From a6da233029124bcbb64370099f853f62c2350682 Mon Sep 17 00:00:00 2001 From: Shoozza Date: Thu, 10 May 2018 21:06:35 +0200 Subject: [PATCH 01/57] Added Headers and License info --- README.md | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 4d24081..d5e0465 100644 --- a/README.md +++ b/README.md @@ -1,11 +1,16 @@ # Soldat PolyWorks Soldat map editor -Needs VB6 to be compiled. +## Requirements +* Visual Basic 6 SP6 +## Notes When VB6 is installed, it may have issues finding referenced controls, such as "MBMouse.ocx". You have to add them manually out of the /pwinstall folder. If you want to contribute while using Visual Studio 2015 update 1+, you may need this addon: https://visualstudiogallery.msdn.microsoft.com/00cc8ff8-beb3-4f08-8aa6-59eefba3bb40 (You will still need VB6 for compilation) + +## License +Unkown From bdbe20e41d726c4af163563d69db062aae309c4a Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 10 May 2018 21:39:27 +0200 Subject: [PATCH 02/57] Modified renamed text files --- READ THIS/{SVN Checklist.txt => checklists.md} | 0 READ THIS/{mini todo.txt => todo.md} | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename READ THIS/{SVN Checklist.txt => checklists.md} (100%) rename READ THIS/{mini todo.txt => todo.md} (100%) diff --git a/READ THIS/SVN Checklist.txt b/READ THIS/checklists.md similarity index 100% rename from READ THIS/SVN Checklist.txt rename to READ THIS/checklists.md diff --git a/READ THIS/mini todo.txt b/READ THIS/todo.md similarity index 100% rename from READ THIS/mini todo.txt rename to READ THIS/todo.md From 6952472afa722780b95fe8df3889197914075e7a Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 10 May 2018 21:40:56 +0200 Subject: [PATCH 03/57] Modified formatted todo file --- READ THIS/todo.md | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/READ THIS/todo.md b/READ THIS/todo.md index df158c7..2930f10 100644 --- a/READ THIS/todo.md +++ b/READ THIS/todo.md @@ -1,4 +1,7 @@ -fix smooth movement while zoomed -texture movement direction issue (while rotated) -collider radius in properties window -render polygon edges as an option \ No newline at end of file +Todo +---- + +* fix smooth movement while zoomed +* texture movement direction issue (while rotated) +* collider radius in properties window +* render polygon edges as an option From 0878feedbcdebdb593cab8c0c721611fa3c674b5 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 10 May 2018 22:06:23 +0200 Subject: [PATCH 04/57] Modified readme formatting --- README.md | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index d5e0465..48854e0 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,14 @@ -# Soldat PolyWorks +Soldat PolyWorks +================ + Soldat map editor -## Requirements +Requirements +------------ * Visual Basic 6 SP6 -## Notes +Notes +----- When VB6 is installed, it may have issues finding referenced controls, such as "MBMouse.ocx". You have to add them manually out of the /pwinstall folder. @@ -12,5 +16,6 @@ If you want to contribute while using Visual Studio 2015 update 1+, you may need https://visualstudiogallery.msdn.microsoft.com/00cc8ff8-beb3-4f08-8aa6-59eefba3bb40 (You will still need VB6 for compilation) -## License +License +------- Unkown From 7076babf6c1bdd82e62f5b053330719a678bba4c Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 10 May 2018 22:07:39 +0200 Subject: [PATCH 05/57] Modified text file formatting --- READ THIS/checklists.md | 5 ++++- READ THIS/todo.md | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/READ THIS/checklists.md b/READ THIS/checklists.md index 070d095..3ef1713 100644 --- a/READ THIS/checklists.md +++ b/READ THIS/checklists.md @@ -1,3 +1,6 @@ +Checklists +========== + Commit ------ @@ -32,4 +35,4 @@ Release * Upload new installer and zip file to original locations * Save modification to PolyWorks topic * Post update reply with version number and changes -* Done! \ No newline at end of file +* Done! diff --git a/READ THIS/todo.md b/READ THIS/todo.md index 2930f10..222b32e 100644 --- a/READ THIS/todo.md +++ b/READ THIS/todo.md @@ -1,5 +1,5 @@ Todo ----- +==== * fix smooth movement while zoomed * texture movement direction issue (while rotated) From bcf88afad10db1b7f06e4c6d0c3e7a2f5184c9ff Mon Sep 17 00:00:00 2001 From: Shoozza Date: Thu, 10 May 2018 22:10:07 +0200 Subject: [PATCH 06/57] Added NSIS requirement info in readme --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index 48854e0..8a02010 100644 --- a/README.md +++ b/README.md @@ -6,6 +6,7 @@ Soldat map editor Requirements ------------ * Visual Basic 6 SP6 +* NSIS (optional - for generating the Installer) Notes ----- From 66f480c964895e497bdd4ab94b1ec6938af09f2a Mon Sep 17 00:00:00 2001 From: Shoozza Date: Thu, 10 May 2018 22:34:12 +0200 Subject: [PATCH 07/57] Added link to soldat and improved description --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 8a02010..a86ec50 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ Soldat PolyWorks ================ -Soldat map editor +Map editor for the [Soldat game](https://soldat.pl) Requirements ------------ From 02baa8f10865813d4d7ecae8ee9ef489deb197c0 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 10 May 2018 22:40:29 +0200 Subject: [PATCH 08/57] Added screenshot --- img/screenshot.jpg | Bin 0 -> 70775 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 img/screenshot.jpg diff --git a/img/screenshot.jpg b/img/screenshot.jpg new file mode 100644 index 0000000000000000000000000000000000000000..e74f3ec8f487c968d2ee3e59fb370f9816e818c6 GIT binary patch literal 70775 zcmeFZ1ym)=mMC~|DBRs$3wNl(-Jx)YgUi94s>0pf-Jx)IclQDccXufm?z`{4c|HC6 zclZB2vu4)xKI>%e*pZQuJ0db-Tjbl)+b;l$w78Tw01O-e0DJ!d-YEnM#)c*o%BC*7 zBrNP)JX|CcfIk6@=4}%&Cgx@V1OVjZ0CewESO5$d8UW%Q`&(%+JOI?+Z~!124F4Z^ zJQ&U2ulb`I7Qp)vfbsrM2V?yQ{v*f&0QvW_M(<|;03sXg&r)x106;eQU%3z@*${u> z;2M9s5&)2VKfgcypJyQxJ0nvPMRPkRJ4bUndlD`tW&kTQGbb+#3okR0unMJ0@5ETFmMzUl0V_|AMo`*3vXQjR9J8g z2oeY|Q~)?C7z8TVTOXkRj|PPTdxyVs2mnBVLqI~qfWg9jcqc;qk@bJ(fxYKJLBqhJ z0Kg!?!6BjH;bEX)kzv6hz~2dws8DF=q%0TE7?@;2O03GNhM;dTaXHg7Smf-EvDG!* zvzwPN6l}sqxwSYd4)OD_*dl7CdHFjWVqc6+oWA=f6x8+3ZEaI>0bTs+dv={0s5nJY z|5iQtJG?*T-yRVa3=Lcff|SJ&T}T;{j8)hO^tJ*(fB<{v2?7=H3GmX@%`A;;ZV)R; zPENCOZe#mOZF=nHrasz`<=ABBD7K@Qbh(B6C#taBb%K!gGQg@jH2jb{D z*~yOWU{1*DR2##kMQAftQ1jL!y$?(EP@TXe_OLuN&)+Dt12AM$_x$>l++90bMEhYo zMK}auB0n#^;bpnL^U@&Ce-Qt~lKT*4FQVz{RQNm!`?lfsKzV zAAArtyG(JXg`v^Kp{ysX*O1tm_g=SlMT<;HVg-|DRcrzAQGh_bDT~_r$y#?S>Z@{5)Q?Kk_u~*2eRvof)aw%)`3+@!6NWo(VW*#TnJwSry1l zSys>07z|s{@%S_O<>kz?ahKWura#0m$(S1PfBRP>}H# z021Rbm<~ivjWL5lxVyg85#8D3J2wW5&VvTGG+ex*6(< z5Mx`W`bB=nk?Ik^iMbZN(o@FfYfryjw$l`kc;x%#DHptru@s5RFwd?*Xrs#Rh^Wdc zpa^m;LJLI?b(k0gLQ^>!?;VdE>ocn3k1K$0Cw)(tSK|izwUq8W$82~4qeZRfnEY)f z0Mlu9#Dq+N9K*$(Sn(*(h2L@_>-YW-J(-<~k8gloew9csrm#&sMrsO>JYW8AVm^i3 z;a6gXyq9IOS&eNDjAT_EG=610juXl}5)BdLqkr1UM5Xc+FVJsTO3Z${utl3VvmG zLV=D}){(9R)UYWprC7J3_h;wLk9ZR19lq@%omdubNz;vgZb*!yQ40 zuZ3lnwwGdGh;qR%i$+A6LlziFE^P(h$BN(#TJ=k231<%3XH=_kkJ0xvh!C5x#`dQck|T5hZ!i!!Q@t>gB5Oo#qO zN)9~>Jf|`hi)sg?UTa8xOwkQrf+{p8vk1WnL&KG_0aVsTbWm8;5@Ft zP;&^*gO{m`OQ7(v!?G4CqXz%PmTe)O`QTBpzvH5{K$~vKKZnD>ebnOt=dbH}DdOB6#+I*k2Dszq|jv@oawa?tAB>Y*}Sm3-U z`3<0qZewKpG<=`7`#QTy)RsFc3q~@U3kw;nv1EJuB;)xD;s_1DLtEGQ{0&gv-pG%Q zSJ-=47qgdIY6Ohsa)8|qhaUpUl}n{u>F4&by1fCY2Rl6PA3*L8PCH&)9uoPLycQI( zJQj6P`DT;2@qVeSWUh`4KNmgMmqV6^p9LS^0FJYlooe|PuD>G+9}4x}0D})6Hp8B9 zDE}ic=T$W0i>^JSIJEuQvgQ?}U+<`QxP3Y}vR+@MdD_l?dAGf5r{$bEV(~X(-LXLY z?BHrtLc7I+Cv8zwBQd?lZ26sv0&m)j!Elfq2FpI#Nm^0muy{N7EE+6x(GHK}gT zpsU6T-bvH{zTJPf-T&%9Nzhh>5LoJemqzN{iE|V*PfCzf1P?y)ya7@yHcqv}#DdXJ zGd8pZn?F`$*)|?{TmMEXS@#r7a+iJ1Zrgt~^?3uB_UHD&-A$ZVWa%U=Og3uY2sZcx zsh$gD$+Q)EPw6?n0a!bIYqqA1AfL@#7bYuZj?Gppo`|(SiIlo#P8O{HRiA$6GN^KE zzRyVw{F+A(mxE_5E@!#?A$#C|nO8!Ul?5eNi6eg;6T4TWsb1lP8=4heo9(nX=1dL2?X1@j9b45HSK@B{Rp1HP>!g^JQg?eiHN-vwL|&q2$i& zO{<}T?3xym}Baj@@=Ho)a9d4S&jYV=dQgDxma4(E_OlVF+sW_CbPO(@@xI!X>K z-9w1ra({x81>1VjsWcK}rj2868gg9rfkO~qbfPz(V*1WahqVXzAMm?-sUqLN&Qi0G@-c46VhL9qfN3Jk@LPr~gV5XN=SrTFg2C;Ys9FOnwpZL8b==m#x92d zOSq`@9yajN+vx`iipwjKeJLG*U?q9*PKhzx#d75YyYoka_}QVcJ7%&#rF1I)zMh)E z;2{&7RVu`^NP%8!!Td|o!UA3`%WxW6S`uK?I+Cnj7EW>a6*qJsPi85d18l$zqbwy# zVswJCeQ)5B4<#03ZUHxS)gWm(E^b~pMPWcSRg?lO-w!o-HNX%k2J(a_A{CVAk-h9@ z(YvB`*H2(|8UC3CF8J_}ejBBz*HJA%L`MEpU+p}mk5ZBWRp^{;+G^RTG@p82PHiTyj8n zSo~w1GEJ_p&IZF&VMJL(DeN$k)P}K+JV@Dm`}>1+EaY;%_*KxLOv%`v7UBP`qkq33 zl+q=-H@K#i2@o|%RZ0x3Ugzs1%90a^kBzgU5_^7Qq3OlZ^%?Y~e`sEJ?PIFnlJ3v* zdW*jj@~+GB;-zPYUUNh}jvXTo9O|wzd)asB8F#8qOWukojRXnTET0a39W*|#o{lxS za;?wo<%Rd=C?Jk&x85t1nm5BW;L$7@=i< zSK78()t}o~n!U!%O7=%RU>*3bJAIs4lR;e2%Gj~2JWCoEI{7G( zako=MuIB30VTo+Wvti1ESJql^t>_6i@l5+4XjGkeOmZqc9{Ov|H-H3;Oy~3J$w=E9 zpwql`v$r%-h=_+CNNP9TJ@W>@TE*OZwp^C+yCnlR)mH6t9a4~kfHOU*X>Dk=_7p5y zX~=qVm}6q}SDTsTuTod?bt5${^2h1X6z1<8_inE28#}qvNqbl;IrNMvZEex#fceqR ze7Ojp$B2;yNy&TqNf%l0-N_uEm zDzvNDrnUFU|14W(nT+%ZcbIL+(4MI7vS<@!HuwBx_6;DfwRky(R`>yKhqpB7WrGhP zS_~hDnDgGSL%k!HupOzX@eNQiNwwMaB3zmn8|h)OTbNF^CxZ}x;g=E&PwN*}-xsVm zS&^}7T&3T8QG2?**}7oN{^E$nb07jAkQT*$>jc_j{08#okFSvsbilhJBR8iQlUH`^ zOV29gEi(+m>3+!bPxwj5FCwNhJr{{^DnsNEPLP9ZXpP}GoEwH>D9A`99=jqmG0Ks8 z$3g|68T6j(C#FLh6rZ4Ec&j=kxyi{^2s@DU0m5in?(@Jof+1Bz^S~t|CQxyUpAZ31 zVw#0y8C-nHy&_q%B6UPHsp?eYA8VpWjMy`D<6+UZBj+@a8e5@iJ}4TJy<0LEizhyT_~q`pC@K z4?MJz?mXcDG9n8x&KZl8;hzzY6aB99uD`9Xj4$2*qoY-$S-sbdR}Vq(51-xuU-BLX zTHAbap2w`Qbx&oob-@p?Kes?lF@1A_|KCe|4KXIj9rx})?oZ^%{Shr=yy44K?~Gkp zS@M48;Nsr`#4pyqL3Dc?hm%!xP1rq0KY2AjgFduq8RzwTpV1cKte5Ht=HgkfgFYRy zKVjh#*dmeG3U?>_6oKN34Stg4r9meg9T&S>N*{)of_U`=O`!vWNhg$lErkq`#~Om+ z9@fb}rki3LTH~=GV|Kv<%-J@lw=Oq(AE!3=F30iH$J|V^6`K&<{NC4`n4SsS6|`c6 z02OA#!5)6j;vWa4%}fA>j~I9*FbG8fc~#LY8s=l`kzvwX;7%svu*q;ghLdFQqgUuw z?N98!H#uW45BFcRTXS;9)9qPFe--&xbPS$xoEfHT3WIFu|JL-!8Q*6 z674LaRGaE{ph|phe-V&v)_^_cK%5oToFcKfN2e%1-rpn&VW1^g5PPZ-7Q_S2@G&l& zMJeA_D#!kZh}MIi#z@GJ)E>7ZDg)tFnSjo_4*&IV%z z0^fX)&!!n)x7Bt$P5qcl!nEemljZvohJp%GxQ1pvqSu+@p6&A5t&`JDr;17KA;Sla zoL>KGwD5zSWVbfa6_E+*$!P0)oWYEA-7GFX^-l~N=`YP*oy(72#98~lE7=~!@G219 z|LDyEf;v&9!^9m=?`CyzjG~nSNx`WOj>y8NU0~N0el8B zk*dItLoC@a$dUG3A!!oc;_zuCOZ9KZ1c@=QN;S&#S8{adzZ_fU3^b0u0WxR`N}J1n z+jwU^F4N&)qKTfSO4LFKcG%Z)$(@or>z*~;N=73nvPOIh#}~#uk>}#xr4c`6YTJa& zrx-gm-(aha1}+w+SBZoU$PN;Pr#=NcqFeghRMi?Sln_)Q+j)5U3Mjo;@Fq?2#U*Lw z|Ch``-<*hOh;)Gojg%Rh!D5Sx9rIzLa)vL@HT|`^9rb=rZO(hE?i-(SUlVoJ!WG0c zagW-wN^ZUF8cXkW6UO3OmSf3Ed2~0quXx1Rq>Np$PGo&mb)W329ghX1t`aF<=0B## zoh<6>$(uX;m71+0BPa;*<&fE@cxFEy3ZgaAA6I@H798ijA|264x>oIQP^gt}3;yQ< z%#=nwH{~3u)PT$Fgm5OASz?i3mqIW38zO4HmOKLmZGU=8CudreD{u(bF z?>E1}<3z)bIU=2@7dN2BNllX#-s(B0l5iLDlMswj+dkX zYOF-0gzY}PyDpNc+>*p^d8dJTBx&3l+(a-Nk| z{g<=W|0LyUg2`srsV_W4*tk*ER;y_p>|@%)sLn1C3_AWK|hhJC!U9^vs+{)#!TGhH3RR=<3< zcIwM|(Q}DT=shI`rMz>UBxdI>FlzjTfAy0Fv!#DSVT)VMqR40Y z+IWl_{k4%hBqd|9a8ni{*v>+Og zgP8Qw43@hHf2Uj~^uX!KhgKI-GR6R-Ct zjN+*Shy7U#CwF#tp5<%P(TVnGpsGE(|BpV0Q9q+p2g}wC`7RPYhiO^!r2^E}eBqy5*Hc~Lcd=oM*SD-XI?Zr`3-HIet zRM^;*TqY|a#$z=JiRBmF|7wYNEN<*!qTIO)F(w2OS68{g%a8X$dihhtR1hcr~ zEQ2_(1JJhOMhh4s_NBk{=rM%op*SQnWHEB*oa@vEuIJdJ5VUydLh{F%g0FPkCzu$k zlqbsj`nYj>K1d?vmcjLvWJfW%1M`bRna53*im;U8RimD#c@OY9dQT9 z7RgYpI%+&Q8&zfG`FYFbvp>N3AATHw+NPpmB;?l>D*9V44tc~jdMNi6tpukTB7-m`V^*q43Tkj< zIJ`_@Jdq&nnv*wyEiWsv2Z`GdOzH|3K_o=t!rrxJ;Ig*qyNfY%$|C*7UGAL17BqBP zy%U_t=2FX9MCwW?SC-T85p{jiw&&Asl?MZ-DiCs^q>wWyCJ`-u==9 z^#{VW+&oN+V@^}~mh-!+YrP2s*<)b(=4>{-+W6wX@c?#!5tXR+;#dmif|q*4(- zVLu#2ZA&(37seO=+oqTC@98`A@NOPyK7|W8U*-jgAn>)dH?(gbiSvxPd@DpU>wAOk zIv1*)7?{~Qzr1qL)4K(Ac7{NOr@bO&>zI4KMztpda;hS#Ro(K!;yY7 z-kxtO1`GmhUtbx^*xMa!3q)B)>D}g)yT-4Jb=^n3&$12MN-J>0xPpAq0;aDd?>3Ho z(Q>t(Gdn*FPn8INVWYun$R4E9tkX6%)JTE&sk?l?K9OzByw(4-?elDN)2ZMwT3f_m zqc}H6ZS?fiqCGlab6VoENG@QV{YTW{cdEu8$Weu_{FYc!TUp@64&)xPvSXeSon+qHEmDTZA&@$IKTz(l<$Y$Y+epuuzLz&&1U6jD+O(N^B zHQhvpwYL`j4)6#~E-1?G-NFfi?yXdrQ52Ig?uV|Un?PqKv;O4{HZYYK3{@OIc;EM3 zW;WhXLEcRb3Y#DdvA3{~bZRqZYCeo098CsMq9cg6kTx%3lR1$kQd%#`glT+eDG4sK;VKv{LSs~ZEQyyqvn=l;YOxPIsLed4YJSXlv~j+A8qDw zfQMtTlZ4s!wO3CL7Jsgb)dGT&KU@TXt&X(MjXGpz#t2WkC?z{K3cZjukR|c+c033B zcVpaPluYG#ss3H~FoDctU8R{H)-vB8Y}DREa*WjCW{tUZl?dvhXATZ6LRCs4SrDW_ zu~IU^+v!3Ff3C->&*-sdeiDhUdnH`aI2Drtvhj|F~b8050Bt~jbOS33H z>a>RHTiIwuK;@g*FoOXgc{(E3$=?vGTypDElx# zq8_T6@?;3X!+IPAo03W|0k4j75(>j?ASnx$Qoy#A@N#hFqox|r?myX=q*vt?SQ=NT zG2DVN!8jVoJl8@i!j9Mo{yQT0)iKZ#1{TOA;ve3_O#ePK8R}~!po%kb?2m#eXv_+? zoKc1tATP%iNaRp=qmfug3_iwp1>EuRkzvz~lvMdOuF076rYJ-8cE7S%bW5}0NS_zfoT8|qVM;A3jtI*1Mjr+w@_2d&< zc#)XxP<(taJY0i>mDwNllF2!_!pJjSCd)NJ3zre7J06{LCY&~z-IqJXc+bQ) zK&XH9h@7^X7BkV8jSIyDUWwz4f#Oz_jgcH6<-kM|0 z1m*e^C~VP6pkgcG8dO;+ToXvj&uZWHb%Wk&aicv+&2eB2nilS~>C>t8)qTtQqHg^t zKH;Jj+8@>>*wpndLBX_#%VJ@5j0a4KKDiq>7c1%knJ$l>_lV|qKyJaF;pbEZ;p&ao zTAg5Bw6+n={4C}NrBre3E#$+XeeR})b{XDUwAyd!Bt_GpaB4I^1!f_v#MoScchgAp zU@GS%sdg%a1HC}XNqOvl-))_?02MxxH4$Wa#$pw1;NNILrPuW}&RsV|^4`=bo5Pnka!@_$U_Q)cGYA z@`cihQ6f|hCE;I9icmnUV;@Q2M90&0y3@6p*A=^uyr?WEHi90&d1mCJ75jBd%+;gi%g1 zQgmU}Od%m5QIdpBeF9d3izz%6_C}<*Q}2Youv_&a4m8(b>zRt6qKeS z5=<&P3``5NfkMa&@-ha%$#9Grfey{42r;7+Cf@>QxWhUaKQjqQ$}?d;2JFW%#B}KJ zta8v??}Ny|5furAe&UIzgeZ#1>2vF)x|5`8G>svlNic=K2ivllFHf)mn=sRu1qa&W zDbstFA=2f>m&PVbe?K#(pO9pxM|7Eu8GDAA|4f~nn>a5sUTY{VA0HBEeu=p)QPXa2 z62VoSPgi|07D64Ri0&Ssuqc`mcEA8xm;iZLVfU$;b%E{XbD#1)MwYy?hfO+B*%k=@ z#|)v+vjLkyir(cm%h+##F#Uqxh*c$-I?t6$b3F(>h=$e;cHLRFiz{dMhb_nMbRK8- zjlSodi9_+YnN?{%uZs=+6U(_@0^7#7Zy%D_s$r=cU2m364h(-EBsJID9jj?ZD%@xH zcFd=a{A_M@y~)+U-tg68xLpG#9IV})`(~I2oQ0it3e#PTepxu!Fp43#`t5nFs%uc_ z{d%i5z2~}8+R{Idt!(?fe-2*Mn+|PpsItadS9nzZAb=;nPJ66Y&GI0r{2-ygG*eei z4Yp;5QW$_1#bioDe@@8W&LRfj}uc1+^ z*}PXA29_mPws>!PV0-^=bWd9E9anj+<4ZC-?jes*qdyx|SZ0 zc{VXIHlZ8Ev6i`(2=rYTeJWERKJ~IAKp%ua>f@e9@>JRa!JBU{Vg<6UHAoyuA>u#F zUg>NA7lLa+J)dZz^^xd?dNM9v)R8N=FJ8Ei{OOzOg|I9}unM^gzvBX7uMQ1ULRs7n z$0&=lxN8WT#Qek}HZ_vxR3}u`Zdiv=43=E5kRj0zBf5*Nq}fuQQ73Ws%=V?n!0Cnz z4VoHZE>>FbLOt4yiiE;9)nfac>TZ6tu?NuNnh*%*$tW%-8#uW6Ll&A*&p1kXcBlJ- zArv_kB+gV}~z;u8?qi}D>~mWKk?RUF97@w}YViSv6eB@ZpD=~9jlwhF;g zzh|a0kLrqj5m$z$RMd@Nfrl3>57Vw?t-%iz=zY>UbQ7b9mQ~*JkUTgdrWu->3{_t6 z$IR{1yipR0g@gRLNjyF(2cdE)yQNRZ)bKt@!^*1sQX@v?nxaf>u#CS&m5@_N@A?SI zIVSt**I>n}nRKn$%v>@NrS{h;W`wC(hd?SD4iRzoi5a1Q>ypo!rG?P}{=rd-6NpU6kB@=zor&BrZHL^NBhA8n#sjH(7GW zbLd5%IOEyF_ehY4ij%>o#WGzTB@@V*s`WIJ5dL+zU>nVXjljMKYI58G#}I90T6{9v zr5EBr{-H{LLle%5+QtQC5q{zF?DY9_Qu5EuSq(fikc zcn{M(;_DrE!|;kozEQpE>4eJlt$uAVXSn5*e|mY`aA~}@`rL_g0H_;9i{~h4hdjC4 z>8nz{D3RW>VdvT2(H|!YS-ac5zHsGX^Xpxu;`uF3>N9A(p|3E}Y}LYH!&Xjcsio^p zLqBsq-6@UWnldkuYE#T|GgPylWLbQSo`{}BR|rzg%z&6!?!|4c zJn=6-yza{QW$Xpfk3V#+uV4Mn0&b!Z69~lBYpqwFq1u?v7CHu6kDbR`3baW`J<<6- zsnlo9nrY27AdtgURF&Xqam(js_ZY+aX{L#wj#G)dnvofRgHW5(8kEquP(3*e1Bn$? zYv!5tV1eIpk+w^vza?)HRGug#TkLuUH#Nwh*GB*3T8RX=PsEATe7CgFpc(Y<8W`epiZ}_sTn{Q_r|hSRmN9gEe|A6y-FVX3~da{GPK1chhqkNosn`CmhzPaGmR(sl*)|4!(EFsp=*Vl z2S73M2)k`S3y@ox5S{@;sr{+Zy}lf{`MrGX59Lz`F4XHo-WJspWX-||Gyj*C*yM)- zq1nq5GFibQ8etDD>Eg}V{`2YKIL>fu!&sq4_LXDqwYz)B2RkS^Zk0Ku>0vd<8d>+7 zEtQY~mLqPnh!IpOTvonA(xfl0aCTg~K0XAUm4e7=o#&_58@teMo0XyNw6vDn9y}G0 z`+6*qUkz|^n+m-7o}WA1+4x$CfY|0MG&y%2A5R|_pME}1HnjHgOJ_C`^&Qb3(pr$m zVfIO7qE$L_ZaX@T7gi)9%-o5010Z+=!^!q`pLKl5i(O90UxOBoXWS=xyYvP+Upa~I zG_W^2k9@RdA^=?j9QBShpRQFAEO)Q78{S3~0O0(b*9B5b%c=GZNQ_ud5{^Bfg znXeOBH$IQ@AMlm>Rs2du0$GNvrqqG2Wu0Qa0n|%6wXLpgvMTvA7Iht=!GPA~3-vAd z{WfX*MB>Np!77X{Ha3e7t9EKH^i)G7+C{+D2LZ&|65w+2!aTrvqwLa-{HD@XCUsu5 zIbm&mO_wN3J;z>vf)riwwZN~y&pFPNOGqa1x#k1gGM3xU>iN|7w6)JQ2Q;pt)wLvb zJEb)V@H920Smj|f8=jgd+5=y=vI$hfY-t#?8*SbI7#MBl3{9*Eu2Ap{P1%hJN~XAq ziYMP^*xmf*;7NYkre^ApP?)ZS%;5FsVexq{Th;t9^e;u5n|^!y|a6F=)Im5Bv4WK1)d z-JZOh;?lmHt)@gueq}Ks1eaWBCPXVuFHcOLpsQ5uyy1Hk zCa*f4q-81dFdgL9G^Ry2qWJ(Sf0bYp`NWQrc~^4;X{)Z+;Na%O@wtz0T8GY%SV~Gt z`FKf6JsVe8iMQi5aAnQkcj{>khhvP5IQ2bhLrZ}DO40#tT^u%$*PAHEEJ{#kdHH9u zZEt)9xtIKd^RDyGd7$l@&4v16Al`!+e#(zimeGE4Zwv}i2kZ{!_K9&?_^>!(p~TBQ z>(Rr!19~VI9y|e>JM5m65Q5GbZgdX?1pQXI}&x`!z3PS^cF6|Kw4aN#9F|u)&miB zwU#zI&OKf0trmDZtS^4mv1HtUpFg{DHog>5UDoPbP6yZ&x;}TDe{{Fr6;d;8sPKHa z(>CgFm5uepT1&cMbJy-V`{7g<+9qKo{&e0rzj@r~XS0auI{1l)xU;hY#J9xseEz<& zljXZ;Hi)&gdbnPeYnM!RoD@&XCrp1xjy7%Zg zzA(aW-tC-aej}C3#k`=0Ae<=$n zDgT%fR)+r?V$`U+FL-6?T#`~ifB;5!S>;sOnpaF1}Z)q{f^#PiBCgr~psgc6g zH%n$^QDD$Y3##r9Kj!*3h0pH9YGVZ>)5^ulhHJ5nW@sWK!+6sZqWw z(*P6Y5bVc#kTyw2&kZ2Q#Hg7yN0n>vR^NAEVU$B(f(^h>sSi<;zO@^1;UYix)w5MQGvl zZe92X;G&8GH9t!Z-!a$5b;e}e+W1^0+FWomhVW=^8LUo_6I9q8G=K6`?2NG^@TT7U zHfUTEXQ)#-=pPxcmCk2W}Lxi^!&N4 zVI_=Jw~uo}KXhHf<_QBniUzBE^1@bRD)ll~wC~an8vNGBuSU z$&u`g`P^FO+pb2h#bG~93oH`-e*J!DfuTPZ@YR7KM(zqIP9g21%RiFG8w<5qUxEpR zp{=r8^4+#3J4-ah%G1v0N*PVGDECCMGXE&W{|(X|e9VaCYG|tE1B!K%&Lic>GqQSA zo-yBjo2z$N5kczV@uK@sYR8}Jb_u%MUkZJz#(%j&-*;%if=H<{HYFtyGK(vMGfDy) z!Alil3Ev4;pp~ZBx(eveoOE8Uoa>u^P@^Q&!SR|;kO&q=k#$y`Rz^?^5XIEHLs?Mc zk0tmax;(UvlZOitvyDm(%s1320xyX&J`VgD?gX+Ubx(s4wVGR{7`^Bu7F77x51qfLFvbW=* zgxA)*>$X3us=5XjiDBRQq0d|z_TZQni8e1WNlFb<6$IO@AbOLRm>A!~RajIAOf@b` z;vg`#o}H7wmGSBGr2{DhZ#jY-QL7Lvv5V&i3JZ(jmps_Lrq@dQtcG=+G8zlVdW$gl*2og9b^f7qLFZN*dGVPLR!4^RP&vzi%P6Mq^Yp z*BIUuk&%N!)T301wJf2qEG8@TXZMpQxe&qBRp`J9PPKp?*1`7%Bbgyv%7u5Y~C(t1oF zgI4fsoMA~1n_1P^87vOHucwba_w+(q&SVit&sQ7Ah91Kc(mMZ`mE^dSg9SWX^|n1b zJG*yvrFJEw-seGYjca{}D#LwRp3h|9tSDH}3-Uc{N#3ir{kcSNr@fOnNfC>Ipu!Vqiq~!VbbB7<;?erZ;;y zH}lz$wQf{d9=luSM?87qd+_^mbR5cn<+;G$zxcA9ELW&G4?CEw{6>0OzFqBk{j%C{ z_MPgq%<8mLuHnIpabux$DprAdvf^oDc->S8k)f(;@5Qb*N2v^7!OFSQ@96kxUO6N+ zU%y~gT|cPP7u|=4(@;Xm=;Em34ZwEl49_9`Qzcy%Z~ZANr`-oJi*;|!S%NK9!nO6- z``)zcCT5bXd&)mi{`FOD;!vEws#CgquBU!M4w}%i>|;&t5$myNRjplnj3XV*ZGdF^ zbm!brh(^tnsk58wN@&f{#|rcQuq5>;pE}Hhiq7@#{f+BKQ1T<oV8ZpU^S-;r~dar5dp*SJpXGce-Rau?S)Enhz+q^#Wl0qt#=!S3kp?rge81Tbf z2G(K?{qXA}ltC_;5nc3gJMw94JhpQ6_GbFcrPp9JvY@MP^fxQPq6+k^3Q{aCd3#+< zvc63%M^$};P5ol-9;gcBdy#eR`xF+GWFyf32I%n}e*+v*Q~p=su9OFDm;Z8m^gpk= z9}PFa^55;kA~#<`d843zJX%J!IaOgY#G8pIj$<;k7-mX)_(fe8n@(dWAoAxhLrAl7 zV>k?e5?DD3sezxNVo5mNvMnO#xRy)0p2&p#zROjl%E@z!8i)wH>HTlUwSo0 zWhMSrA98!i^t{zUy$r2DbQa(YL(b{T3<{r7nVkVhv!f@7(T|D1w@R|cpkh!V$eo*9 z!LneVt`nhOS1r8=)?V$X66g6w7QeDo?*B+s%>JAG=j-*sC%QUqr&lg5Oo*FvXD{Py?Wcv+N51o; z34UJ|7@F%l`Epvfhd188kdbln22knfq;EZ5nP>np)=efZUf4XHZhnzo9+?n8INdm~ zLqA<9twkvC*4FQwTmP6gl|vI^Nw~6j^=W<0W$qcvMzKZ}OSgm3Zh9T)b2VHGII3Jd zKDTTPQ+tsP%QG$M{L*;A6;uG6hG8P%@=R#qYE+-7u1LK}F22#J*nC=lN>rOhVcm+o zvAk(zc#nRF{js5)@VrJ8X05R(Dv~}5eGr$nf5V^)t4Zzqp?j`-?0&Jru|dsOI`?SW zwKT+I1g#>)UQd{B8i>X=qGM*OxONsX)frbh9yu%h2WuB{gekfa|p*+uBXD{#}lQrjBhF!KbbMWhFW!vvhxu+64}IMs@v1+8 zN;DR3-TedmXn}|f-#@SG%P$=e4^uV%p6PxAh-BT>IEg$`EW80)G(H_TzAnfIZ|TSD zpLv)4dIeJn6XZfPR*@3_2w_+Rk*2CPJM)@yiR-XCvu8D+KANO{MwlSDCZ28u zhOWLbrtM7b;aWD7xUlw<`$N;zp`>4H+R`in94gYz)Y7E6{JV-s2u@o_*zN&ika@rf zCW8t7y(UpkECp2QUitwT9MsihDr;MC@m?UA0V}F&Gc$gp(cScyYuzqc%S7(QnJ|q?8 z5C2+@<>iG?_W6;fuitrVj3P5NVaz2+Iqr1CHgc9v%7QL@0DG@>BR zk2_kiEzWdmaD-B8PIHG1_N!LzzM=>O+n5}llZ3*n6i4S-BJvZ#8=yWe_kAxq{HNyB zTKH}j28A_9^eY!)P4(QJyeOIeY@RyzN5w1PXcDLLsOK(Y$TV@{!(a09%p$qbuLbmA zBZ4%Mpjk{^8&zC`Z~37NyM+ApQ0H;O1V&@1xO_4CY5~C+DTiNNCXlw52ykqeIlSrl z`eumSjo{d0J$E7vuCRn1$sC|v4ScLDf%?&pz{NX--YYk^hdrm%K9)*kwa*vh`r=#X zE-u9(k!)7Gv8=9MggK+H#kdOkd(exhwnGUb=yZV}J2HBx{Md)D~P4 zH~F&A%Y}%%S^lvnBoH5%C`>A6{95g&V9u+geZ-#B7XmKHU0YwVom@Pq=U>cQ)Zc7; zc@?ObTF1aZtm$Z7d*VIc^v>cf9hKX0U7q%(zj0l)gdLtNGQB@^^=(&j!kskpRyTWU z!+Y^YE-{*ir<8m0xLoaa5)dEf6k>qk}s$<1PA zt^1yH%rV9sS^!PDv1Pf&+l?sQukjiNmZd(~&KLxZ}o(Gc*h1LBvB1v6MB`{6*kK zG%?#P@SV1iE^zm;aUu&k5CsgLl+nDDHoH##wfsg|#?DqS>0%(}fFVXK1N`lNl$aiO zgij*$yU(z4D)(@Um*T`nke*Co@Zubfoj22>qJU|u3#)NhQ66x<%Pn~DL7mRg$&C?)C3g%EVXD@c^|b1b z#NMG*Yt}0Rd<*A<^>zmJj%LVgnc^rrN8BziVWmW!a!tn51~_HR2OkEph=Y8$p!DGS-W zELgpG%580`;%XytFN@ha_8^6K7NYNV$`wbs#o4Eod?{*Ke=je>U|Et>d{GQW54q0kGn z6D9cs$#22eR=Oo*zos2391<~dXA zlNWfvIRuba50_Eu1R1mMRS5zIHOi*nWuZ`8t^J~IOhKI0tl3uwjO=0jS9|c)bV~*GasZ24vH?a7a8G43a zdb?HARX-1kdQWldgwfI!eRP9z zt?xHF-Q!iL$N48Z-9)YgV&HKTu%OuV4opYYU{G=uHLvaJ;8Jf$Q18l4*1;2jP;6i3 zwl{ohI;HN6$MKrry&`-fdEn_VQ)1uoUU|%a8*Rz`mF${uc{vu_Fd6jW-bZb2yXE!A zH&H=3rG~NA$kHrBv-0yn+`Wu1mg}+uK&sfE<<0(MpxrVqpOuG3u!d*mnzL~g&4z(* z42$}7I7_!@Mt5-VHnWiD>bl6$uh8N!zxPHG6nAukl9Xa7n*+yL;s=`N%RwV6hUk5T ze`s3e-T| z;_9|lCUDKOi|(PVoa&vvS3%_$YK(f;cpHU>PfKI?nitCN9Cx7bKk?r^mWU{@nR4jm zk`M(s;SdFxT+gWTfaU&_7W291Ko z#HGKYvwqXfJ;S@hH?dud*krAkHD9)9so2*dl$xNvEN)Cavb!h~6UK4O-%4+jfj=O} z8PGn$7u)uN2P|@?Bk!Dz9h9F1wYcJlkn?(}UVOyIf)+~xdN&ALd9;8UI=-`#@A3GGPSd{_BbyFGW^IUTs(3AS_*yx+{J0KM)zBw8gI2rS z4C@NBPBB^rz5ZE9|Js(3^7X*aw09`b$R}MMsgK_~I@N^^Tt8BM&$IW+j?5bYg()u* z|8!Ad9s1aQOKw`4`vMvgT=SR?_*$F9UB`cM*p4|uWobZhuj`SK?*}rZ;Qi|go%{`U zRj+Mwb(p`pOTC|_eA7ej4*Hap$l?xpH-9Uj?BK0le5AP0lQ~Adpl{mydZtZSfD*e^ zJaC$Q*+=>WVi83(bU#LoX^8wlTva(i4N~%mL&Zh6dusAc+)XRt_%7bql2+A0KJe8j zqs5!2s$<{2xkpR+5%%RGt2Z$F?1s7k;;#X;d3eWgWqEv;*^KH`J>O~bz}P&%@P)fyqp9)~dex{_XK`$_7-`@8plaXcv~0qv(Y`e1 z5$61(4aR|c(zj&Tq&vFo!N8qV&)w!Pa+?jiE=*OFN1Er}2NFBW9i!(;+)Y%6n=D@9 z?SB^t{`rKwjM=_I5Nb4AwfL;*qV`8!7IAV`nx%WM#4AfLIZ>-{ zYp(>7e{VcML-R0*P*9E`-s3Hi96mgv z)!KbEH;^vlBj+8lqfsfL3(HsSy`0X1?1@5+uND^FBjs-<%QCp|6*+p`Tl!>zTYvS7 z;LFfCK!Wii!2yioetd*aSsd6DT={zWFwc;CV1km49GbAolKec%cVEZe4L~^8*TFAN zW4^hqy9+OJE%!k%4oAx0KTopmHt^|x-*q~ZY8Oya@F2Cb2(zHBH07lha#s>mP$WlM zFo3Q;05MWlIvUCo%dpkW_i57_IWxZ0gA3}u*pp>>t}Ml8$2=-`i{4_rSF2=aIx9=A zoOVyVef4UXtAxpVN6U}T)xkvTX)W23YI66o(mUnoKEZhO9F1(R?i>HeHkKfkgEETV z6607-rAiC^>E1;x0fMxm$qi|^%X`Q2f#&cHI=ew#EyDJvDmqf*3tie|*OYei zLsZmWf(B@$d(yJ*|A5G_rCw;$R?Ul*X)9a@*($$eAmDLhVv4Mas1@(dN=t)oP}m2p zYzk?scR;FjLuK3jn0wfDVNJ41zT8&VZjUGwyvk>67Z2jAJR&FXL5gC;hL# zx)g1&`!O>6{!Qy`HjVywIUuH9X7b~SIwMKn%cpX?R4`PAxKO<%$aaEN)E}O=)Z!l)#+Ow-P$i0|U^%2%7H!W_WocKAmV}hgL-JsH~5F0^`CvgmfR75WuT;EuX zJl&xE2I%~`nQa+FYoGC_V5xzMceM2oInu)aPWgWP+kS4>HKoGb8WjNw3&8}nlAa7M z>$n5L#!A7SeKg;ML*JPcBF9rX+ITl8F3v^Sw_Hs&Tl(ZuExJrfrG7Trpb0bm*>ADb5@L3PpA1GM*^FFTTla zsyl`-@YI?$-|Tao^lz$9T9lZu@4ef}>b)s2jlHDUgh^uH=&bSgri1a>8x$`g^;r#< zz54oJn$>oe`^H$_)t;w#^FC^<|JghK`46hcf4#|SOme#zQXji)m}b^HFkK#Zulo(v zoL{W*+0r)PIA4BeMc^uQ7_Gwtn{|i{Z+LJ^`N4PB3`k)g*3g%@jMMM6oe~?BURHRW z`6RMYd78H2U6O)+00_$QP4aF*0>@KR$@`(%$#Lna+0R5x`_H0iTm9~fJa8Q!G#qv< z^DBIxi$LV2Y7!Pg)74%JX}`T8mGHumB|-UhugC~t=hatRt3xDI)fxP63ObShAhZpw zHH6MHf~V#`h`md9 zrIX52>U)>EqL!Mo00jqG{HKmo)7)FIsTmyaWoA)1EzXB3(D)=6kc+1M15(PBpw+{N?stXgai}um+k7se7M$M`e{GuegxY{VvB# ztY}zn!BPA}Mi{c2ShT1pExufnv+?E&0SS(cN~*dV<_InFkHak@$&Vt6^YDBg=0Es6 zQxOUUfAV=o(wQH3uG@1M6RJU9q$2nXMv-EPqw)qq@*rX8+K4azHB^cY4*gdU#ujxRhsxGUg&fCSx-kmGbYiP&BT}Z)nohp;L)3Ty{`QuXY zBeA!0U#^1U=knib6x&rbmi04DUDdH8PU}_8(PBjH-+HW1zHc}wkU_JK8U_OP6z)_5dea_ zl%Wb%ty?rvmSlQw@|4?c--lKCF)S1Fe!6yXP(`K5>CC~yfz-DnN>gxErO1|JCtz#- z-@$@`?7wuKC&w#Ab>bllMsMfGshlK{lStj=qHrngN?MPD@n=@)DtV;$BO-SkcO6K2 zrjj@Z+#dbhYwK7@{J|V!mEfSj#K7G;_;VFuK$F_V@X?Xg$pQ(0u5l7(=BIUuOhi_p z>J{?22Ty*qlMo$Eef#F7?ks^F%lnd-T&QaIbXICSKEC6%&(Wf`?rt#E0IRQp+Mzmg zTnkL1mrwg&P@UCH+8Ez=9U)a@4l>OHqyka@C!@yyD+ zlRAj*+O4)W zPgsmUAfsBMu>1rNv9)BM6}+_Tl6(xG-y5h)-%ToCh%pMio(DsvrQ43f4Roo zdOnAuPcDzBNT3hus&P1^(S<4@JR!)M);9RPlYp@`3%rVG~yG@r;WxonfPxH z!|W#ta|~u2*8Kx6{VAEt2O;|p0=0hvW=xKnlXuYw^wq=7u~^|5aEoh$KGC!D)1-u6 zJY5R=%#*WtL=rC$^76#gnD>kp+@5Q-4eCpsuGy}AmyuVTRbRhdW}$l}v|XYvbJunQ zv@eL5%|K~5V;`ZZ>Is`7b4n)18x=rTj!6E0Yv{v$;cx;n2wTBv&q{w=LLwA^W~>nc%rLqq#(oely<>UYQoZ zM$S)nJLaoW5Q>4B~p984f{`n`-Z)K ztxOhu)TU+A={plqhD*4=ZvSK9cDS-Sc{O=CpLF&82BNp0L`6>!LD-So`w`cT6e97o z#i!ANq6S54Kl=L=A1=}V#HnCMZpv;CEqy4zks#L2JjD89f)oLC-Z`OnhxcHq6F)p* ze`^|Nc*P0&;_AS%*G%Q}8jq2r9k)%#{MIvtF1QGp#aOlm0~!^!G_ z@mwJefWNpqt7o8r?l+ zbLXsMp?0D0O{y7@iggMT$*l?Afm*YU5!yhBWV*01-QW-abhj*PM{x->RhgF72;HeS z3)&Q#9sqZZEYDO}<_?%a%B*O_-5boBS+*xDM!#jn8R~LZNj9OKJ1=N@8!^REUV+CK zeH0sS1MExLEZPc0oNX$wLjw*nnhk!`6Hvby%a%nN@od`-Ck+^=p*dJrx?!_W-2R1S z50<}o!Z}(HgEo}xthTORo%EU+E5AUPumi3EfVA=srdj6{;2f7I%&vU{)OaIKU00lX z#rr~{2A>Lhu1I?jN8i$sSZ<#C>NrGkP~p$N;9S8Q_NRn`Wa7h>k`#bQ1laByN~WX) zryEz)0Q3;&`r>9ydhKom5NnztxU~!0#vj#i|4z-Dadiv5`pX@hz)2DfvZ#&23HvPj zM^k~`xbOT+v7=~AeE<~iEDSk*aBAcsju%C-BpH?&wzZWt(H9sbMIG^A^Kt4I6MBFU zk2rMM&>9v+sT5D<UFOS1hx4p+_d9d7HC(1p#0%ulCcM=&z1FffG3k*wub~h&A25Jq$)qf01&CDT+ zNBW-?WWG*(^e(U=kp4q?$`cnr|Ii4=k3v1o`y!A?k(4T;=55fkPpA7l{Ca!BJqt1ThDG?>@TVPr^T zMJ3w)0PEG+bCDvZiZU`kPS4po!k=B!c{WcA@Ps`WHkSLi$2}wq8TyL=P=XuMi~zF? zKJYf6yaW}UOG_}z&)>p4TdZ@uA~g0=ML<0d6j!K@R(?|JogBw+@hT<@)z_Xy+9lJJ z<$ah4p8Rq`mfx0RYZvTh%VP9zXp{ zjLv)MR`Cz2i~uu2+t()1OgrH@)$4_{bbd%lf#WJK+l#ZGB?G7sy7IB|HMF)?N8p;-Rr9)(@R&)yGXCa_#dW2zi)Mr( zKKqL6>$uMr{kr_U&joJlT+!4}a-%aHS9qYvL846bWvuust!5!pa(Warm(lw{0y|6m zjUPstrr+t(rZQEhX19idl76f@uwH+HXU)suRgV*1LFHb7CUjXw?tXkDDR>Dv)nw|X zQ{s^@Sx_9a$UySeP*M)U0A`Hw#*2z3updJ`jGYPfDS#YZB)eV+E2ky{%4VMv8MA^B zTA&2**0o{<7p}}92d8d{6G81I@sk1k4$UI`jeE=*`hLq(UBtYu=xbZ{)AQ~x2gR+mF zBL2zHxZ{i1WdL-ts|Z|@B3TeWXD~H_tle8ze3?Lm4!nRoD*I-FFFCVYQLLeR0wa)7 zXqloF0JJ?(bk`?i9{`Q1!3TQ0)h~m$T}m$LfsT<%4@K>9Y>FdG*Chd%J*G{@c;>B3&AEYmlW$ z_Lek~%}RraEZ{SetYiJm{+X;m9LQ8lHfkIEs3-T1Hae&v!<0zIUIu>HJlX{62eSbFSX7B}ttIIms<-KSTkseLHkp~LA8|7) z%<|BXu>B%1`+ys{i%qQZr3A^0x?}}ji^Y`VLEmuZr%!(f+|Qu<8F^Sq)X7cE zuw|PyEhF2xviWZKAEvyvN5Iy-;us%buT-Moor*~Rwa`;m>K8)s1Ciq$JQ}8>J<=?^QMaUc zYu?k{rT6@#C{B$875jo>tfQ#%Mv`mwVrgY)Qi!sv#H~t-`4hWhWLUL_tL3Jy2}=v} zSjbt=r)Iin4r+Ld`Vw}PM5jQ*G}JPVMt%{z2=ZKX_;wC4N|w>Mb+w?4?c+lJTmjJ2 znV$cl{DMby+uQ5advdINT}m9w5@b#;FWat&wP{OMT-g*p^>K}sZ~4h7*O6aXdiUn5 zq*D(8SGy+o4;v0I3H=Qa^ry()! zDuNbxD>}$j?wvbgKljApMOvP;0;17H%3WpF^2!{eL^Jy?tTWQDFwx}(DeQZ*|SOA$c5l2MK!87J?adr zehB_VE7BTQu_Iorl6Up1_HAbALn7jOhM}B!xcM)FYf<=8k0Rv5J6ElDdI1XP=PB?C ze*e3tBy1PPk8`WFKMB%wXnfo^ec?YuzBF3Q{8lOmsEoOe* z@Ljj_iH#B;QgL}Xf=HLeQ>hhemH>U3gQn{nj2stQmkI4)oG$q;wb8|kC-0*w1V=)22VOFA$M-zZ zppTuu%?x6-Gn0)ocyNo;J<+HGmBL!vwe2k2%56+f=AYAMek(VxXl|07Utg#1iF_V} z6L_m}Lbr>UnA%+M%38a6`irf$MQOIh)nz3KyFF9p5be=@(GHC~y!A8}eZp(^yP(JZ z?$J+y-PKAGs2Otu2NGBM8`|3Y_Y?DOB^H%>3pfrAKGe1L>c8moj59exO_gsgu3Tg# zsERlQHf%Njto7}+1T`Hu8){yHqjI}__t_7vZHLYo2b(_`ltTx%OTSo|wCf^~s$OxF zbd8JSIIgcX(DI;06UM0bPz_ryhu)?B-PubekP}cO&}D2C=42F*AP(( zjG8oM!*m4!9X-1>%iafoMhOJmrxzyMk-czr#za@pq^TqwQO5(^1-df5WV^` zkt3sQhNrt?i^Hcw@3+~zS&hUPlW*QYHA1F$ zRRpz)vjb@tA|UVDTx^Q`AV@0r65n=dVp4(m#qsnx)~gtJTPVc|SMUjxJTbF`)>-yq z&i@2V)*u~pJiqLX)n>tCI}!uA50skKdg_Ibos8hG8si|yPiixj>VLz!)*7_Uq7>gACU1;Zp{JY@p@&BaU{yzpX zmQR19LRE)kroUMM8<77iJAg_r&0`-V665i4MWBCyC+*u%yh_;&Fhr%iGV7T4=I-?1 zy&&^9c;A<>aAB!NwYc;Q)$BT)eRm~>t!KUhDmlKe;z|N3I`Ngr%?yN^EW#vyDsJH?%Ppt#}_P@A~k8GpdhWs z*wQGm3mbh*m|(Vj?BkWXkgF%+F=^d=gVS|+g-{g&Ik}@m5mwmYzBdwIAE)%%my~1= zHKR<#%-<-XddK}>vs3&wtn5rkOj=ZhcJ*5hx zmE(JO(2$(mzR;))x#+qm4buA%>QnY~r0a9bn=ukHB5N}Cv?C^_*6DDO8W5;eLt1V*@cc;ryjf` z|EO*4yRvS9C<8b6$)@e*fvA>=H!{&`zc{TgThe#BBMK+!3E>S}z61QgHn_d!LgTPs zmd-40kR!aK<$QwXZ2}tTmFG&PFgyG(cTvYQ-hg4vjR)ZoW1T&{Tg-S0CQFTn=!X`y zu|$v5@tQ!#fjK;u!i8tM*RlgDa{~*p_1~HmGsenoOb&uSkqJy|;wZgqzqn5-C`sE% z0#Mt{CN7?_PE_e&%}eeQlcxnamMy~(9HQtFOO(YDvbHENc44}>J|PKnLE%I%j1D~E z0ptTxno{>`4JrEZNDNKT6YRCQ&r@aYaXYBk*|Z znT@vUP}A-)USYDnQ5$JwL26nKzNOrcHUuU+a86|uRn(kiI9)_kvGhv>ZDZo9K15{hZYaIYx$s7SqIWfZ|0)q?_HaKVo!AKl?Ho%>X|5R zAbN%hq`}}CIC*T<(NW3gxAk9PL&% zs)VWcl{({CvB-GnbfbSw4Wfdns`Nupb}W`2S54V5g{navyUd|=l7LjpmD_=c9A*R* zGmDD5Zv6>ec#cWmh|W929B=NKbS>-I$BKs+oFLA5i$|aXKr)YGd#50tKp^HvW%+a( zQpDD)xgjfK;tsB6j!!@5W!fFy!qG?^{j{UrJ1BbnsN(V5 zGVPf5FmmllI9-CuVtGMW)lGrI*1~Yfj;Ewg)f{}77;r+XgyO)mq2 z@fNU=IKA@C;DN_8YzpE!wa|M)V8<-duj>xr%;5f;lZy*_ zJmX^j_Q*e<)7)a7z`S^j#ODy?S@)OxX4iwUcrxO`r(Cwn{t1lfW26?I*Mzs26*NJ; z0qe_L7<(wS?C{n$e8v@nPuthR>*{BBg0WwI5iFABK4bXHiS}Xr{~ym<`M->CH6#9Q zgG(3Z8})*FiKj?O;bh7!>XLVNt^vBrWJU70zr*cv_iEzE^`z6hSl z>3MAYFX;MK8Be@;`%jc{hRyj-!99U{&fq73_IM|__sPlw43&t!MD0(f;{Chms$9V0 ze^42dI`>;X)zDKkRU>mwN@_jZ7bgz02jI}%pmV=~^b5K>J02_=&YIcoTh0}V(=$h9 z=|Xn)szbs%7kb~Tsll#^B%qx`WHo{dWT zqv-v0BZJB){U@6e$Pb0y=baK3d`bBUxx4XoatqJQicQoUolczw8 zl;bJy++OzD7d$iGyd|&wiIhIN0o?*tywL2+uFn1;i=3LCVdSK3K4sR~A-yG9|^miuFqFz}7bLv!h-N2!3=#QDYg%ZeDHBmC(D zs!>+wO-$@zkyB8#!TD(-W1>LvF9J^_5=5eOj#7J2JxbI)c!IbzKHpTjJ(^*Fx-c{r zkk!+V*ygKPnOp?aIE*fQz~)snV3CJDK6TaoCM1L4NfTk2#JkoplBu-WBK z=xvK+WQGz4Ckwg%&PFU1v>3To6`BOlwozw|UD;fxr~bQV1R*x--EWsLBgem8!bT>! z(t>n;5ls2H;LPW8ei2N*fzL@>9oXUe#(xpu32{U+xP~Z()ipwit5@&hquS353~Pjc zz1X|_7bEo6#N%zzi#FW6zYBlm{9p1qLwRyY67?0j1M)EPVfu{2$V_8NS*&dgZTkx2 zmcrG6CovY8H#yTdPBB1jBIPGVgyg~TC^*b)mfjr*^8%>CNDh)~JR6?md6D8JKAWDS z18M^#d4w$xhkX9k8xd&?Gh?n;wI&fNoWXp8FQ>VGOF*oQ=g|t zbC}kB?@2Pk+X9c&lGmJyx&T*W1q)197 zmFZe6lJXU&u+7zw3Q6u1>W@5yyx#+en=mom#(x?R#}@zitq(IPWVZ^TfleJ|KQdvDi?whzX2gzK`}hC&%zr&-(?w2m z?=ONiyyN}jp7Ve_>A#igdf@C@Nk1Rw4g^O0%6W~$}S zhb+8jXY$?HSPiJI78;lu*Q1*;C{?DBr0tx#+23g~RFACKtID|rDS7*}8&s5+Z$Tmy zVr3W+Px_b!0%E07iM`wq`+kRAfgpR4O82ny_-+&B)xtl`niOgWiQYH|nBQOcs7@#4 z+NrCr*S*l9p?UX_D)-h|Z1r1iZkD8_4}y|-Lay&QG_w=aig-BErzFOEhwtW%YllM@ zyllLUV}pj?K3P9A6}zj`asaof#}8LTQEzNEq?T^dm?R{lBs+ zj2Aqa=#{;VYJrH-`kq`d6ll!|aeiDj%>k&^(V*J{{oej%>D7?hx|9!rIGf<|!u47d){q(Qw1mG=Y!s2`a&50G z5|B-C%!NLsg?KU0N}>l++fX)L2`}Y5?oK2U^|S$8U2gvQcIo}>$MG*__|R5A9-~%P zDrRG#?b?$RpC^!H_OU*s3`k+MGaSAy;^&(k3n}mO$ z1Vooa{E@=G7s-1S5GcC8s3Q{a7ax0lGYJc7yjAv(3HRT#@9Ep%(`*0N>*uSm!Zg{t ze3AF6R{>0vy$@1Nlyq%CzUf?`5El2i%w7N^;h^u}ixf+q)CkT$34qn=BI%#=>L{Ca zde}91o`eLL0pvIs?bI1V-fEGq4astAa62U^J?&>{qkA~IGEYzceBsAUGMeVin7W2f z0gZYy%S2UE8ObUymUddd4_-!_4a}~JKZBl0mO_@sn<4`|ei3vCAJ!jJpO}^#rq2pz z7?6Gg0YnVi0xyk`6#gHzOZ%Am7C1|JmU(fwhd#X(LJkcnZ0fO8EmcnslMP!^JM9W3m4w2 z>qU08*>(+1tNbG78yCFP4qq@(e-SOvioX%BQ+>POEG@T1HqRErsC%>_on~;wQSL{{ zJbLU8#Y(xWwtDqVdLw|0E1$d2{v~p?4{sZJ>AVZQ(MpN-&m|XhFreQ>6j*aKlnPqk zW~kD{$hw$p>#4;+qS?F4U{7vn^XZi}a`E%rvsyG8itanGfnunBUj)zctigX6>>(4T z|Ar&;ph~Nkmoh!zb?`>tcfT&o5x&;_i=Y5s%VGE-lSp~Sd?|RTeeFyZoFFqMgS_wf zxL5fi7MFo5e0Px#?#7c*HeQR|Tb9Ae|02MLz&g)yy1xjPWbmULKcTsGfJdVkei2MO z-cWhm+i(&5i@*q6f*&_&^%ucC@PzpW;p1Msyga;llkfOC{_XglGxN>ZA$*+h8O+^` zqrta~`$cf+M{<7V{)=F*`O@hZ!RAYu6ui=l2tO(s2fsCU=l89N_YW?UnRYn~zid63 zwRC>F_=xkxf%U+3Ch53Z*DZXr+MP?{>4~i|f#sO%%gj;Y%)ZQmuSgT5rN--Jy#r&V z$P@=*t1)mJS0+6^>))J?2?+I{4mR{(Yo4!?xqI3>rR>%xO8qI>DOUZ{{pR_fFF!9I zK_~b=*Wz%Y(a%P>$qD_7srak<|CgSH(2 ztNT)t_>mTH3~p|C+)hTI;2ISA@OF_>~6_!Z3qE(qiym#F4Lqb9$%(k#o zGbS=%L$e7lW6q(1qHL?8_t|%%(pDTR+q8(`WGV}6jMh>2#fjLjP#bv?HXsTO#)WaK~6UM#|KR4@Yvpgfk}((`!`mujWFLcr~d7zh%~dJg0K0@4V9=92nr zJ^kN_zp_>H$ILXUL7DaS=e&rDa&hZg`U1X0jeomjeI}JSpo`QN}Aup+CDsHe}QMhIn*F6h-uaPT$S* zzz=$bOI-+eF(@5AgSxt71db(z3vY~zhiR2(OM5T5_uY0~765J&Wl{>Ldxsa3)0MII zGd1T^mQ$`E4q4Y*9}p+9z{EQkyu-12Zf_RcWkXRfnv1ias(v!BFA4_m;}ymyHGh-v zWFKpP{lj5=E?T7Q-%DKVKa9tIW4Zr$2;RJRl7YjQmfkegrv7-dxi6t?$sfd(ykLEI zk(-UU5@Be|kiaaqbhS>EIzGPcQ`LylGe)6cDng2wewIS3=-GUql||*3hg6c}VJ|g! zL@XN~vbShjYF}Gfo>Y2vIY+s~v;XL7RtP#RKcE7R2j#p5Z5`V(vayFAd>lVd4?{C) zxhWsKZq|_p@lSb+_T})&SH?$wqp-cn-M`b~TsHBjrJy*QtSCF%FUoG-ab!SCsQOT8 ziH+Jine6thr_@)B;E|Hgip(Y&CynP!kE~tik41>;y40D!er?`}6$;rJ?5f~a+V!QX zl3Z`i(OBG(CY~Jq$uRd*EQm%Q!0o)PMI4@3?Ye$1D}i=m+^uKVvUTvRJLE>M7`1D? zdG^u1b&Mjug_nDDe&2EI4(1!BIO@-Ba=0;^r|1$Kmvh>Qa500uiScc~P73Idz%#(c zrFv^!kn;iDtq zEuEhZT09k|F^})hVT;}a2W;QJL>X+>#i{}CAhh{z^czVx!MMSF;YSTbHGh*HM)NcrJwy3^}3Yt zi*wSt+uV9`!%sf_;lHM;@5Pr|_#Pi(OeUbeSb|5#-T&zE@gMis|1sbOA+A29q_d^2 zgn4efVVrczRdi?&ajXrfHN}oS4%j0)SUdH+^1R)te*|Ih;}^j&Z0RXNdtk`Px1KWM z*qr_iEW{?(QiFFmW~#qts^!pnV06dw$(DTDyFNi!op~vhJ#_;iUM+N7kI6QkBE(;_ zz#LuJrtPl7=8vt-hp65A^MlO57Q3$-QJFG_cQV-{H#m)@lb%jgtT`q@Tt5J55lU_NXgO1|IurgGNaPc6TRc zP7{e(>DUtk^7{GK>g&se{h*A0q@e$?-4Fo?TQ&OQ?)IgNl(9wB&Tb}4*pKZtr7#z) zwJ*<^tO%ggBVc^MWhl?T)ER#)ig$kBweMrfAV{4CHpst6y?I0VROXNGhUdWy|6di> zBB=5|`U?CjJotO}&p3fKDi;Cj@~i|oiuF8&r@*TBgyA9) z2qa445r)g)Wbdr%T(NH^FNrV4;AHrZ7iMF3L8+SHxg zfE+WVK`G~F{7HVF;!q6KN&1Vyc%6EDe3knPm6y_sfpIjvBx?)xQ5r5NS;~0ylZr*i zW1B3PE=R?75PPwu(<5itW?UK zB@ESQ!TL8;(xX!7vPHa+Xg1G8506RnD>J+G+ksXftR^lTP+J__QUvm@qkM(6|f>ZN&!6t9THF}kfBe#kbwH?eAtcQpzq;|You zs(`Qd;^kE1@URUHED6bbNm5+}TAsnJ|w$XJNU%w*Vr z^WlpnY#zGo%z(ZXtVYP-{IpU$JIX%JGoxYH3$b8Tlw#-QZ;hW~Ex}|^Z#}Nmklh2G4pqnFy1WF~bVs zJ;&z#8Y_MHKT#nTYIrDcR&~tIIZ0NGv)76@%LizY=bU|ert0_c*1w)4-tnnM59IXl z=|K7v$zvv6S@&SIgWbsjPoB$8*GY#83hL1v%Dj@8;gX&aL}fU5$&@DTmY;Ypb{|Zd zQy|ASj!vih;46=0r-o6yCuilg2rTrAg2HI6QnO*6t$C<5vJCmO!MvaX(VR8G8ohME@-xzm|v0=L%y)z-UBxB?q`>3AzC%gg99 z{q(0lfdJ2HmG^~CuLa*HTLwPINt>(nZjHVR)!YtxeQG{FSk{{#PPpzX#XYbIeuzqh zl~AiD11(^H79Mh60HmD-R7~Kw5M^ zZy)<`T14uvz<9&q<9|0W4*z^AB=hj`h|NmR8GzwR6KhEOW% zd_}9@g?Py3{E)J2H+oDN?y0tVx4bIP<%6GaAm#vGqfKs|K`>zXQppcy{(_01102zMQXv3{2l z**N`Z1Ls#0yMZq*&o3@%HatCFeh>`ngKf_aEsoFL4gF+or=9^eOw#tSKDh+?9Ur6n z@RFu?LqllW$eHg|_T59ZW~kVvlWm1^X+^kCE&6-(|3}?h2gS8*-J>KSfgnk6CqQru z?h@Rc1{wl{1{#MD+!G);1b2r<8X9X{6Wracg9dlE^E&6;^WF1R-QTPG$9q-pt)l1+ z)xE2G_g-twIp&ySyal5nd|F5^iUHwou+R0U)e}V=VCPMTYj*%0c}#vk``fFV#4tAe zsGGW_3q!L+%#erQtkFDetjLK=?~D0L`)<3;*K!F+YK{$GYdKNLfJ>YlS6RupXj15V3nS6gs@oaO?O=+P2MXeaWl{II=^R-KEs%j=ILEM zA-#0V#wCC&(^OmVuQSgCoe$fm!VWv?@yWPVBpozx+Rt-_sj)9$ccu9TgflhovI1V> z{t~v{va?&8++Q_d(lSxPwC)w-Ya2dzkSWRFp~4#SYszaGTh^}vQNr$R_`+ja7VIvM zuEu1zdOOOyR(z1leOaF%;nH0=krc)L8UiNS+d~V)(|@>l{aOj>7(vGme6FCzYFfP( zt$)idxj#DmK*n{EEPz&jv%LH=-Wc4xY&d!O+F;?wN%-DGZ06dom%EsTPwFSFMIQ$T zwEnknRYk9Fu>GIcG8a~TYL4eE&950-hXk1p#Omq-Hi+g5=|p>`FOIx(Z+X@W|2}DY z{QrkfS=J*$M@i_IIGRW8Wn156pJ;JpnB){wIx4<7dZ+Ctla#oxWccoP;3Pp{aD#j7 zLl3l(4QlSmu3tFV3eszAqMyKn5!W&r>&G-p(IrMq2&P<~3qx6}57&UKp~W*Kd@Xi< zFIUTWFw13z|0n(m*l84DcoAZk``8Wqi_D6B|DL4+VY30YICKJf9wsk2TYS1N**%2c z2nk)3)nUGtS3`ce2EU{Wo}TRb7_lQ|%STpR8^=-)(hVE=+CrNh#>VQ5zdU2vaf7$s z3mbrE&Y2?=Xpy21t+g_(lZa~hPtzsmbYt1 z%+(Sxb$$kibrZ#Ab0oB>7p=>%%QFo#mqXY-7~uxwl~pi6uiJi#D7(C2-Q_D<7RPHd zpD58?YMlYVfREJQ&L%oMsY?PNbcVtPXPoz^@4X%{I)nt@p1a)bXe(g9_m%Z=Lx9HK z6+CV_Sk`qrJ})Asb0B;mkPS&MF9CY~Zs%)KDlcnlHZ5*+**$W;I=@V!Y&sr^ zbZmLXE!0Zd;Ig=>8Niik5pl}b+Is8W4D*c#j4s~DK~ffe%#;n6t$86o=>|OfBuMtgZ0HF*{ z0E|`m^Qjn5lr7?Qs2>qo9vJh&E)4D6RS+&2y@z5HeEeb+kgbo=7}4~Hb`ACA+r z-|_-Ny4uvzP!#VhSVpolz;N_hjZ$52T(vou6qkHqNs< z2U-poYy6s=z7tw7+H2t-=JGdvji%MMR(U>;aEVS0Nohw?m&Bq@_YQfRJrf5tKlPG$ zdQx86)gB7(92vua(ynnmu-iXSL=i>^O(=kTWVJ5I;JhuaIa@}7$!2Ev>>8lYW>qz} zbi=!AXJk~nI|Y**@+`zJbeP$iT|8(_^rI-hTrucwbno>oO8UB#wrO!z%92ZE)}8-} z1z6M4xG-^Ux1~3IT&fbPh^#z3usaMnD7H7!ke5*O9UT0DVw~i~%92B_wTl$48qaYV zOY?1`!Su8_gpUV|74gj;EDL)N_xI-q;KsB8&)r3pZ})YfGAmt_H}enJ#==6Wr3yjp zb4Gi*J5$Iw`l;tIU4xFWtD&gcj&A8{ly>+<*7xNmai8TrE#d@$z2?Z-ziws$LmV>$%G;QWR>kVAfJ&@$*^a&wgh}kZK(I2bfN9aZU!br_`VKt2!sT1 zp1v+;fwKQPNtk(4gTGod_DfKk9fCE+rvr#fLrMdtaXdHF(M!DD)deRMrlXeWx}EX+ z8PvsC4)M%pyWLaPz|4usy~S!r%z3VKS;%Se|E?N zkmAEmRtgEPc5ZO5eLuNDHKeK8SHN7q4*8tO3G^hs)k z@pg(NN^*I8m#2e^6Sj5FEXb$Pnl3cF#RpbeeT~(EPmded$VDHmo^SH9X>)5?kt&^* zYQE%>1=|+z)#`vNHa3GnVuj!C#Mda>g3qoC{h19<>dZ_EjM3)=00o%iDN5M!M}YPaPE?QoreXiV%c2(tg!_x3OH|F@=i+d@$w=syV!vEh>D)ui0VAF%ws;Aaa;F9#U&dU* z?eM&2v+%k??3|sqDF&7*MaU(T0lgb<=UWtOET=bD(D!kC9LmpqZ4sZ^8$E2|Oed05 zjnS45;knBtCI%3Czc&E*a;tr9{QM zF0$bc>QK=&M&u9E8reaA$C9|ut73?YiL<$cPyY3&SH33m_~qnFp2IeTGqD46UmhC- zNf-|s%1vTJqQ$b|t4by0H*GH40!rDX3Uj|Dtqcggb`hf$;29{xlwJ9$!(^okZ<1c4 z5o=dG;hz6QHrQ)lX6CF2x|uRrR3d+G-JZxVu`3V3OnGoISMHYqPDP&zJyE>9-+~?z z?;?Il9K_x;GBNSmA^NjTNH*Pjj2f~XPO~AIO}>c^zts9(SG2|*F8s=Yq#=dmZWN3^= z|D|c!9vMQv_dwVwmHR5SoT0i=YBPaa?AM9Vk4gWy#o$qc4AK_G= z3{`M+H)}EraR3k9RKoXdc3h&6WoOG@&fAdN_;MWBn+qk(rDI%Q{t2-*U+icd+M#3)= zEkECkM7IIIrZoFfmNq61zhzJ!JS;EwExF%?{DSrIAuZ{A?ik}uC*5u?7si&gEq_GM z4;H~CN>VrXr&e$7^pnV1%Hxp4fG3JYQ-PowoP2;ICg_oQ*)Ea@8J`G5wd_9Vkz1jH`CER#vc%}C^?)|`FFv5v8RvF ziLrW!xWTvIKEB57pe>7nOW~~CWpZv@AcH zue5T9*<}q)O{6NY_Q!aG4uRzs3hFmfr6x&EOv;|bfBtZ7I{0Ce21KvSTn!F>iMOeQ z|9yo=f`=YY@{=q`Bbn?K32&%j8c;`DqN)bVm8@6Sk!X+PBJxJ1*0|VJmiMccG8N69 zDlk3Gz1gFR{et zeWU@MF&fk3RF7QbO_BQ<^$h1E&`G|F_2cabS++kn^+^O#c{Cnvrd=1R_1tW|-J6B*j?#sGoAsG~zqRYZnJnm<|Y zFd?g>RDAuQo^*D>uW;;jOH8C>;y-;$E&pB~nv-&q{&W@ykdK4E-4-8i?(v+8r}N4o zDGSKeI<}MMdxWIQvL{B}-tXwcy@juRgr;8QBedE8NJFi`RR4?jG{37#FCqiJH8&U- zr0wq7@DIT|T;Rb5_G#>hjtQ5%7*rS5Lj z9Zt_4cdy&SWxejHppS{S@M}Vx8o4HMC9wxcxcO8Z0DWj@RC8;{F42FtY7lAk;qE^* z2{$A%cXS~sk_`{%wC^8a=Qk(nnLsk&3F`+8YkX{erOohm8uR$&eLMfrrtaC7r88tR zG;N=asgI2}5)5VNUePa(V&IUN^>< zpnN&4ZK}t35uIi)`3;rlGYOGq+!!77h1JB)6U|>yQ<<1oVs%pm);~pQjK9;Is^*IB z<&4yrXW2Fa^+osvvxSTgpw`<_2*>{ru~2rg%Z)}g>BX7S*6yJY{{9BVy z1?|U{4;_$|(#oly-0>DHAA(iwUvfWu`Z#5keE!99Ap9#Y86l9|1oGJneJ$jX%=NqO zG~~@{V^eZWT*R`?LYkRd=7AEGDJy;idGkmZ{EQFH5#*x=%lv-z@EjZ48(+`ITXSYY zPW40^^hz5A1u#B^kRc>fJy1PcWj$o!<`kYgXCz5T7b#+n&~c|3RR~>s6mnt8*v%>s zLc#QytT5>$McvtU?^IIkHR~JjgHhdepHUEKYfVsS0~nM&#qZO9_B>IgF%t+P3UNv)pvHX`+7&Vj z-?Yss{Fp{qSk`G?T$qo+7{Sz)jg6hM>Mx+GHnhFHGQ{*nQH7lInG*{p3-hQ>L?_vQ z`we%FJgW>TvZ+34cfldxbrFdPggvj<(NvRH#f{h8ptf?tjF+7u6SgsODxNA>>0V6n#^6yc$>W_b2G!jf`US}wu^?#EIgnBQ_`nX zmih{`(I)BcJ_KCJo1}k&dbdakZF)1ZnN1 zJhs~b8B+6^-0w)&?LYYp+uBY@r-t>t<&1Kl$Z}l|%b(T>E}K4)bLBI`OBZv^Wep_- zytuwCZV04OkFs($0I)h3vnFE+2@~Q!vJZ0o!g%eb=JT8Jg{XzDd)U(U$dC1X7`}ey+!h9kw z+MF0TTayiWxfQB3M`e23r3S3J>JUu-{tj9hBnG8V`S1Y9B|KAx05Zs!B7+w_jdPQ^UUc731hFb)Q4YS-OAq6FT9;>dPCY?T<{9V zm4S6w1y;2;Fey{VHK42VL4b2+nwMh;TfBK{P;&?})jtQZl_EbBL515a_(lba?36vqVC;F^Ay|FrG#XYSt_ELcK8~rtyE01Avw{36 zBK3p}3v>wL8=MJ*t9`C7`kZOYlgH#wK?R!C=*A^?QhvhoMPGvOgTF3X^k?M&s;0D% z#?ry06OTyL#BEQ z!H+><*_-I=g(dl=Xaf4U@!XnfEYC5Oa0KGQXAfpHOC(|0fe2R)d=(@dS+~&uSK>cYaN06gU9EGirE%HL{&_-}SrDfw8akPzTKANa>%1AF~ z9mD>b-Y^GC2%Xp57W;V|`67w!_4liT@OX{~?ymYe@^MF1-fpp%hjY%r6Py03lIkrE zjB9XqAk7dxQ(PFI`+`ztf#SP)+aDgQ9KY%f*ey1N@s`re+L0mKw3evy%Xh~p7NYcY zLEjyp#hZ-qa8LEnN}jy>9RHbB)gCrL99}~;Iqs6UXM4y{mW*(-h1yTJ&e**kP>d4ZUSv+^3+mlJDCyI&m3CAD>J^OhkSreq}$0Fbe6MdJJF5`8*VUFeAz5{~bF zYgFL^qp68+k;Clz@Q*^Y?Po(Xj?5Q@h~9=g#b%TtgiE;0Ee)nMVlq_URlQ;c)}e??}F$FTD!R3da8$wlbR;PFxJlF3nHlqYlTmcemP@aCG!l z4OtuXoP{TU9a#?T-!~a@6k0?tHWFeLt9rg{IijXzOaaKlNr<9~A|=(h?4V-ccA_6M zCoh%rVw_`g|L`MHYxU*xjUfNjh}9>B4AIo>9a!RDH6}X}Kj6|lDM+Xyc_O;cB01u2 z*d9hM%dB3|;UAJM6f4N~j)7Zo)GVSth%C4#k&Ps}0X5j;Tlx@KQ^0=?*)0&T#rm4u zKl2%0(DNvf*ohcocn@F18`eucZ&(s<>PWiKNxCo6`vq|;W-!wJ2a3IE_>=;7b*%ij zyc{*&ChiudEBi%FDeE*C4ChVpn&950{1wGj&l@2lWmuSqR}@lQQoJ5PXQ|R&73(Sa zF+Mkm2~!EFsLEGAx1j%Ht5&OrqsXenBqz5t_?t!z&o?at0@e35)c}x5Zg#<3R|vVn z0AC!pz}BMK*R@EISnyRl?LKjAgxX;nh_k2g#EA%eu9Wcls#PDDwT7#hH zAR^{$S z^p})v$RwKCIo=_AQY4(+AM|WW-&T9W&8>;|_@m2K-_COHlbxm6wrTD~*eohx34u&R z1|6#9KgBt{TQDIU6Sci?^--O9PjsurSHMC3bT_kj8JZf!EM(8gT0?H~;|p@H2ZJI0 z9^{z{KT=YK^$!lF)%TUvejo#=+}!f)&W-Y7Ps=q3bI2fg2>o+E!Q|QS6PCd@Cdn+` zLMa}ht$aooG^CD}CA-pfak z0)R7qd-c==Uy{535jAm$^oA1^*v)z>dN%1XXTLy+c}bp-<sVYwWJa~Qr4lYXI%uO4X$9Bo9yocd*~1zm#dD}}^W4-Q_*kwmu9CDg9oWAH8656s zCW$@bfAu)R$d+kYt5?u5f_5&8x^ILUMjv5|Iw-sP!k(%t{kvkXveLCkx4-*}Yqp0u zHr40VWMGp_muj7=hYhCOOCq#{0+C7qf!XVyUHXlrgHvu@rtf! z^}=ilHISwT#7q9Ie#cq^&r-kpi!yec8KwcGLAJ0^OaWxebb33GEo2oG8m>amdqYWT z^)hgmw-wjwN_^Z51P$`teC}1oYd_2eiy`Sn38O#wU#rgOHzb+)bEA=QxbQr2!c+rtfZTH%~(m>a2P2LN0n&Hw)x|!*^W$C|i`!Jm(XT zatTj0@OVYfzs32bm=M|oBaIDpF^j=Fq%6R&`7L&^CY&?F3{DsN)N*WNiKO7oo^Itg zaor>-&fkPwv?Ph0zdA7g=1u?ocnpf2Pr`EvM}`yrn7G2w(ppxyZJW8wOeqw;AoR6M z!ru7kcVE&6!%Xo+p&gd}*UUGVXgySgUjkSBO~27rugkI?59Of`hz@13m=A&Bzg{#K zz79U|c6%5}JUwb#NM1eHRNkkJ<%z}VmA(#ae7qFi0<*#7{p~XkHaZ);>1kMt4EGm# zL(Y}!Vf+m~pnMcMI+IDELAIR}$F0n%*v&pxAFnC>?)tPQ0wpbDtFgvmgGCA8ua?&d z6?}~=w7W{2MVb1(OIjZ#Ewn2)vK}^9r2vZWUwSD&R;d2*+vD7lTxf3lE~%%oVoKpR8JjfgF!bia`3tvqT$}uUMQ;p5aB!A2{Uz`&IEmPqOio&QjDTuRCq?#fO z=^vLP-g+NJRfyrmh^V*g2vfG)OqH*U6jb4ARO$A~0kyQW)Kqy-Fg4SIGa1!*EGT4Hfgsn+J#!lc?$TQ}BQJ^~&qn)F3Wy=5M3#$+Of*#9*Yn*dDw~ZN`gJD> z5af(cG!zNiozb}#WY`xBaq6MCbRImcN>R1Zen@lVN-%{r?kp{0HOR%$xgYqzQN+Fqyj(W=;j?YppnCEHoKj#TpZg;aYOFLnP zh{WOuH2b%|c$HWedDQl*^W%-8_1up2Mt(6Y0m{rwo4&|wnuqe}IX$w}zVoDw z$M!%M(63WE`ahNqY_`9ue^))$kbGs``~=Az zT>|ZN+~XFi&O9@w9eE`*vpg;j;jC+lJ?^v)Q#TJbP&z<3B&%;1$U|sT7Rp4TGVEf; zK-74O{Jj4+1Ha5=#-a6~d2?&krU_c3EsT^hAaMm)*Y@uv%}rMlSlJCQSF$|(m7A1s z4mIv5ZBvr{$7lqjAo-olY&u+!uXX_bR)cVHfX$Hi^Uoe*y~z$9o`+LiP9?r1IdbRf zQ|&>SoG2i#91hT*i-ApNx`DI~;fSk*Zy{kU5sII1rp-nnP7!i;o+nP^FjBN_+OPkF zh@QXyJ|X1*4tq6)j4E;SB z#Xnn_Uag`!_atEyV_1(9;aPh`Y(@~D;5fZs<*<5o{HtH^kk(d{?&#s^Y7Ia|>6I3* z#8aF=&FL|%beQ2Q6{Q@joi`qe?>M|GH#wYeIPvHS^tq)z*B4tEhGTyWmdKAwsDNP- z$fikAX6)+oN7pw)^6)%}r8qI4V>VBv621)ts81&F%75;sett?9_TghHRVv=|9Kko7 zjDy%ASgD<5L!~8uvpxT{C;TI)wh+tx7r}J3g*LYy`Gg;F)|YXX814!a>>4nyp3C(t{t{`Tk`8j;I617+`zL3LM(4*R5Kzyg$4@ zH`jg7=h{-5L-3uG9aDv3IP;{(X2Wls59URZ3>!T)!Oq)jaU8+mLW6wG-PhH?UbhD*>hL_B*l7m-I?u}bA!fJUjX7S9qwYf2a; z-}QZ!BR){wBnwOCN=_;~l31EYE+9@burPMknWti_T|r*~RV{q+{j%0G797RZbxm@d zmG{KX01Y)|7Y*$U&aFRCE}R0$u?0e-SBZ_Nhr!8#@}vxeZ$Kj{RY4i;w)&Y(IEe+B z(Tuqqg@m7Z_$*2!7}dOdD*|mKV!Izv47G2kBwqA zcUFD_z^ERrHQkLIVYfF)!aCf!gAB<2GE|@>X8ZefDbvu)I}%`;Wk|E1P!r#ZfZ1tEb0lYvEh1CI+8DK+=CgO(){JH<;Z$qjZfbu}PE=cu>L#ZMsZP z7QXf*Vt6Z83(@$#`0i=CGgng^2n}Ta2TChCzvrOp!C`TtNTZik)z7J)s&Cb}n_ROu z#ToU|bXAb0pps0X5@2IV(LccBziw{-c*^X*W5fUBV^`eW>)*8|VuE-V^L>$m{z=YR z2WrDk;|hy;{%yWFU&tKsG=U1o=kQ8F@FzRFB(PB~TSKCLlTaLHqNjDk+DF$sbhCK& zJx>xkVxBz5-c@b|^jDkXMjxo3JW5{Ov_&``JXzHOT@y5yPgI?o{XMP9ZHwuMX2az~egc5J%i`fXb!~>GG z@31-{%!z2(1M6SoCe zq@ntgc@^xtJ6^=`d>Hp0)}?saVGRgP7ZTM zkm-w_o(Z3uLzfc5O9h>-30Q5N+EAP3u4AobVZXJzqrs|?CY=C%sJ74Mhj%{3&ZxO#_sC0EC3#`YW;# zIq%XAzhRTwZU?#=_sNn-J6GQSdY2^o_V`Md9WzYMm|Q~rI56|{O>2zt3*a4eqIi0|6>XYG1_YCD5 zR%!Zb$#Rv6)GvNoMGGDfnVg;L(ttoPiq1?mc=1m~Spt7@{@@&9^+Z3_RvDAm<;!15 zuf{(gHF;_rjBTj;nnj)$(v8Ao0(}y=Q5cja&y^t?Q%dzC563a)dOw#W8EpfPpnc0~ zyU0BCSy)wVF8KKd`c4oOL*EDM$8*{D-#;(Xk?8C7+m5Dl$#O9Um<61KKV=dp=y>cZ zl)?-VQ7wa(<$7$Og{gAVQLh|NN@~PJ1wlz3aI}Zb2sFEMS*MSNDYZ?`jyr<8a*0b= zppP~=)2oK{Y~u%krePH;-BGOA%!Vw?dhSN7II z2TWS8algI57I6{Lf8S_C2f`*Y;e6&+3krcpnbuU-@S2N?xO~ZP=s!=80`kP+;EdL$=c<48AFc_f}aBQoGeI z`RqTq0Ai5cq>1~h77NSfac0tE&*7omuUcw^jnA8IcMe(88jLuD!k>PZe(y31Ox<4v z&(+jirX+Ef~y(4?f~6n5sQEXbB#&&zHBquJsk&_qh+3l^+);9fEE)!@!7v(<*ASrrT?hW}zD$ z8xDo8R=abquk(Ya=!S7X_-BqQ)6MJ7hc;5^AQxo`!uK+4r-UQo?J#2O z=X`htx404_&&QaX73r}ib@cL~<@G(3vPNfiJV~qgKN77D=z=IXIWocg^R$8r4cT@T z;g*@TUP$Q%n=;J%;xq$>XGp{mqNf?@LP2|~g39q!32=KCNBHg)vo)~O)&sb#8R2nh z;R+hiwc%oaJ|HR`qdu*!i^Vgf!L!CaHqlA?!M}%|iGoO2BnFe4yVC0E*QHaA&-FxM z8&JmfR7g>A5Y(5&Kt}KQ`{wcXr}0U}b*g=jPnDLBzHjtCLj~kWd~en%sNTxMFe!QB z&+l(N&+K6YY(ht6W`5(8l9j?r)y2wnyO=|s-o+!eDneQY3E7AXC)dajAdf$HPWZr} zKJ^sc0+OjSsG`Ctu)NywX(0cbNJPKtbC8p^0!j}$xwi9EtjLsh_3>BUcN6ir_!C3q zc3BbagX|us3JG1Ip{a~1muL}I)j-P!v>xZ?oZw@7wr=;#xX9zOw@2SR1|TC@IsgLj z*Z(5A$m6RjEBZHs8kuVSv)r;7{;zUN$k})i($CyGzrqkpDW#;7P=)l(^oP&>w^Xni z7HV#M=-|W$8yQ@jxDv)x++7_F&Zk;IFnfN)bS(&x107tP*+$s680Z>&q35(fUvZX2j)pVsRfK3=&Ussmsevqnody9tcnD`@f%3+t zXBjLVwkuBYD#<({>u;y$grur5WfpOLk!`2EX|SzlY9aX=R$>^@G8| zAvd?3DYu!*l=z&>XV}5K6pZbn8MFB;n+>y`b2YrBBGXfK28}o5-mbe`KDG};2qgXT z6+hzmI>o8lEVHG_n}5pp50t^7N+9}UxN*mBs zQqjm1ibTC=4Um<}`}HW!Fu^77V|%@mQZNWWobi;-bX5*3QccU?J@412Dzeem&_UU- ztO$8WO1*A_&+@-$BQ=sAi%i>?w?nB{2ngRQ1$}*^H90n=qJWP`OFvTN8tN)1YvJLl zUo>&cl5jKO!itHUlKPOm{QAXfT^R!fEiD2S6#^+yQEg-*u0&zxdO0stKur&2a5X`* zz%F+)XRgCrxvSKf(Oy~6k^~6oybgY6qH_mIXKWB~P6rX^Ix$IxQ*#8W9CnQg%ELbu z-WB(sJLycG6wd(E324vpukt36A6!(l(PUC%E%I^QRUn_`R~Rx?&^5a|FfH(mh1dR@ z4PBV~e{blhsQ=v3H_!fOOD~91N6vAP{Q7wg9Xotd9#i2WDIATr6i>%=&;SHgn7KL< z+~nc13R|Iuvg*C}=PtPKybfJ*Lm3Mly~1}9J~py;-Kj-t&4*)GH@aGpwHDrGw}|mt zCk~#*X0K}zX59S37mE&V+YU{Iz5X3Dvf`yk8OS0LjH|5k<~r~h+=3!{5Sf zW*QM(wv(GXumVOv;@QU`zHX8Gt>r17go*LS1G87}g~6=9dN7)xtryYsF)Ci)Nq>ayT)zW}kU;PKjq6XL{ax z?*K2KuCxwLMzAzF-@Nu|Q6k)z*~uJfX>L)W;7c|9 zRkcR%TM{ybK|l#d;ZGx0+%cKhR8Xh2QDVaOt|io8VQ$4DTtP*H)-ld%wKY0GV{^{U zT)X5am=2ruoc#>9OZl;rqqh<^l;cUFfZiET&8NPE_2{R4U*^)!=j21mkZ81$hOwH4 z^2ec|Clq>Q;Ue!&rBE`feua`Bn=>xXwo7oJ%ik#}NcwKNGdmT=f<#9sv83#$`vf9@DB;#2; z+qW4`+NL3ZNMVDHHjhbKkIOsboTsfE{!tur+QGyUUTUY;A|cRsHfpuLu*McKh^tB> zt3nohswB^Nq`bGb)D(mf<47hf{^jxvrdKte)7*4$0KvLQC|h7Vy%rkNg@`t{_=pMb z%|jEPL?a`CovH1eV<vO6uA^D;Gzq^>I(C|S6R+L9SKb~_iyfeBb9`+C) z;4MCT4;R2NWWCBTP|go`sA||;Hatl}ORPp92ryId^M9naB&vVbTLGr!FpXJSh8E5x zn)qig+Cc0ow!^HqI`zMnd`5^-KSr3$qEx^Q5sXm=d`(SzHA^?_yITn2F2NeSx!PT1 zc%TU#(zj|qL^wQqAT%G`w$f6a_KnJV;yzbF(@Y!WPjdUQU)Axa2>+n{8KniZu9o=8Lq~#C@A{crm{788VsK;ieL>NZ(!~~y; zU@>6fk$cb;(r{Wt*%8YE4{Wau*ll>T1Y9-*?!@EP+Ah57vc5hn_7Fj1Ev#r`@}r|9 z83yS_3HJ>5ZS;VpgF|2&uFC?8Y0(jK^N%*Kld#Ix94*Epd7U+)<&ViNv=l@cm7lR5 zbm0x;lh?X^gug;?gU$>hi8h{)+Dg4FhLx3fg0jo=ORYV_8rB~Rc@Y1B(jFgyx}Quu zOVJg2E>`PVD)!$~*Pgw`tXyQlDJd>3%q@jLOG{G=bQ5ctLwv5Hq|jGM(XksghG^pV zSXcK{uY;uPj~2u@2&OoOM7-13@MCyYftV2{Cu38p+~iyp3L>W}`t};gK8yS}9$3SY zMX6$BD`QhXoyJW(DP>DB{GDRsRJ3stnB=hFnkMl{1KA8#NT}dba&P2?Ae+_k9WE*9 z6=TKC6{Nf%Dr3E>r36ya8pg_(v6!*l30&3zgWTXdnt|O6*Y6Tb66X~^ICe$3 zed%3<2}3rBiPa7sFhos{+K?~UV-J+ zxTBuADLIz){pxo|%o!^(*~eOB+)d+jC#gFh{!fbq&+o;8=+DK1He-}MfK+$0^xT7z10Jvfj9N8L1`K9v6>1hkkn*eD zS*>Bs6KkZ5RnXDjtV@Y`OF21Z5@X9su_60?-;#$Rgelja2Pv!_|GaXy3;}u!1Ob`TsY)WLhl#`2a$4Nh7QgTe;ljI){jC9XEG#DXU4Ho0aNBS{`VrMySsY|(b-!5#O0;8-64bco-%1qTx>ncYJmZ&6dVJ2vE=M_VUre=$Fx~e>><;t6a@|@B>+B~LidY%NX zXfQFv@e?6Y@4goVPaq5BI80z?*fH;}XN8)OI(SkAt?jGuHq%dNEO>zD^HcZhKphr3 zU@%bL z&Z~p>$9H6*pMqkq_m7Od2hzlM%tr=wG*VtZd)@SE^&|`vLF1T~Y)x+@o=#$B7n3APIMyvizi%qi8_ajl z)^JAlTkbGJ9!U;Z1Kzj!yej0XXvlYAk`ILL#eQLK!tWqW07?kgwpjPtR%mZ7T-}h^ zc2yYrep7-a=bOfMF5GVg9vHw|m+v2LuXuBdtiwJg^8a7$opn@P%l79vWx3 zr;FWns%r23`M&fsEwO93I&ArPb>wAXT&&m~z0(jGnzlI3Vz^x^-g$Lxr$y>MU)XyP z!f$P1pVqd`TIIA1@;qx;(&&&buZH~|PpV1uGn!!=IwkNgj9m}O{#5o!sX&zZRsP*F@?$pYr^iplsWH`uDGV8|9x?jL( z(L|iFN+<&E<@W%U>uFi))pW<6JE!@~1;>`LW0>4%3b<+k6V)8qzXvBsT!Dq$Xe^LzTH)H3m|BYTfFj)>MIQ;&yBRGYc zYuzp>_4;}EpmDg4VuTcrSvuI`!jj}Dqod&IwlsF%AZ~E8(jDU= zv#qVo{y?XstyaQCKk82GR%uZTtJ)O)+f5hLZaQ|KW!wHT{azL9Gje&{m{&D%4cO?0 z4She8a(VjlO2eh5;t0q?sRvL(-76ob%>@?y=ps%g(Iy9cgd5^r1?cw$AB_y3qM$hv zM9^b~y{8KXlA|jtSmOJ;ATX+RN%v?B!Y?zkSBePX`plTpEiDNT)6{bZdoqvxoK^l*?D=TckXoy@=gH-<>t7y`CcGwPv_+u zPt6Lf(AHxyn;Aqt4!oi-1#zh;x#p#bgNl4INvd23_O8mJGg;7R#y*9&??Gg(Zor1W zMLGT+>4-r8Cm?XtP$-9}d-JyRIfeu0@Xd63NS}3&AmYQyY27>O2^xo+%Suw#N&~iJ zs`}uS0$CJ}dMpZU-%7E!7DNe#Zy{*v+9Ua!rHzf0#@P9LDfS{?Rw9N-0+QOSH08EanP3tIl}~z|Wy=D06Y==Lw}xB|AHykz#rI zp5$ct+LPZQcC3udeYWIhrBBwILe}H^vA&zboz^>YU;fJXCB^ltl%=>ttl>g~Jg+*A zXPY9dw8ZW+EGZ}iwAkA2+sSlJ2njo$ckUNd(~BRxoD9Me=vQt!UhzlTtiv+w5BbOK zbKF{dS5DV~){TdB-`h^z^(~s2tNVerqewv9Po(on>WKFJ>~POyN6j!$TBCVx@z3dD zFSqH#xh1EH0o9)^eg-FTYB}s#!C*H3C1_v)i+&f>a%I-<2I4eN>7}|rPLnBGL(UZw zSFvqBUeO%jyJEL)=+N0TOU~DXpwn>Q zSHxcR`wfv*%i9r*JY9uUnT2VT-*a0Gj6JdbpvVmmLR-qz^xm@WzW@b@@wGo1s~t9w zf7%Yv>izrH=fD2@zXq0MXgpGK#K3rxzbMO<4*!S{B6gLc+t90wVs>+Uem14qwe8lc ztlblni>E-e59!0tYafMW{{}auQ+=^!XYGF_sa4tEVt{5JTp}rjmZ141vsjazY6O)a zMHL}>Ea{~k(9l6l&A2A0BCx0cX^Pv_WaV^z&ydp*pU!pRLEsQFAL3@?;qB@B7$Bxx zHdJY0KVB2?07Dbj<(4dV>9loL9W`1sC0-rvubP7C-O4qhYPIlO3 z@yzhceMP6ku31pPm^ljzWv%{GP5F~}>i+W4a)wv?@(-K+qwA&hy(Ji=a{i(^4Odrk zqV2NH>*_XZy2`#ki!5HmWU%>u>FRXWuC)1z!dQe)Anm=w^6~T!bs7`D)U^&1@#?BJ zLI?aXExyy6`^R$JaHiY`-BDwDrWics+hh*n0v|IPGcH%0#8oHrh6CVkpSb`OQui}1P^!|KZfb9P(}Prq z7fOvO{jSbN;oJL>)0`naN9f3^cVw){xj!&z`8hX-T1ix_lUO+bnITY z)9liIwpn2wf36ytp+MbzaL)KCSdNrA$$OGY5xi93h3m}8kJ|v{Vhf!p8;l+&ZlzFL zI(>Uw5Y7~LmSqucOc|}&=JsBURUf^Qp)j7M)1|ZByb4!^FhY^m#k=y&!u$gb%!bZ= z9@9$_t^IO2k{Y)tkZGoFL`~@gzd;QscVnO>#N;v3t7rb;E%?7z$$sa`hUM0Ot`&B_lYJKLD71wPG9)VoC8jc8> zVsBu=!T?rRg|lTbYH}<8e0o+d`}GRDA6tGxuOukW+S}DSw{1mPf2Po3&?$@YajN0> zGIV^!k%Ou%sX>o(GER;b?F18&*K*tf9F1(YwvD*sf1dg41rW-wzES`C0P#Ls%Ft`Q zv%H>aKc*n3E6i;mGD5Gih?ITpQ{an!Q}8?QFzp`Kp}Tkgd3sM@pbE1(=SslvwC+(k<9n#D zDcb^jSX$A1SCzJ3zo>*)$~5f^%wZeYgjxYmtpeI!#F&hY-B0rgD2Hbl@>n>wI2krn z734xX*bummh`NIGO-(0%fQ(PMn?K&)>^ZdQDkr`{8e8;q0Le>wE*xH)?~DhJyvT6U~eF2EMPX+g+eG(20q$E2Gs zyv6+ZymHR$ty4YPOY|WI3?^^iF762+ z3Tg}51F3(5Yl17s%+6Giz!Mc+%D1V;HOTee#+`}cN#GjT7^i>F&oR^TTKs_EGuTMD zJU`dA99>SUpfb7`kK9n6OHgB@u`62}1AfSr2%Ch`IyzU5NtvaNGqX1}1^ZE~_lG}C zY3)+$54>T06k8_RI1?J)JOiV2y*bJRrXyj4GIvb>(GcrVg(}Mp3GhI4mb9)EfsC2n ztV%zUZ%Ap{t7HJLhr0)Om-Fle9(ULeD>1G>=Rwi0=b4c`L5wi^i-|BZ_U7f)JfG@7 zYmucw`;6bMr}LaO+6{fXmSHsF7Ckn5uf_G4teLwAB~4% zEycOwtNvAoY7I-Oq5-XUh6_1X^_kueF6S*(!jqP~XV+WXP6i&iBY#~1o*i6?PwB8( z@M9{8Z+Xq)J6n0J1$gZ!u5(qQfAn8yj>W3DKP-Y;6-3$p9U@|^wtj9}@czPnYbn>~ zI5_?AvPpe)>G+L3TjuqyfZ>nRnJ2NG241fR<@R^2^Zc(>3*&j`weWZo+Y;o--jY=1+b+E4jI$!NW~cUhg{5I(J`?S&w0w)Ho(joIQwFOM4O7_vo&O76?6>tIAC^;NCcC(mPpu6t%OKgF!{jDNT zXA4cxtM%Qs1N~<6_SjO$ge5S&8m3%E?0V~U#!7*boahG8>4%9Z(2q?MysF{ME1TBg zu1DOHr;rDFV$?jo5q~{{Y^ocOY(#pP9RqykEIUUo^ZPv51-)xXwCx%o5Py5caCUl! zOfw%8%k2O00I;=wjwxFX3%k|6gP;4oBKe<}NyG;Y2@zI2nrT6?G=nIAgG+E_)4lB} z8KNwF7K5ogK@Doo!TE{-L-j%ou`x< zk>f(a6jLwl-{7*YwQ{bdqkuOafV(bBp>>P@7tYIR6MN_@zz-f6a>bZtRG9qeZ+2KN z$+?bPi9xKv#$yHGyc2;k#Of(?Sf;Ett-N2l5})sSeecp#8H8LFgO$BqUBxwJLn`!E z#sb+B#8%@HP^q$fT(*e0`W_b^Xa2$a_zR@_FFpwdV*{}R8@wMz zvkYm7Xf0FnAi-b)V??zN6R|TdZF^K0bTn9TD;UQoMh(J$wTl0(FcD#>sfOLz-6}f5dZqbQek;yZ5>*BPvL&YU%EHv<{b4oDIlT zetJ023?ubBQ0ML*Sn;^@24>V5&9RQm%2#l4b_Lvv`Wr6Qb!5j3r#&VVxi5ksYIn4IOu4({hj=;H-meJM_~`n zeE|HewVoVNBrk_=dFB{jAMgC!O*ms62A7SstxbHUtCSF?F79NOoEk~Ui5I1;rxDM2 zOo*C`wt1uW1#r@s{__vBbfjD~R`J|eTlzl6I<$gt>1Z8r-sjj5(Q|0}1XZAkp-$Jx zcL}0f6U2U>SF-&+bhkH@&`%h*i*MEy2cIsK2iY7w{oHiQn;SM-5a|XiVv@_KzmP(< zqD%Kn-F?NGOfeWkvELc!#BQhN0w#jLZh9Bc#7W_~j&K+pOQ6=0+Sra%L@w@^JMV<; zao%GKGLf7im(Cl1kOi>zW_}j=BqpRS(r@#Dmh)BluJ>nHGEh8GG%;r_lM7&+R8$9%p(K;N_oTOk; zT_f!MvlE%RpIR%2vzLKUinA6vEhSlK?*eM;eKZWY(#E`$mmR2~};EOUqawSx+w6RjcceI~t4 z&L^^-b4-=kiEGEJb>mU4bs^tey!cAr-{8pO6ZW35i24UF^&Ou`U^L8s?+7t14PM&0%E&iHdN70TYqGn-2G}D+&tjK^xNHjP&E% zUw8J07;bjeXW3R?%i0egSblVxeCBoeqr~LjflM;smzg!uRi8FG^}lzz)}ys`g-?vX zrDb2)p{?ghnd1B$h;(j_dGct0;dpxQW9Sr8)81ZFPjZI28*$$^68MBY8R;b|u|N;# zlHu8;n8dn@NzvnI~>KEx1kE3>N0xQ*W7XC zaClnwaLKk)ZpL2yl|FLXF{zxqd9{BAQBDshmL!GUy3OnZx~q7eVuw2 zWG58%dXMI|^*M%J{`;Q`ynoyW^7-SLAc@Mx-WH#HW^|m`k9u7LQ%KWe@2?O0k@p4B zT2wNDkwwl)AL*S^Ww`SY3_2XHYWSq13+mi0)7KGqSIS|pdM*N{>%#&W{2p%Sb@XTR zTKUjM8g56Kq_zN^&p=BO0}K3p?ef-{yuxA_wHKe*7YLlQA<)rtlQc;-DA!rNS)1}H zRBs>{U(>J*cd-4WPg4%LK+8W`a8QfkSOT#)-a`nDPC5iP4IxWWe@lD{0GLaVVV%7& zgKnQc+FjBH>(Not@VTE4;m`D8&o?QGTantjHTjzX3Ng4aL~Hbp*fm?#!7d^D3K6G# zTaeXN>>i7+`}ImUeKj?6rSX=w9h zI=_@L!t)`!n%Z-3=f7!;0(gLC7s?o-T=E)ZqHJ0ODg^)yUMDS;!2t#0=ved0Cg3!a zH%Yg28dgD4eV$zfe8}@P&yd`1WXFpMVTK+gl)iVR;4OABo`z8Sw=y#DVe{#oKbe%m z^L?Dh+)xF*2jr^23Rc5m=JTs#-z|AAEDIvlCcNTw9nA!jI%o|CTd70Lwxa+=rBy}w z1Mhp6sd7nei+9WoBtP@wZBq+dD=`f)gnLIWWePRcX^sQir=79jOZ&Mp72fqvCLJPy z^$T+yU>JVdOt+*6xXNkJv~)peK1F?M`uR2~aGlV(4Rg~wN0okpB~rWFfj)JaC{tp_ zdUMjgBQ=_JEj5-SrS|+e+tIz~`~T_)r=m(OcoH=weyx}?7r^qt416``E0jNFO-BYq z(wMQq==gadA-K->aVdtayK*hI3+w#uG$Li(U*a=(k$7W2o~Y(Uv8_gUmfZA8j#+}w zxroRPcgF=!#~_E`1I?9a&<0H8`07!jre%08C@<#s4CKcy7b`vpb0HPF249t-4E?4FpU7A}uvY_#k+bA5#` z5LItRn7xF%Tzd_-2>X05ML^QT0`#>ou*ouw)O`I+mWcPH2!3o&bf#1(hX&0JQhwkD z!EzI3{_1Ys+CZc)b@WlafeI$bDNR*=SS)mq0weDiNy2vZkq7{00ZukF0R}(Dsjlqi zTeMg`!XfLBXtkMwvCm}z4CjHl__J%W3^p1&fVt1Z_w>03Od?A0+<}G9fN9UR27@k^h}|&cv5`)oNsfIpWIk_!EgY8KH+K1i&7QwlkvT6P5BK@ zlJ>cxMY_e*;OF^;rmaBg{{7B#1w->!;rZtY!;-_S`^wy9kCLTP_b0a?VDgGu=wYHz?HsO;~}8o&jxdBu3gt8 zjMnEZu4k*n|4%gCY$-0LhWk-u?1&z=L!PDR1q!_DoG(#$aB_8C$ll*7p{?{bcXh^O z16eTy_(o+nr)1|Gdx086s$)sD6JL{AWD#zx#?JR0feB?i%}=MU#pF&im?4q>pIL zEGdOJg^f*t$jBsl@Dfd33pQ%CehBG<&7^JfpTMkNEeMvR#$qZ5q-kZZVY#*ybar0{ z&TRAkOE^!}?KFdxq!v2wen>!#x{~LFP#UAtb1jv6exBtBmolAC+p9L&>HHJ$Qz1hP0 z3US9Hy{&0}s&lN3Hn)1sz5cK0tp6mh_#bWqXFez|Z4-LW9_gcakJ8C19z%mG@EgfDK8=`H7RPsWrI;|cCAK`I*2(JY8>6NE4wU#$4`PDfZ+~(R zg2(`S#Ma)khKT*{tozRnq&Eq5cKiB#lFO6pMxW+j_VCeys6Xf04oCv8_Kfi`YDqGV zeXBDqyBY$^8P7m2YmXFlrYt0Ed@+9kLowe-Q5fE-`{ZHPDBn-%ZT7-AY8AK@G4Vk` zxRL?+FbNzlU8xIh2xS@QUk=ItLFrq?6G9hZkn9wb1k9KsrY%Sg{_#sFOJdW={OcYe zu9xZG&?|bmd2|iargNA1YewnLYd%an(u!9b)~s)=J7w7SId4sn7nSE*M(! zW_;mw$59EL5WQpV)2XEp(=d-m#Hk+tvc32Lw)03QB%nkDL?SwvO=|E?@gmA%%gt&H%G1dnkhYJ?^=dEETJtEpJ<{lz zn5d)|^ypR*L9R%O6TYip{*wM}MN)wi`ZAT9jg6l{$BdRZFxdJFSf+t^;2QTMR(B`n z)cnk(hORyzqpW_!3{o@-{UqJH`E+oEmZ3a3S3Du>fTm!xU8)Ar8)74>pWW&*J90i* z1pUr8v0E=V{l&`It@1PVE{I4*ej>fYdd;t|m$5w3^1X}x3Qt!3@=6^%B^^A%HJX}j zNiP2?3qNZenk-F35RON~G$9C$MNj{B={&5|#`zl@z1wSYQiB8AD5el(!IORffr9Qv zgLx9Ms^(d&Gys9#5h#q5L`4&T|CMQ6?%lK6-dh(`W-e3jya?pP!eA8GE-Kjhj^zo; za#)H|k0Kaq-mk^?JrmB8i?|Fl`>eW0*BygHuHNSzPHphw4KL0E%zvWFCZd8E!>5oU zQzwsyuiencqmA(XO{&Eq@KnYBB68n%MxN` z*}`0F=j4z_a&$taRqn!_RMLB4H%C6cx18EAsPiZw*sPk)*X~u6%EZzIryF^s|2K%< z-@Fha3#jtl&#KJXa%s4rcvUiGi~vz-pqBkvx2l@AebG2>WceGWNUBd4X`RZ-%HkNw zCR?19kA`47!5doF)c8o*{;u!2I#Vt%Y z_FJE2aDI9ZGdau4zG7H%1|is4KC<@zYep`80lz#gy`dx(lWvcZ&-R z{RWq9eWy#3hVew{fT;$!`3-Ic)9-AeH^bqz)#T1mfnUK-M3SG*o4DpkcmPRb9sCUp z*7&>16qj0yZJa6>hT<`;LCH6qFK~wJanxLPbZJ$iOWyg^-hLsb zPHoQrP{^7dJK>66`;}K^jE=;38+V6J+M?nyU4GCx+SXvJ%wPRrDE)mwre2wiYkQN+ zV1&8HxL_NGLZ~#ADr;kXADrCg2otG$J92auUjM#bxvkAcPg!t@0=~Hio;05RmaroNR-6^zW^7A0=M9^_@|pF$)W?U(<65F&(siz~Z)7Vjv+k z=qBUIX27;7$dpV#l+_>iru~4#5H%?0cJ_|Zj*iKJ#FErNzx?y%?Cii&qrRIWuSVDf zPHjWQp@3tz1cROZ?u(Fug9Z@ADoQ!g~50cwo z6-twAsA5PqxrY&CF38P*{SyjiIO&a{Z0WQ(;0AG>_W=M8!(CKCiSBRR7FE5>YBpvy z1tt7jTH5f4G6eNTjkolqo4Uodt>Cfa&pgOnBT=BOuH+-(WW3K9@pzfO<=!re@fWtL zmVcu!`+v7d1UeHVl&1N`wN7pzc{}Sp7Ur8q&5WVx!0*vFm9vlTL|%< z%`1;>d0eWl5iowo2Xr-)#q_J}KXq8U%ku<%Vxx@{d1o$rs)9Z)<`n}opJ$Euq zAWu!s(jbQOISnnKye0zohF&hUs5$2OOc)U(x=;6TgS61}UZyjHwIx_eok-Y`yVU;| zgc!!x{O1qqKjqC+4VEw>%y~l;;lRHd8o78HhR~1h$aGpdVFap%GDq4T4f50)*v=6v z&T{?|b(V5*D69W>=*(y~Qjf1b56>>k5<0^mm3KHp<)=;fgaI*5C|<%_3oc|4EmE48GJ)|B68oF0<;}PHj=n9^R}8M~!|@&ycEETv9$6=$0(Vg+pk6pA#L! zud%U;@0$G6;QifHo=Yk@YCbyosr2VkRS^s#j9OsJMdZ&jkpy*j$rGY?jtGZp3BYvjzC%pvz>tbbu7 zEla6mAM&mzhWrDPB-+q75PA~l7|jflb29b!70$X3WT?gsA5y2S?6i5_Z7}wKncl>B zO_Z@4K__R7K3UK{ZOK1OyO;m>h+ z)VGz`_d+I+8^M27qF}&!EZ77mAd0bz>8c|5)XQR0vucE!yRqisMm7ya=8jk9tX)CI z8EyvqZcFgD4?0=COj!#_8DmDUt766|C(9>iC9@l~uju0j`TGN+UDQk}HX#&9Az)Zw znJaW^ukkCdkI+}{?a}e31e+iG@`{DqNHf;%B)5YS(s`T9y%?J~C zLNhR7T(elX?@Gtn2+c7fj7!qt^V9%&i^Zitj7s)E)!c8fb+MF?dJk9h23+=SE&ag>OW-gxFx^i4U}U!A2m0ydsT z&c?D~{Ik22$jfBcuzkK=Cq*!8c*#&YixqzPtJ1z;(DrNm!VgUQE(Z{6+VLbt7gY0D z9=r@oIIwKBjLfxz#mQ;af{odRzj*bRsLlL=a>h+sH}Cz!!cde|88>LOr2Rw>4fNO# z145!l1q)`@2FMcfX;9#Wez@#5rkaJO-oKrS{Y0rXrY4=*pWa|{l4mE`qk&h#RbwWs z(r%QQ-;Y?xlqGd!f3~d2M8?uoNFzSHHkXHq8#$XIxLEs5|3YS-@Y4mD-V2GJXiWQ8 zqHz&tEaeX?kygP!ihNtzD$qW(Il~mC%lamDY`34)Clv?76a;w zA$lAyRLQLbq2fvKw@4IEY#dbMoF#)idsn2$eA}UATEVe`SxhOxz5yPp_YDb+;WTQC zggl^TbI7Or`1AOv*?sR$F zs@T|qm;9M0H0LBJZQqT?mzSb9LSfT>e~q6>IcEng!4Bf7?CNRq48*iT7vX74HVR{f zW0Tpj+11cJ-k%$cQM2ibwK?=A?5Y~(!87>dUp)D}kD2g4r7X|jytX(w7;^ll%x_+E zHX<}%h|Od?KU|NtNw!{^KTQ=y@2+mRC`}L}^s*jgHKALN{rHESr Date: Thu, 10 May 2018 22:44:09 +0200 Subject: [PATCH 09/57] Added screenshot to readme --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index a86ec50..0d3afac 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ Soldat PolyWorks ================ +![Screenshot of the Polyworks GUI](/img/screenshot.jpg?raw=true "Soldat Polyworks") + Map editor for the [Soldat game](https://soldat.pl) Requirements From ce00f537c19ba45fcdc72948c63220ef5e21e53c Mon Sep 17 00:00:00 2001 From: Shoozza Date: Thu, 10 May 2018 22:45:39 +0200 Subject: [PATCH 10/57] Modified description position and wording --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 0d3afac..4a8de38 100644 --- a/README.md +++ b/README.md @@ -1,9 +1,9 @@ Soldat PolyWorks ================ -![Screenshot of the Polyworks GUI](/img/screenshot.jpg?raw=true "Soldat Polyworks") +Map editor for the game [Soldat](https://soldat.pl) -Map editor for the [Soldat game](https://soldat.pl) +![Screenshot of the Polyworks GUI](/img/screenshot.jpg?raw=true "Soldat Polyworks") Requirements ------------ From 510a1b4b8918c710341bc361489daff2d00dbc7b Mon Sep 17 00:00:00 2001 From: Shoozza Date: Thu, 10 May 2018 23:04:04 +0200 Subject: [PATCH 11/57] Added optional resource hacker dependency --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index 4a8de38..83e311b 100644 --- a/README.md +++ b/README.md @@ -9,6 +9,7 @@ Requirements ------------ * Visual Basic 6 SP6 * NSIS (optional - for generating the Installer) +* Resource Hacker (optional - for replacing the old icon) Notes ----- From 8362ae9193308561da80e9c63b20a569f20523f0 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 10 May 2018 23:28:18 +0200 Subject: [PATCH 12/57] Modified installer dependency on pwlib.dll no longer necessary --- pwinstall/pw.nsi | 2 -- 1 file changed, 2 deletions(-) diff --git a/pwinstall/pw.nsi b/pwinstall/pw.nsi index e6c6e1a..55b2aa5 100644 --- a/pwinstall/pw.nsi +++ b/pwinstall/pw.nsi @@ -61,7 +61,6 @@ Section "MainSection" SEC01 File "polyworks.ini" File "PolyWorks Help.html" File "ReadMe.txt" - File "pwlib.dll" File "PMS.ico" File "PFB.ico" SetOutPath "$SYSDIR" @@ -214,7 +213,6 @@ Section Uninstall Delete /REBOOTOK "$INSTDIR\PolyWorks Help.html" Delete /REBOOTOK "$INSTDIR\ReadMe.txt" Delete /REBOOTOK "$INSTDIR\dx8vb.dll" - Delete /REBOOTOK "$INSTDIR\pwlib.dll" Delete /REBOOTOK "$INSTDIR\PMS.ico" Delete /REBOOTOK "$INSTDIR\PFB.ico" From 1721ef3690deee446102cb2efb50adc0d95b72ac Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 10 May 2018 23:29:35 +0200 Subject: [PATCH 13/57] Modified removed pwlib dependency --- pwlib/pwlib.sln | 20 --- pwlib/pwlib/ReadMe.txt | 33 ----- pwlib/pwlib/dllmain.cpp | 19 --- pwlib/pwlib/pwlib.cpp | 133 -------------------- pwlib/pwlib/pwlib.def | 3 - pwlib/pwlib/pwlib.h | 18 --- pwlib/pwlib/pwlib.vcproj | 265 --------------------------------------- pwlib/pwlib/resource.aps | Bin 34720 -> 0 bytes pwlib/pwlib/resource.h | 17 --- pwlib/pwlib/resource.rc | 84 ------------- pwlib/pwlib/stdafx.cpp | 8 -- pwlib/pwlib/stdafx.h | 19 --- pwlib/pwlib/targetver.h | 24 ---- 13 files changed, 643 deletions(-) delete mode 100644 pwlib/pwlib.sln delete mode 100644 pwlib/pwlib/ReadMe.txt delete mode 100644 pwlib/pwlib/dllmain.cpp delete mode 100644 pwlib/pwlib/pwlib.cpp delete mode 100644 pwlib/pwlib/pwlib.def delete mode 100644 pwlib/pwlib/pwlib.h delete mode 100644 pwlib/pwlib/pwlib.vcproj delete mode 100644 pwlib/pwlib/resource.aps delete mode 100644 pwlib/pwlib/resource.h delete mode 100644 pwlib/pwlib/resource.rc delete mode 100644 pwlib/pwlib/stdafx.cpp delete mode 100644 pwlib/pwlib/stdafx.h delete mode 100644 pwlib/pwlib/targetver.h diff --git a/pwlib/pwlib.sln b/pwlib/pwlib.sln deleted file mode 100644 index 4a86437..0000000 --- a/pwlib/pwlib.sln +++ /dev/null @@ -1,20 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 10.00 -# Visual Studio 2008 -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "pwlib", "pwlib\pwlib.vcproj", "{A9D9A3F6-F92E-4FCE-A91B-CEAE440281EA}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug|Win32 = Debug|Win32 - Release|Win32 = Release|Win32 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {A9D9A3F6-F92E-4FCE-A91B-CEAE440281EA}.Debug|Win32.ActiveCfg = Debug|Win32 - {A9D9A3F6-F92E-4FCE-A91B-CEAE440281EA}.Debug|Win32.Build.0 = Debug|Win32 - {A9D9A3F6-F92E-4FCE-A91B-CEAE440281EA}.Release|Win32.ActiveCfg = Release|Win32 - {A9D9A3F6-F92E-4FCE-A91B-CEAE440281EA}.Release|Win32.Build.0 = Release|Win32 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection -EndGlobal diff --git a/pwlib/pwlib/ReadMe.txt b/pwlib/pwlib/ReadMe.txt deleted file mode 100644 index d20fadb..0000000 --- a/pwlib/pwlib/ReadMe.txt +++ /dev/null @@ -1,33 +0,0 @@ -======================================================================== - DYNAMIC LINK LIBRARY : pwlib Project Overview -======================================================================== - -AppWizard has created this pwlib DLL for you. - -This file contains a summary of what you will find in each of the files that -make up your pwlib application. - - -pwlib.vcproj - This is the main project file for VC++ projects generated using an Application Wizard. - It contains information about the version of Visual C++ that generated the file, and - information about the platforms, configurations, and project features selected with the - Application Wizard. - -pwlib.cpp - This is the main DLL source file. - -///////////////////////////////////////////////////////////////////////////// -Other standard files: - -StdAfx.h, StdAfx.cpp - These files are used to build a precompiled header (PCH) file - named pwlib.pch and a precompiled types file named StdAfx.obj. - -///////////////////////////////////////////////////////////////////////////// -Other notes: - -AppWizard uses "TODO:" comments to indicate parts of the source code you -should add to or customize. - -///////////////////////////////////////////////////////////////////////////// diff --git a/pwlib/pwlib/dllmain.cpp b/pwlib/pwlib/dllmain.cpp deleted file mode 100644 index 8a4edd3..0000000 --- a/pwlib/pwlib/dllmain.cpp +++ /dev/null @@ -1,19 +0,0 @@ -// dllmain.cpp : Defines the entry point for the DLL application. -#include "stdafx.h" - -BOOL APIENTRY DllMain( HMODULE hModule, - DWORD ul_reason_for_call, - LPVOID lpReserved - ) -{ - switch (ul_reason_for_call) - { - case DLL_PROCESS_ATTACH: - case DLL_THREAD_ATTACH: - case DLL_THREAD_DETACH: - case DLL_PROCESS_DETACH: - break; - } - return TRUE; -} - diff --git a/pwlib/pwlib/pwlib.cpp b/pwlib/pwlib/pwlib.cpp deleted file mode 100644 index 7c0fd6a..0000000 --- a/pwlib/pwlib/pwlib.cpp +++ /dev/null @@ -1,133 +0,0 @@ -// pwlib.cpp : Defines the exported functions for the DLL application. -// - -#include "stdafx.h" -#include "pwlib.h" - - -// Converts a gif image to a bmp so it can be used in PW. -// -------------------------------- -// var src: File name of gif image to convert. -// var dest: File name of the new bmp image. -// return: -1 if successfull, 0-8 on error. -PWLIB_API int _stdcall PwGifToBmp(LPCSTR src, LPCSTR dest) { - bool error; - int wideLength, result = -1; - LPWSTR wideSrc; - ULONG_PTR gdiToken; - GdiplusStartupInput gdiStartupInput; - Bitmap* bitmap; - - // Convert source file name to wide char format. - wideLength = 2*MultiByteToWideChar(CP_ACP, 0, src, -1, 0, 0); - if(!wideLength) - return 0; - wideSrc = (LPWSTR)HeapAlloc(GetProcessHeap(), 0, wideLength); - if(wideSrc) - error = !MultiByteToWideChar(CP_ACP, 0, src, -1, wideSrc, wideLength); - else - return 1; - if(error) { - result = 2; - goto GifToBmpEnd0; - } - - // Startup GDI+. - error = GdiplusStartup(&gdiToken, &gdiStartupInput, 0) != Ok; - if(error) { - result = 3; - goto GifToBmpEnd0; - } - - // Convert the image. - bitmap = new Bitmap(wideSrc); - if(!bitmap) { - result = 4; - goto GifToBmpEnd1; - } - result = SaveTGA(bitmap, dest); - if(result != -1) - result += 5; - - // Clean up. - delete bitmap; -GifToBmpEnd1: - GdiplusShutdown(gdiToken); -GifToBmpEnd0: - HeapFree(GetProcessHeap(), 0, wideSrc); - - // Return. - return result; -} - - -/* - * _Helper functions_ - */ - - -int SaveTGA(Bitmap* bitmap, LPCSTR fileName) { - bool error; - int result = -1; - HANDLE tgaFile; - Rect bmpRect; - BitmapData bmpData; - DWORD dwNotUsed; - UINT i, j; - LPBYTE offData; - - // Lock the bitmap bits for reading. - bmpRect.X = 0; - bmpRect.Y = 0; - bmpRect.Width = bitmap->GetWidth(); - bmpRect.Height = bitmap->GetHeight(); - error = bitmap->LockBits(&bmpRect, ImageLockModeRead, PixelFormat32bppARGB, &bmpData) != Ok; - if(error) - return 0; - - // TGA header. - BYTE tgaHeaderTop[12] = {0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0}; - WORD tgaHeaderWidth = bmpData.Width; - WORD tgaHeaderHeight = bmpData.Height; - WORD tgaHeaderBpp = 32; - BYTE tgaHeaderDesc = 8; - - // Create the file. - tgaFile = CreateFileA(fileName, GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); - if(tgaFile == INVALID_HANDLE_VALUE) { - result = 1; - goto SaveTGAEnd0; - } - - // Write the header to the file. - error = !WriteFile(tgaFile, (LPCVOID)&tgaHeaderTop, 12, &dwNotUsed, 0); - error |= !WriteFile(tgaFile, (LPCVOID)&tgaHeaderWidth, 2, &dwNotUsed, 0); - error |= !WriteFile(tgaFile, (LPCVOID)&tgaHeaderHeight, 2, &dwNotUsed, 0); - error |= !WriteFile(tgaFile, (LPCVOID)&tgaHeaderBpp, 2, &dwNotUsed, 0); - error |= !WriteFile(tgaFile, (LPCVOID)&tgaHeaderDesc, 4, &dwNotUsed, 0); - if(error) { - result = 2; - goto SaveTGAEnd1; - } - - // Write the bitmap data to the file. - error = 0; - for(i = 0; i < bmpData.Height; ++i) { - for(j = 0; j < bmpData.Width; ++j) { - offData = (LPBYTE)bmpData.Scan0; - offData += 4*((bmpData.Height - i - 1)*bmpData.Width + j); - error |= !WriteFile(tgaFile, (LPCVOID)offData, 4, &dwNotUsed, 0); - } - } - if(error) - result = 3; - - // Clean up. -SaveTGAEnd1: - CloseHandle(tgaFile); -SaveTGAEnd0: - bitmap->UnlockBits(&bmpData); - - // Return. - return result; -} \ No newline at end of file diff --git a/pwlib/pwlib/pwlib.def b/pwlib/pwlib/pwlib.def deleted file mode 100644 index 182e78f..0000000 --- a/pwlib/pwlib/pwlib.def +++ /dev/null @@ -1,3 +0,0 @@ -LIBRARY "pwlib" -EXPORTS - PwGifToBmp \ No newline at end of file diff --git a/pwlib/pwlib/pwlib.h b/pwlib/pwlib/pwlib.h deleted file mode 100644 index bf8c00c..0000000 --- a/pwlib/pwlib/pwlib.h +++ /dev/null @@ -1,18 +0,0 @@ -// The following ifdef block is the standard way of creating macros which make exporting -// from a DLL simpler. All files within this DLL are compiled with the PWLIB_EXPORTS -// symbol defined on the command line. this symbol should not be defined on any project -// that uses this DLL. This way any other project whose source files include this file see -// PWLIB_API functions as being imported from a DLL, whereas this DLL sees symbols -// defined with this macro as being exported. -#ifdef PWLIB_EXPORTS -#define PWLIB_API __declspec(dllexport) -#else -#define PWLIB_API extern "C" __declspec(dllimport) -#endif - - -// Exported functions. -PWLIB_API int _stdcall PwGifToBmp(LPCSTR src, LPCSTR dest); - -// Helper functions. -int SaveTGA(Bitmap* bitmap, LPCSTR fileName); diff --git a/pwlib/pwlib/pwlib.vcproj b/pwlib/pwlib/pwlib.vcproj deleted file mode 100644 index 6298936..0000000 --- a/pwlib/pwlib/pwlib.vcproj +++ /dev/null @@ -1,265 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/pwlib/pwlib/resource.aps b/pwlib/pwlib/resource.aps deleted file mode 100644 index 5d0fdfd592e0b9f0333f476208c4f659ca2d3352..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 34720 zcmd6Qd7NBFb?%Wd25d`~@ghs!Bx4!N8-073>9#G&xBK3nX{)EZ>F$vlll;Ql0OOZn5+0DSCM;RNW)1tk1<1~OkFY0@`@U0k@2yjHtB1V* z-ssnwnfkt}TidPWoT_h#h&JMrB>ICNt*?Xl?NWT^X%{u|JxNxj_=P8@KhPr&5-nf5 zH#)j}{P2Mz$L`*^@5ug*qXWl|9XxW|-Ft7`w|w-Ly$dhgnB#kQ9=!YbzC#;F$Byqm zcywdARI2YC+;#Mh1Ix$m-rKtJ%DvCK=g`4h(*N%|aQD&UcP$^d=B{Oa-Y2)a`FUJr zqeM^3^Rr2XY@$5s?SxEE!og_Li+7JF!+6wR9Jb=g&ak@}Q&0-%X%cVs7Z$=^l)}|g z34~K^LT^0mck}qbPm}m)X(7&{bLyuPWqI0n>kE*rYdA-%Hqku?kLce{qE$Oblb!K! z)amyoonE_70X>~ob)wc}G!Dm|7F~XIu!Xj8ERH)_XtyTqPB-p_3n)lDq)Qs5OK1bF zYBh(WN!abo^(Ni8J*LtN0+gUj*ILlHKLCQN2XdW-3_El49E;1{rRy!M*&mPl3jpg1 z+-iYgZwW|SA=^@<*&jynFv~~@IqA|3Hl}k@LRPvI+EA9267teT_tRxd)6DZyLT0+u zvQeFx5^~d}D22xTes|m%jF3w-DS&ngw7W}9&U*>D=+ays+7HK*g+;_sSQXg3{gg_i zkUEe~ip+PS7!5e+hOJnErFxfcOu`|`g6&B$ z)vaZTOxDuAk>>3=X$0JGmbLs?s3`8phmR0oCZR1MLWVp~hzDh{8tkARKc3 zsYK7CRbhMgq!VFC8Vn}m&bZ5OMa-proxwU$H(rQGqi`-o1A4@u^Ko~u(2s0JnI1Ka zJnc!m(2S!P%GWjRx*FZ`2tSuP>6Q(VJAUc(BF%v5RA( zwdk!Tv_FV@Iyj)WnP9Z=NIfV(OZ<@uAB8*9;0pb*9XttDs|IL;w;N=DdYO#k@gk4e zczBK8A;4h=Z@EBc=$#I#W6jdLobXB1LCdN>7L@ArZWkU5(^;MXai^3jJjft7)uCA1q=s8mrNVirB2iX6W%E zR@c}pJyFCO8mrTXix_G|RZN3E;sMi|3F)IAFs+&F|)C^zV91{uX&yr!n0A${F|i@m6?v(cn)nBZZY1-Iy%DtH$P+2559 zVU-enTZV_jVc65-Z%_&7I}&S!qgEK{s;HFdZzMM6aZxQYxCd4$^tT06ttAv%rN5Kt zXwdEGs;JcH?-jyBdD!fy%~UPX_wwL)cS^1X^v^1kX9k`W`8<*sY2B50#l5x zs9K4Brh<7GotWT&ey)Ps{ow)@m~A{-Jz%DUl|9e$eNBLt-zSk6BtWS7GFEV{Prtv=QRS{+8a>O4r=71-nxV5*xp@+t@b00hhoL%(way^CL0cS6axkFt3^HsKuKx zP6T^Ix=sQMeZ4+w>L$VJV;3T=}hXIPKF`iWKAE@95Lgllwzg!A{Q zjV>8V1f~ouv~@Ai`H9 z-aqvg@Du=SmY!!YwPoYtX{=6n8BFikDT{pDZNb)j6X=5_SWo4ReF`6algTuZlab`I-MH*njqx)#rh6QaW%+k-VFUm zAFmrO_FD7Vz5w}}rC&EZjBxR=7veoc!i#Fo2Bl8FVJMm7!D2M%KN&_^xOBR}Tb-3H zq~A2G#ojQUL%G#P1P^J_t6k7~M2j9ac!Z$>=4Q;AsseP0Bl<0y(F6fQ8oMhrBc|Ur z3>W}MyoXV*B%5n~*Tv8@yg6WYfy;Pvs55@w{p- ztZm*{U_~9gk?loghiL~exI9*%=p`jwZ=o&^>@RPcM%p#RfUlocr9UXJ&|-RhW)iE> zA5N!<3vZ3&Jt*zx7TS(p}xXML0(MtuD7FGyvH+Wj> z7__kI?rD>2JE#Zr4#UCn4lfis<46tFLA^}xG-&$1sU<{!MZ&u>NH0Y(#>t0Q>D?KQ z`7IyFuxRbH)6{G99v?-IVY&!2^e2Xr4!XJF7ulbsKQ*{{ilo%(y*>(tCu~ggZXl>P z=zTsCFMiNrBr~M<`bhht`ZL3U>DCzD;(+` zT#xB548as%&pP@!ZTias1xt>O8ekO#D~`tvC3`Iu2LrLD1oVWVqz_Vz5v=K&Ql<|J z3QujlZ1fLH^ic=HLOmWT4`e$C1NxW)bA`40uq&#x!!mu`A#i8RM})9KpKx%VR!O^?= z?Y!oj75chEP$R2Jp-SIy2&mM|I@=DKHTq@|Z^6i;*7iYjhW@&Uk6QEb0(%&dz$|?$ zBa9~f7Hm7Mup2M-I^)q~0LQtqaJ7S0iN0fasdX+jv$o3^<^RE;>6rlZcfD9CV_^SB z10(GgJdXk{(?1!Q?O+0{(04OzFd03&n~nBr2<9S`G30;Wrf4G=k3m?;@8V9DRcIMA zzz=M4yf7FqA=U2U0#0{m+YS<~&<|~1yAyZOomJIM7CJD`VFuF~sM3#YZl~Lg=dhY$ z538os=*Koioq-r&P#N}j!I9f;V+PajY#H0kpV(xWPtsQrgEt%abfU147kHlJ>hv!* z&D4+Vu4POb|7sJtzVYmFf2>!Q<$6dzvnlcymWlR`9w`qJp!#gRI>n-{>n>*^k z5kHRsvoOn)>k%b3nMZ!iRcg!DQ^!NlcrnpQsR3PgnzZBCtTwH(Stu%&cp-XCI#8D} zm7HXAP`{IO2Vcw{_OVa0>8g5mmeFj_UW8*KL~yKOhp6XNO|8?ZHZ?u2!<`x?QC~S4bebJSzkb#3)beq-e_jfFW z!yS$>QD>t`t5;%UlMTCMT172dlW|8AU8EF==*$cmpu1q<+?#{JA3HNNAB=^2aH>e} ze9D+U*4f+$2RE7+zEy@WeVk{*sa=dqnVx@WmobT~w^?W{46%4aw6U>_S>z&{fjNSo zqRzbW5ZSEK#Wq8acZ)sC9$UtAvN7Y0CiCO5IbPB(M*(eiKpq=X+hRE?(`63K^FMd| zSUFITLWQ2`P_Q7Kw_lE^N|!q%ytd6wgjJ2Iwx~v19D>~~q8YlvA*34twa3wk%+i$( zhZE^6U`U4DE_+p?I$dRG82ekw{NL>Fp0Hg4zpB*uoWvBGAeAYYLRv^qsI|*+g~}NT z<0_^jJc~~^MA232dM z2%}qH)oP_mcV=KqwFL$N<>s%H8nd%>)PM`&98TjcA<4#Uot|d^<=%v|7JXKM4f-Vm z&Z|QV?Bqo}Z2Rvr&`t{q=xzh``VpM$t>H*VE7LK9jfd!XJ-i<(#R?sFp?I`QK~;Lb z3#kmkDR7Si?9z$N&cHhwD0lCG}Me9}&PUbvyE^cx1Z=8i^9wd4%FIwK78gC4wx?<#nfemjFZII)gHevy6zo?gZa z`nxu&&-pP_rPpK-4zy#a3E2-jIRa2nf$0hMj_9)=?phR|HB|ypI~9w#Nn+S1Y>uJ-sobx z=GmeNETG3+j2GHK%Je1|nH$DfMgXhOAGlak-CW>vqJQW@OEKI6yEtBr-t2-H7uPAcy|EJ(py|;ZisOLP@UfDLbz)%KhE$5z0JiVEOK=z(SiTShh`;37ye@( zo|YE9`0XyN9?mliXB?*--r*AX>88~10=(15NJ|d;|GOMm_eVDVzuO?AC73T4RKufp z1;H%6$ABC|tw3N?59qxD=(NV{`9XM@-e8macwVNHbZsSNfea$7nJ<{*;0#ohnap;=9 z?oyiLUOQ_+yqn+f;IND0(5cD=Ue0fN7YWT_Xc3T z1Y7hE2GsM6$wNf{Xh8Nxbwdn3%D0&rE#n}jf0{BCU>-by|I6@F z1Pl4pVH0Dc^1p2yn;7gd)j zq@>3pQHB}%fr0g?G#Ky&DqwZ`p$D6Y6GAZ#VE@Q)xS}U{^pJjBgzVT&`iY^WHE0rO z(NDdookm3eQef$sBD+S@#`#(LS3}aTyjl%S_(A~ifPUu3`Az`vGX31(SZ6jTyqQxN z&V}L7adv%2VLSok2ZP%&&WEka7z0?~)$G;^ak@-jh-t?#O`q&#@CgI;6wEMBE--j& z%cop5qeiC`7;FqSX1f?>=%*MC3|!i%-G^(OlXS50z&qhBIunq+p5JZ|k?!Om<jbAp zXGjjrQ@oYtWkr98V|GpLJdNQGTPt~r)F0=Ww!`)2-O1^%6&4V_zk6bS_~D-5?3Nw2t{PhC%dv$-;X9M+&Ij(e3&6z&Bb&~8jh-cGBV5#K&GX{L&O9!BNgD1z@l_`_ zUgP{a_A%;eGu(=^6g-J|Y_K%d|MU3l`1xb40d zx32fmG9AUW+P%0QeiT<%pGSAm0lFLi4$yvt4xnljMZmhB6$X+kn{hu|O{brx<@P?L>^bk>)-+q*6JCpZ6o| zD1O6TLHw($TDl7%cibYFQSK{AZ)bTxtc~I55{8`t$sp)HQrcY2p8U;2%Pow<3+bNa+Z^A5taa zw%&*E7a(nZ(*F+YtjQi@3uXCSqP2m~eWp|0Z-3>-3>ci*-MG7kFS0GS}Zs0UfyQNBo_hRb$7iH6L@Xvb5YI~$a zu<%H!EM%3yRdUiQByh6O3UQ@8P*qv-dM&PfSV(9EeG&EAXVHp2E|E74rlYa4A+f2b zNRU3RA}V}b0MTe(wE+>&w!1n2XCt+{0x`u*{aR85Mbr)_DebaOqI@hjwaW^`vC9g? zvC9g?vC9fX@A`yYwtxw{Yyr#dvIQiwR>E3Wz>HnC07<)S0W=m$*trU*vC9^q%qWDY!uaFGja{|?yLQ-t@sL#QygB=HR9w;5md7$lJMzC&aj|*8~Y8WvtWDD`R zkOjfxLKbMjg)A}4g)9J%3t6D93t2$C>vGJlPQ>k_r+?0_DZ6M*>MOR**mvET06D zfH83TC6K_uOvWQ|CP~45ZV{T=3gJmoONES_-&|)0x1gtY_drjV{yJ@S=`Un69FTM$ zpb_Qqgf+%UAc@rUs#&1vP9crT_nmc;>ApdPI}%8RMAIwgI=Y&AvZCeJT#(h!EgPJ( zmIRVWmoIHt5=a6oNFWKUAc0iCgancYOLcy%=Fw?(agdK|945fk~W0n_;JgN{@BjsQ&f#gXQi zHm#h<3+56?zL>cLk^^R%7XiF=8dBHGEeRwy+$aNOt*he*2_zZCNFa$&DS;${EeRwy z+>$^lfZ1_Du0EU>6u2#cWCKzHNgzcDBmrV`m`fmuVC>-1;H>eA5=fe!h6_CwzTjtJ zjs%j06(o>~sG1+SCUD@%LM;g-jT9u1Ot6$d(xE&v;5@gGKoa4$1d;$O2_zlP+j$r; zv+K(cO-fBKA|xAEeG*7I72drFt)py?;9*n*XLYNM*4Yi3IDiC_PR1{RWH8mg^^sFl zDj&0PFq9^%^3;NYahp@sZ$?o9$%&uZ;DrQ|As}H#0tuL2_U0$!@`;ZnkczM)f#e~e z9(mxwfnrZ|u1<{#6GZ-OH63bLbv7q!wggh~(TocTBoI(_d_un8(V zbRj89>0&~Z(uLqUN{#s>oCH#oa1x*;;UvO65>5g&nn=hbOE?LvAmJo2 zeXR>ovgugm-H~vzB1j1*0oW2w8qoe$%$%u~B5N*LNH+hl=8^@Zb_u1qWC2-cWX&Z2 zy0^IkOBNsnmTUkAQ;mj_==q%7f+MhG#pK*c1trn(IWFf>!m7)doaS#U3oKdbIs!`; z<_atc&=pt`kXK+y;JlLNg*N)O5?B&Y=77_XYM-nO1%V|I%@tS@P?n+;SQ0Q-8*86s z^`iuq1nv`960j6l%7a%DSjtJxohbYAJzvrg%;^G4f;3HFNl>sA_6RHqLUtM1E3hPZ zYW%eYmIUeuED6LBSQ3azk+(p46jcIC7Oa|y2~uFmVqgzc6j++VQ2ncFy$LD@=$7dj zuo488+{ohiR0#r0E^G@d2~=C_)KPRPup}62&gNNHWej&{1*XnKx&liA*OtC)rK$v$ z1S$oVM6fNeBmi4rNdN_bC4s43trS=iSb7oBpu)U~fs5629f2hgS;0PmCBZ2OED20K zydbb72-%4{zMCurmIR|Hup~gQz>>h#0?sF}Bse~SB>_(nSP~46z>+|V0!so^>tRuJ z+#?leHXKM17u*2yQCN&6JF>z8OP*9R3XXuOtAiz67|m(Z1(pOQRfg~gEO|+)^W@q{ zVy=b$YEfXxn?zAyNz&L@gu@-Sz>*~7x+ETfB`?n-uq1dG;k*J%f-*&5Nifn%^a(5p zR#9N70CGaP%9GlE>Zuy{aQy;HA_ZpPXqzjrBp3yOr2>XCX1Typ0Yp_v^(3qDbtEi=mDprOvK^kaw>9dlWX_zxj~~|g45L^H)%p1fu*S=p@<~b z$@$Z~0!zija+*j^tQjC?;1O67$)qqJY4-~(Nv=;|N#JQE6a|(9$0M*L(DZ%F1(tGX ziojBi=hcRXiS6fw6vL+!}w^M+!}CRzR7kh}s*-X|JsiV|27 zoT&m!f&;^RQ8pofJci)-1(pQCWZM>4DpCppOM;TUmaf2(prj8f2rNm8@`DJ0B^Q&z zJ2+MD!ssSOw>@H3oN-TS76D- zxlB@E$;BOkB^P!CmR#5oSaM-`iafw6au*i@O9CngEV-C$XB-H3VLs=bsrdv=tC>~O z1%V|ufr7x2OF*S&wqGT%3Eaik>Ah0BO9)Tr+^6_5$(WT7B3;iWgPb1tK zDhe!#*ad;59Gfn%FUiu;g%k0!t2MWq~D!3?UQ0z*3RN ziUp2dlQm(m)R3tk*z>>p4Yhj4B z1eP2I<_K3{$zkBQC_V$eXs>OOts4^toT>_Pt0# zE7+&D&D>qAe$=ux9_Kt zR2``|M4#u$-c&oO?64ufNzzQjvZm@%weh_0?R)Vw#yz+1Jq&sK-UHjW?>&Uf7oZ9Q z*)R`9-o6*G?kD;6d8=7-%)a|>4F>M*dy#Yo*|DwWPHRx!z847y)K0@108*Cc_Pt2T zd;5M0p5ML~xH?wCt}a!>xP9+p)|nK2``#>B(=58T@AEXQ`}y+reUZUiHhKHL$l#rV zwv(v5;`Y7Zta$t0;<>l)ZLoOz-opL2?=8x-+xI?_d;8wvVC}*N623g*-oCeZiX^XP zaJyPT}% zR96Yrsm9C|q8vnp+xJ!iQ*Yl}tZBFJEfN<7>pJedO7l8yT9!3dwVQhT-b#phNXWW< zZxK?f8hFLq_da6b_Pvk9^=RA)F>c@cSm_{P-@ado=-z-AtE|C9{n=R*b^7glD`{9+ zBw4jMG(Yg z9U+8pXC2Y-CGW!H&)Oe7e%JB={H1$37ud@2^(|%@{}~65EFU_)|G>se_TBmdBzDd1 zm#jV&={)Hdro{|9FC6jqlZiGWJV~Bp@+KkfzSds2mNq_X)5|t& zUjO0smz?{tb2py*k#jCS`-!tIJnKXJIs4+X9zW;ea~?l$(>YI^cgeX=tbfM34?q3F zvp$IAUbN;JYv{&%I&VMx<~x%kZ#k6Q{>Iyq{lB-I-13Hf$>g=qRiB$*KS}mKdP{Qq zW49)U-+CxH_Re2Q?s)8AvgW)sAHAq?@s;sQTFKmf?IgZ8O5zhyGWXJUGWeao`riEI zX41kZx-Uw44=*I$S9Oy1{juVoa>gm2-cUO?svn(AW)96H)jMj*MO!aO&b;)Dw_JDl z+V5R=tbwpfa{1_)$>|rI_UWs4UHzf$FWH{d4%d=ke<`6S)923(*0rh!t4Zb7APEix z$=XZTvPeS|A85a?^UL!{x0-BT*vw(~Tyx!(xA*VwC;Yr%8S$S&AKXyc(5&2APM&r1 zHOV!TtCBUF)-d;m(Ve4L9{kPQf4=vj=OnFttuLQ^^2z6H>uxLG{;J!4eDf=AP6qc3 ze!A(3O?x-bToP86E6EjmuE1wYvihRc9KU+Tx-;miYpQ~UFt2QA>e_eh3)hg`r zS#DvX%dfrshT6Vba@peMWb^p4FW^%#Y1<3{N4aq6%PT}}-TMu6UzW&3#WbT#iWbS2g68&nFY`=eda>M=GlI8

KpblT*$*?Ga3vWs`cP~p$t)T4ZsrcUq_IXY} z{d`7!e=7ap)bgpx>Y3Ha88sFE<6$>!pLor^$!1KW+`Blr6r7oxW|Gs-JpI-Ez5VMRe#^tj!*Bbo@#wpH8JhOaz#W=;ehuiztADrIaJTE= - - - -// TODO: reference additional headers your program requires here -#include - -using namespace Gdiplus; \ No newline at end of file diff --git a/pwlib/pwlib/targetver.h b/pwlib/pwlib/targetver.h deleted file mode 100644 index ad00983..0000000 --- a/pwlib/pwlib/targetver.h +++ /dev/null @@ -1,24 +0,0 @@ -#pragma once - -// The following macros define the minimum required platform. The minimum required platform -// is the earliest version of Windows, Internet Explorer etc. that has the necessary features to run -// your application. The macros work by enabling all features available on platform versions up to and -// including the version specified. - -// Modify the following defines if you have to target a platform prior to the ones specified below. -// Refer to MSDN for the latest info on corresponding values for different platforms. -#ifndef WINVER // Specifies that the minimum required platform is Windows Vista. -#define WINVER 0x0600 // Change this to the appropriate value to target other versions of Windows. -#endif - -#ifndef _WIN32_WINNT // Specifies that the minimum required platform is Windows Vista. -#define _WIN32_WINNT 0x0600 // Change this to the appropriate value to target other versions of Windows. -#endif - -#ifndef _WIN32_WINDOWS // Specifies that the minimum required platform is Windows 98. -#define _WIN32_WINDOWS 0x0410 // Change this to the appropriate value to target Windows Me or later. -#endif - -#ifndef _WIN32_IE // Specifies that the minimum required platform is Internet Explorer 7.0. -#define _WIN32_IE 0x0700 // Change this to the appropriate value to target other versions of IE. -#endif From e35a1ac340d04bb1a40a4d96fce3f08749b96614 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 10 May 2018 23:30:57 +0200 Subject: [PATCH 14/57] Added ignore list --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..69297fa --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.exe +*.vbw From fb6b8fcdd695a5889e16297c537a2d57e6c05bdf Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Fri, 11 May 2018 00:50:42 +0200 Subject: [PATCH 15/57] Fixed error on missing undo folder --- frmSoldatMapEditor.frm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 57d2739..655b83b 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -3533,6 +3533,10 @@ Private Sub SaveUndo() FileName = appPath & "\undo\undo" & currentUndo & ".pwn" + If Len(Dir(appPath & "\undo\")) = 0 Then + MkDir (appPath & "\undo\") + End If + Open FileName For Binary Access Write Lock Write As #1 'save polys From 12fef09741a40435726c1962048a7a560890cc01 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Fri, 11 May 2018 20:15:39 +0200 Subject: [PATCH 16/57] Added snapped subwindows stay by the main window if it moved (wip) --- frmDisplay.frm | 2 +- frmInfo.frm | 2 +- frmPalette.frm | 2 +- frmScenery.frm | 2 +- frmSoldatMapEditor.frm | 81 ++++++++++++++++++++++++++++++++++++++++++ frmTexture.frm | 2 +- frmTools.frm | 2 +- frmWaypoints.frm | 2 +- modSME.bas | 14 ++++++-- 9 files changed, 100 insertions(+), 9 deletions(-) diff --git a/frmDisplay.frm b/frmDisplay.frm index 218193f..510ae9c 100644 --- a/frmDisplay.frm +++ b/frmDisplay.frm @@ -621,7 +621,7 @@ Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, snapForm Me, frmScenery snapForm Me, frmInfo snapForm Me, frmTexture - snapForm Me, frmSoldatMapEditor + Me.Tag = snapForm(Me, frmSoldatMapEditor) xPos = Me.left / Screen.TwipsPerPixelX yPos = Me.Top / Screen.TwipsPerPixelY diff --git a/frmInfo.frm b/frmInfo.frm index 8492f83..406d872 100644 --- a/frmInfo.frm +++ b/frmInfo.frm @@ -2027,7 +2027,7 @@ Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, snapForm Me, frmScenery snapForm Me, frmDisplay snapForm Me, frmTexture - snapForm Me, frmSoldatMapEditor + Me.Tag = snapForm(Me, frmSoldatMapEditor) xPos = Me.left / Screen.TwipsPerPixelX yPos = Me.Top / Screen.TwipsPerPixelY diff --git a/frmPalette.frm b/frmPalette.frm index 982f3a7..8b59c6e 100644 --- a/frmPalette.frm +++ b/frmPalette.frm @@ -1081,7 +1081,7 @@ Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, snapForm Me, frmScenery snapForm Me, frmInfo snapForm Me, frmTexture - snapForm Me, frmSoldatMapEditor + Me.Tag = snapForm(Me, frmSoldatMapEditor) xPos = Me.left / Screen.TwipsPerPixelX yPos = Me.Top / Screen.TwipsPerPixelY diff --git a/frmScenery.frm b/frmScenery.frm index bc28712..c679410 100644 --- a/frmScenery.frm +++ b/frmScenery.frm @@ -589,7 +589,7 @@ Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, snapForm Me, frmTools snapForm Me, frmInfo snapForm Me, frmTexture - snapForm Me, frmSoldatMapEditor + Me.Tag = snapForm(Me, frmSoldatMapEditor) xPos = Me.left / Screen.TwipsPerPixelX yPos = Me.Top / Screen.TwipsPerPixelY diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 655b83b..a953d3f 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -14848,10 +14848,91 @@ End Sub Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Me.WindowState < 2 Then + If Len(frmDisplay.Tag) <> 0 Then + + frmDisplay.Hide + + End If + If Len(frmInfo.Tag) <> 0 Then + + frmInfo.Hide + + End If + If Len(frmPalette.Tag) <> 0 Then + + frmPalette.Hide + + End If + If Len(frmScenery.Tag) <> 0 Then + + frmScenery.Hide + + End If + If Len(frmTexture.Tag) <> 0 Then + + frmTexture.Hide + + End If + If Len(frmTools.Tag) <> 0 Then + + frmTools.Hide + + End If + If Len(frmWaypoints.Tag) <> 0 Then + + frmWaypoints.Hide + + End If + ReleaseCapture SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + + If Len(frmDisplay.Tag) <> 0 Then + + frmDisplay.Move (frmDisplay.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmDisplay.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmDisplay.Show + + End If + If Len(frmInfo.Tag) <> 0 Then + + frmInfo.Move (frmInfo.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmInfo.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmInfo.Show + + End If + If Len(frmPalette.Tag) <> 0 Then + + frmPalette.Move (frmPalette.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmPalette.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmPalette.Show + + End If + If Len(frmScenery.Tag) <> 0 Then + + frmScenery.Move (frmScenery.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmScenery.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmScenery.Show + + End If + If Len(frmTexture.Tag) <> 0 Then + + frmTexture.Move (frmTexture.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmTexture.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmTexture.Show + + End If + If Len(frmTools.Tag) <> 0 Then + + frmTools.Move (frmTools.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmTools.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmTools.Show + + End If + If Len(frmWaypoints.Tag) <> 0 Then + + frmWaypoints.Move (frmWaypoints.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmWaypoints.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmWaypoints.Show + + End If + formLeft = Me.left / Screen.TwipsPerPixelX formTop = Me.Top / Screen.TwipsPerPixelY + End If End Sub diff --git a/frmTexture.frm b/frmTexture.frm index a5e1dcc..453f455 100644 --- a/frmTexture.frm +++ b/frmTexture.frm @@ -275,7 +275,7 @@ Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, snapForm Me, frmDisplay snapForm Me, frmScenery snapForm Me, frmInfo - snapForm Me, frmSoldatMapEditor + Me.Tag = snapForm(Me, frmSoldatMapEditor) xPos = Me.left / Screen.TwipsPerPixelX yPos = Me.Top / Screen.TwipsPerPixelY diff --git a/frmTools.frm b/frmTools.frm index b8abd22..f1cf68c 100644 --- a/frmTools.frm +++ b/frmTools.frm @@ -373,7 +373,7 @@ Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, snapForm Me, frmScenery snapForm Me, frmInfo snapForm Me, frmTexture - snapForm Me, frmSoldatMapEditor + Me.Tag = snapForm(Me, frmSoldatMapEditor) xPos = Me.left / Screen.TwipsPerPixelX yPos = Me.Top / Screen.TwipsPerPixelY diff --git a/frmWaypoints.frm b/frmWaypoints.frm index d392d94..d8d0902 100644 --- a/frmWaypoints.frm +++ b/frmWaypoints.frm @@ -634,7 +634,7 @@ Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, snapForm Me, frmScenery snapForm Me, frmDisplay snapForm Me, frmTexture - snapForm Me, frmSoldatMapEditor + Me.Tag = snapForm(Me, frmSoldatMapEditor) xPos = Me.left / Screen.TwipsPerPixelX yPos = Me.Top / Screen.TwipsPerPixelY diff --git a/modSME.bas b/modSME.bas index 9a4b6cb..3d4141a 100644 --- a/modSME.bas +++ b/modSME.bas @@ -472,28 +472,34 @@ End Function -Public Sub snapForm(currentForm As Form, otherForm As Form) +Public Function snapForm(currentForm As Form, otherForm As Form) As String + + snapForm = "" 'snap bottom to bottom If Abs(currentForm.Top + currentForm.Height - otherForm.Top - otherForm.Height) <= 8 * Screen.TwipsPerPixelY Then If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then currentForm.Top = otherForm.Top + otherForm.Height - currentForm.Height + snapForm = "snap" End If 'snap bottom to top ElseIf Abs(currentForm.Top + currentForm.Height - otherForm.Top) <= 8 * Screen.TwipsPerPixelY Then If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then currentForm.Top = otherForm.Top - currentForm.Height + Screen.TwipsPerPixelY + snapForm = "snap" End If End If 'snap right to right If Abs(currentForm.left + currentForm.Width - otherForm.left - otherForm.Width) <= 8 * Screen.TwipsPerPixelX Then If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then currentForm.left = otherForm.left + otherForm.Width - currentForm.Width + snapForm = "snap" End If 'snap right to left ElseIf Abs(currentForm.left + currentForm.Width - otherForm.left) <= 8 * Screen.TwipsPerPixelX Then If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then currentForm.left = otherForm.left - currentForm.Width + Screen.TwipsPerPixelX + snapForm = "snap" End If End If @@ -502,26 +508,30 @@ Public Sub snapForm(currentForm As Form, otherForm As Form) If Abs(currentForm.Top - otherForm.Top) <= 8 * Screen.TwipsPerPixelY Then If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then currentForm.Top = otherForm.Top + snapForm = "snap" End If 'snap top to bottom ElseIf Abs(currentForm.Top - otherForm.Top - otherForm.Height) <= 8 * Screen.TwipsPerPixelY Then If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then currentForm.Top = otherForm.Top + otherForm.Height - Screen.TwipsPerPixelY + snapForm = "snap" End If End If 'snap left to left If Abs(currentForm.left - otherForm.left) <= 8 * Screen.TwipsPerPixelX Then If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then currentForm.left = otherForm.left + snapForm = "snap" End If 'snap left to right ElseIf Abs(currentForm.left - otherForm.left - otherForm.Width) <= 8 * Screen.TwipsPerPixelX Then If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then currentForm.left = otherForm.left + otherForm.Width - Screen.TwipsPerPixelX + snapForm = "snap" End If End If -End Sub +End Function Public Function GetSoldatDir() As String From c36800a4af3037d0f317a94b91181fc653dff7fc Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sat, 12 Oct 2019 15:25:14 +0200 Subject: [PATCH 17/57] Modify relicense project under MIT License After figuring out the license situation (Anna Zajaczkowski released the original Soldat PolyWorks v1.4.0.17 with source code as "Feel free to do whatever you want with it." https://web.archive.org/web/20191012125637/https://forums.soldat.pl/index.php?topic=174.msg214342 and The PolyWorks Contributors (Fryer, ExHunter and Shoozza, Zakath) agreed on the MIT License https://web.archive.org/web/20191012125244/https://github.com/Soldat/polyworks/issues/8 for applied patches to the v1.4.0.17 source code) this establishes the Project License under MIT License. --- LICENSE | 22 ++++++++++++++++++++++ README.md | 7 ++++++- 2 files changed, 28 insertions(+), 1 deletion(-) create mode 100644 LICENSE diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..409fce3 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +MIT License + +Copyright (c) 2006-2007 Anna Zajaczkowski +Copyright (c) 2009-present The PolyWorks Contributors + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md index 83e311b..aeda5db 100644 --- a/README.md +++ b/README.md @@ -22,4 +22,9 @@ https://visualstudiogallery.msdn.microsoft.com/00cc8ff8-beb3-4f08-8aa6-59eefba3b License ------- -Unkown +MIT + +### Note: +Soldat PolyWorks v1.4.0.17 with source code was originally released by Anna Zajaczkowski as: +["Feel free to do whatever you want with it."](https://web.archive.org/web/20191012125637/https://forums.soldat.pl/index.php?topic=174.msg214342) +It was subsequently relicensed under the MIT License by [the PolyWorks contributors](https://web.archive.org/web/20191012125244/https://github.com/Soldat/polyworks/issues/8). From cfb183eee3e11d78f9983563662230e8dee44456 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sat, 12 Oct 2019 20:24:30 +0200 Subject: [PATCH 18/57] Fix use $ suffix for functions returning String --- frmColour.frm | 4 ++-- frmPalette.frm | 4 ++-- frmSoldatMapEditor.frm | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/frmColour.frm b/frmColour.frm index 33fa6b5..a807d41 100644 --- a/frmColour.frm +++ b/frmColour.frm @@ -1213,7 +1213,7 @@ Private Sub txtHexCode_Change() ElseIf hexValue <> txtHexCode.Text Then If Len(txtHexCode.Text) < 6 Then - tempHexVal = String(6 - Len(txtHexCode.Text), "0") & txtHexCode.Text + tempHexVal = String$(6 - Len(txtHexCode.Text), "0") & txtHexCode.Text ElseIf Len(txtHexCode.Text) > 6 Then tempHexVal = right(txtHexCode.Text, 6) Else @@ -1249,7 +1249,7 @@ Private Sub txtHexCode_LostFocus() If Len(txtHexCode.Text) > 6 Then txtHexCode.Text = right(txtHexCode.Text, 6) ElseIf Len(txtHexCode.Text) < 6 Then - txtHexCode = String(6 - Len(txtHexCode.Text), "0") & txtHexCode.Text + txtHexCode = String$(6 - Len(txtHexCode.Text), "0") & txtHexCode.Text End If hexValue = txtHexCode.Text diff --git a/frmPalette.frm b/frmPalette.frm index 8b59c6e..acb3ed3 100644 --- a/frmPalette.frm +++ b/frmPalette.frm @@ -605,10 +605,10 @@ Private Function getRGB(DecValue As Long) As TColour Dim hexValue As String - hexValue = Hex(Val(DecValue)) + hexValue = Hex$(Val(DecValue)) If Len(hexValue) < 6 Then - hexValue = String(6 - Len(hexValue), "0") + hexValue + hexValue = String$(6 - Len(hexValue), "0") + hexValue End If getRGB.blue = CLng("&H" + right(hexValue, 2)) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index a953d3f..07e20eb 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -5141,7 +5141,7 @@ Private Function ARGB(ByVal alphaVal As Byte, clrVal As Long) As Long End If If Len(Hex$(alphaVal)) = 1 Then clrString = "0" + Hex$(alphaVal) & clrString - ElseIf Len(Hex(alphaVal)) = 2 Then + ElseIf Len(Hex$(alphaVal)) = 2 Then clrString = Hex$(alphaVal) & clrString End If ARGB = CLng("&H" & clrString) @@ -11183,7 +11183,7 @@ Private Function confirmExists(FileName As String) As Boolean Set tempNode = tvwScenery.Nodes.Item("Master List").Child For i = 1 To (tvwScenery.Nodes.Item("Master List").Children) - If LCase(FileName) = LCase(tempNode.Text) Then + If LCase$(FileName) = LCase$(tempNode.Text) Then confirmExists = True End If Set tempNode = tempNode.Next From 3d16bf24dbe55c9452a6d3970dba9c1cdcaa3192 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sat, 12 Oct 2019 20:28:20 +0200 Subject: [PATCH 19/57] Fix use Sub instead of Function when not returning anything --- frmDisplay.frm | 4 ++-- frmTools.frm | 4 ++-- frmWaypoints.frm | 4 ++-- modSME.bas | 16 ++++++++-------- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/frmDisplay.frm b/frmDisplay.frm index 510ae9c..3aaa36a 100644 --- a/frmDisplay.frm +++ b/frmDisplay.frm @@ -521,13 +521,13 @@ Public Function getLayerKey(ByVal Index As Byte) As Byte End Function -Public Function setLayerKey(Index As Integer, ByVal value As Byte) +Public Sub setLayerKey(Index As Integer, ByVal value As Byte) If value > 0 Then layerKeys(Index) = value End If -End Function +End Sub Private Sub Form_GotFocus() diff --git a/frmTools.frm b/frmTools.frm index f1cf68c..0eb6452 100644 --- a/frmTools.frm +++ b/frmTools.frm @@ -321,13 +321,13 @@ Public Function getHotKey(ByVal Index As Byte) As Byte End Function -Public Function setHotKey(Index As Integer, ByVal value As Byte) +Public Sub setHotKey(Index As Integer, ByVal value As Byte) If value > 0 Then hotKeys(Index) = value End If -End Function +End Sub Public Sub initTool(value As Byte) diff --git a/frmWaypoints.frm b/frmWaypoints.frm index d8d0902..1285210 100644 --- a/frmWaypoints.frm +++ b/frmWaypoints.frm @@ -516,13 +516,13 @@ Public Function getWayptKey(ByVal Index As Byte) As Byte End Function -Public Function setWayptKey(Index As Integer, ByVal value As Byte) +Public Sub setWayptKey(Index As Integer, ByVal value As Byte) If value > 0 Then wayptKeys(Index) = value End If -End Function +End Sub Private Sub Form_Load() diff --git a/modSME.bas b/modSME.bas index 3d4141a..de23f77 100644 --- a/modSME.bas +++ b/modSME.bas @@ -743,23 +743,23 @@ ErrorHandler: End Function -Public Function RunSoldat() +Public Sub RunSoldat() frmSoldatMapEditor.picMinimize_MouseUp 1, 0, 0, 0 ShellExecute 0&, vbNullString, frmSoldatMapEditor.soldatDir & "Soldat.exe", "-start", vbNullString, vbNormalFocus -End Function +End Sub -Public Function RunHelp() +Public Sub RunHelp() Dim iReturn As Long iReturn = ShellExecute(frmSoldatMapEditor.hWnd, "Open", appPath & "\PolyWorks Help.html", vbNullString, vbNullString, vbNormalFocus) 'SW_ShowNormal) -End Function +End Sub -Public Function SetGameMode(fileName As String) +Public Sub SetGameMode(fileName As String) Dim lReturn As Long Dim gameMode As Integer @@ -776,9 +776,9 @@ Public Function SetGameMode(fileName As String) lReturn = WritePrivateProfileString("GAME", "GameStyle", gameMode, frmSoldatMapEditor.soldatDir & "soldat.ini") -End Function +End Sub -Public Function SetColours() +Public Sub SetColours() frmSoldatMapEditor.picMenuBar.BackColor = bgClr frmSoldatMapEditor.picStatus.BackColor = bgClr @@ -792,7 +792,7 @@ Public Function SetColours() frmTools.BackColor = bgClr frmWaypoints.BackColor = bgClr -End Function +End Sub ' Initialises GDI Plus Public Function InitGDIPlus() As Long From ab97870f588c5e30f88573fcde7bcd5004313af2 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sat, 12 Oct 2019 20:38:37 +0200 Subject: [PATCH 20/57] Fix use specific types instead of variants --- frmMap.frm | 2 +- frmSoldatMapEditor.frm | 2 +- modSME.bas | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/frmMap.frm b/frmMap.frm index ab895ec..be1cca9 100644 --- a/frmMap.frm +++ b/frmMap.frm @@ -654,7 +654,7 @@ Public Sub loadTextures2() On Error GoTo ErrorHandler - Dim file As Variant + Dim file As String cboTexture.Clear diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 07e20eb..630c8bc 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -12105,7 +12105,7 @@ Private Sub saveWindow(sectionName As String, window As Form, collapsed As Boole End Sub -Private Function SetIdePath() +Private Function SetIdePath() As Boolean appPath = appPath & "\pwinstall" SetIdePath = True diff --git a/modSME.bas b/modSME.bas index de23f77..9914933 100644 --- a/modSME.bas +++ b/modSME.bas @@ -330,7 +330,7 @@ Private Function GetEncoderClsid(mimeType As String, pClsid As GUID) As Boolean GetEncoderClsid = False End Function -Private Function SaveImageAsPNG(ByVal sFileName, ByVal sDestFileName As String) As Boolean +Private Function SaveImageAsPNG(ByVal sFileName As String, ByVal sDestFileName As String) As Boolean Dim lBitmap As Long Dim hBitmap As Long From e1852e451e466c3d8ff445d3eb2d721a83eaccc2 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sun, 13 Oct 2019 01:16:10 +0200 Subject: [PATCH 21/57] Modify switch to Arial as default font --- frmColour.frm | 36 +++++----- frmInfo.frm | 138 +++++++++++++++++++------------------- frmMap.frm | 36 +++++----- frmPalette.frm | 32 ++++----- frmPreferences.frm | 136 ++++++++++++++++++------------------- frmScenery.frm | 14 ++-- frmSoldatMapEditor.frm | 29 ++++---- frmWaypoints.frm | 26 +++---- pwinstall/bgothl.ttf | Bin 35360 -> 0 bytes pwinstall/gfx/colours.ini | 4 +- pwinstall/lucon.ttf | Bin 115068 -> 0 bytes pwinstall/pw.nsi | 2 - 12 files changed, 226 insertions(+), 227 deletions(-) delete mode 100644 pwinstall/bgothl.ttf delete mode 100644 pwinstall/lucon.ttf diff --git a/frmColour.frm b/frmColour.frm index a807d41..87f6fec 100644 --- a/frmColour.frm +++ b/frmColour.frm @@ -23,7 +23,7 @@ Begin VB.Form frmColour BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -73,7 +73,7 @@ Begin VB.Form frmColour Begin VB.TextBox txtRGB Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -93,7 +93,7 @@ Begin VB.Form frmColour Begin VB.TextBox txtRGB Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -113,7 +113,7 @@ Begin VB.Form frmColour Begin VB.TextBox txtRGB Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -133,7 +133,7 @@ Begin VB.Form frmColour Begin VB.TextBox txtHue Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -152,7 +152,7 @@ Begin VB.Form frmColour Begin VB.TextBox txtSat Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -171,7 +171,7 @@ Begin VB.Form frmColour Begin VB.TextBox txtBright Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -319,7 +319,7 @@ Begin VB.Form frmColour BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -345,7 +345,7 @@ Begin VB.Form frmColour BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -369,7 +369,7 @@ Begin VB.Form frmColour BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -390,7 +390,7 @@ Begin VB.Form frmColour BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -412,7 +412,7 @@ Begin VB.Form frmColour BackStyle = 0 'Transparent Caption = "°" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -480,7 +480,7 @@ Begin VB.Form frmColour BackStyle = 0 'Transparent Caption = "R" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -503,7 +503,7 @@ Begin VB.Form frmColour BackStyle = 0 'Transparent Caption = "G" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -526,7 +526,7 @@ Begin VB.Form frmColour BackStyle = 0 'Transparent Caption = "B" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -549,7 +549,7 @@ Begin VB.Form frmColour BackStyle = 0 'Transparent Caption = "H" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -572,7 +572,7 @@ Begin VB.Form frmColour BackStyle = 0 'Transparent Caption = "S" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -595,7 +595,7 @@ Begin VB.Form frmColour BackStyle = 0 'Transparent Caption = "B" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 diff --git a/frmInfo.frm b/frmInfo.frm index 406d872..d9db1dc 100644 --- a/frmInfo.frm +++ b/frmInfo.frm @@ -95,7 +95,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -115,7 +115,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -135,7 +135,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -168,7 +168,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Range:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -189,7 +189,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Z-coord:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -210,7 +210,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Intensity:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -233,7 +233,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -272,7 +272,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "0x0" BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -293,7 +293,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "Dimensions:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -315,7 +315,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "500" BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -337,7 +337,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "500/500" BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -359,7 +359,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "128/128" BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -381,7 +381,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "128/128" BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -403,7 +403,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "500/500 (500)" BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -425,7 +425,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "5000" BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -446,7 +446,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "Connections:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -467,7 +467,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "Waypoints:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -488,7 +488,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "Spawns:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -509,7 +509,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "Colliders:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -530,7 +530,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "Polygons:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -551,7 +551,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "Scenery:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -589,7 +589,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -609,7 +609,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -629,7 +629,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -649,7 +649,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -668,7 +668,7 @@ Begin VB.Form frmInfo Begin VB.ComboBox cboLevel Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -691,7 +691,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -713,7 +713,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -735,7 +735,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -757,7 +757,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "°" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -778,7 +778,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Scaling:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -800,7 +800,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "X:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -822,7 +822,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "Y:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -843,7 +843,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Opacity:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -864,7 +864,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Rotation:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -885,7 +885,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Level:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -924,7 +924,7 @@ Begin VB.Form frmInfo BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -947,7 +947,7 @@ Begin VB.Form frmInfo BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -971,7 +971,7 @@ Begin VB.Form frmInfo BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -995,7 +995,7 @@ Begin VB.Form frmInfo BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1016,7 +1016,7 @@ Begin VB.Form frmInfo Begin VB.Label lblHeight BackStyle = 0 'Transparent BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 238 Weight = 400 @@ -1034,7 +1034,7 @@ Begin VB.Form frmInfo Begin VB.Label lblDimensions BackStyle = 0 'Transparent BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -1085,7 +1085,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1104,7 +1104,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1124,7 +1124,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1145,7 +1145,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1167,7 +1167,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1188,7 +1188,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Rotation:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1210,7 +1210,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "Y:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1232,7 +1232,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "X:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1253,7 +1253,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Scaling:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1275,7 +1275,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "°" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1313,7 +1313,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1332,7 +1332,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1351,7 +1351,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1371,7 +1371,7 @@ Begin VB.Form frmInfo Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1389,7 +1389,7 @@ Begin VB.Form frmInfo End Begin VB.ComboBox cboPolyType BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1412,7 +1412,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1433,7 +1433,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Bounciness:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1455,7 +1455,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1476,7 +1476,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Opacity:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1498,7 +1498,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "Y:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1520,7 +1520,7 @@ Begin VB.Form frmInfo BackStyle = 0 'Transparent Caption = "X:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1541,7 +1541,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Texture:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1562,7 +1562,7 @@ Begin VB.Form frmInfo BackColor = &H00614B3D& Caption = "Type:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1584,7 +1584,7 @@ Begin VB.Form frmInfo Alignment = 1 'Right Justify BackStyle = 0 'Transparent BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1604,7 +1604,7 @@ Begin VB.Form frmInfo Alignment = 1 'Right Justify BackStyle = 0 'Transparent BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1623,7 +1623,7 @@ Begin VB.Form frmInfo Begin VB.Label lblSelPolys BackStyle = 0 'Transparent BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -1641,7 +1641,7 @@ Begin VB.Form frmInfo Begin VB.Label lblCoords BackStyle = 0 'Transparent BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 diff --git a/frmMap.frm b/frmMap.frm index be1cca9..da3fac7 100644 --- a/frmMap.frm +++ b/frmMap.frm @@ -23,7 +23,7 @@ Begin VB.Form frmMap BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -46,7 +46,7 @@ Begin VB.Form frmMap Begin VB.TextBox txtJet Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -77,7 +77,7 @@ Begin VB.Form frmMap End Begin VB.ComboBox cboTexture BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -100,7 +100,7 @@ Begin VB.Form frmMap Begin VB.TextBox txtDesc Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -153,7 +153,7 @@ Begin VB.Form frmMap Begin VB.ComboBox cboWeather Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -175,7 +175,7 @@ Begin VB.Form frmMap Begin VB.ComboBox cboJet Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -197,7 +197,7 @@ Begin VB.Form frmMap Begin VB.ComboBox cboGrenades Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -219,7 +219,7 @@ Begin VB.Form frmMap Begin VB.ComboBox cboMedikits Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -241,7 +241,7 @@ Begin VB.Form frmMap Begin VB.ComboBox cboSteps Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -299,7 +299,7 @@ Begin VB.Form frmMap BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -339,7 +339,7 @@ Begin VB.Form frmMap BackColor = &H00614B3D& Caption = "Texture:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -360,7 +360,7 @@ Begin VB.Form frmMap BackColor = &H00614B3D& Caption = "Background:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -381,7 +381,7 @@ Begin VB.Form frmMap BackColor = &H00614B3D& Caption = "Description:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -402,7 +402,7 @@ Begin VB.Form frmMap BackColor = &H00614B3D& Caption = "Medikits:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -423,7 +423,7 @@ Begin VB.Form frmMap BackColor = &H00614B3D& Caption = "Grenades:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -444,7 +444,7 @@ Begin VB.Form frmMap BackColor = &H00614B3D& Caption = "Jet Fuel:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -465,7 +465,7 @@ Begin VB.Form frmMap BackColor = &H00614B3D& Caption = "Steps:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -486,7 +486,7 @@ Begin VB.Form frmMap BackColor = &H00614B3D& Caption = "Weather:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 diff --git a/frmPalette.frm b/frmPalette.frm index acb3ed3..eb5e82f 100644 --- a/frmPalette.frm +++ b/frmPalette.frm @@ -71,7 +71,7 @@ Begin VB.Form frmPalette Begin VB.TextBox txtRadius Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -147,7 +147,7 @@ Begin VB.Form frmPalette End Begin VB.ComboBox cboBlendMode BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -183,7 +183,7 @@ Begin VB.Form frmPalette Begin VB.TextBox txtRGB Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -203,7 +203,7 @@ Begin VB.Form frmPalette Begin VB.TextBox txtRGB Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -223,7 +223,7 @@ Begin VB.Form frmPalette Begin VB.TextBox txtRGB Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -243,7 +243,7 @@ Begin VB.Form frmPalette Begin VB.TextBox txtOpacity Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -302,7 +302,7 @@ Begin VB.Form frmPalette BackStyle = 0 'Transparent Caption = "Vertex Colour:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -324,7 +324,7 @@ Begin VB.Form frmPalette BackStyle = 0 'Transparent Caption = " Dynamic" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -346,7 +346,7 @@ Begin VB.Form frmPalette BackStyle = 0 'Transparent Caption = " Normal" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -368,7 +368,7 @@ Begin VB.Form frmPalette BackStyle = 0 'Transparent Caption = " Precision" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -389,7 +389,7 @@ Begin VB.Form frmPalette BackColor = &H00614B3D& Caption = "Radius:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -410,7 +410,7 @@ Begin VB.Form frmPalette BackColor = &H00614B3D& Caption = "Mode:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -431,7 +431,7 @@ Begin VB.Form frmPalette BackColor = &H00614B3D& Caption = "R:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -452,7 +452,7 @@ Begin VB.Form frmPalette BackColor = &H00614B3D& Caption = "G:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -473,7 +473,7 @@ Begin VB.Form frmPalette BackColor = &H00614B3D& Caption = "B:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -494,7 +494,7 @@ Begin VB.Form frmPalette BackColor = &H00614B3D& Caption = "Opacity:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 diff --git a/frmPreferences.frm b/frmPreferences.frm index 0248fef..b68c8ec 100644 --- a/frmPreferences.frm +++ b/frmPreferences.frm @@ -53,7 +53,7 @@ Begin VB.Form frmPreferences Begin VB.ComboBox cboSkin Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 238 Weight = 400 @@ -74,7 +74,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -97,7 +97,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -120,7 +120,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -146,7 +146,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -171,7 +171,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -196,7 +196,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -221,7 +221,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -246,7 +246,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -286,7 +286,7 @@ Begin VB.Form frmPreferences Appearance = 0 'Flat BackColor = &H00FFFFFF& BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -306,7 +306,7 @@ Begin VB.Form frmPreferences Appearance = 0 'Flat BackColor = &H00FFFFFF& BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -344,7 +344,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -367,7 +367,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -389,7 +389,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -412,7 +412,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -434,7 +434,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -457,7 +457,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -479,7 +479,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -502,7 +502,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -524,7 +524,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -547,7 +547,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -569,7 +569,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -592,7 +592,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -627,7 +627,7 @@ Begin VB.Form frmPreferences Begin VB.TextBox txtOpacity2 Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -645,7 +645,7 @@ Begin VB.Form frmPreferences Begin VB.TextBox txtOpacity1 Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -693,7 +693,7 @@ Begin VB.Form frmPreferences Begin VB.TextBox txtHeight Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -711,7 +711,7 @@ Begin VB.Form frmPreferences Begin VB.TextBox txtWidth Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -730,7 +730,7 @@ Begin VB.Form frmPreferences Appearance = 0 'Flat BackColor = &H00FFFFFF& BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -749,7 +749,7 @@ Begin VB.Form frmPreferences Begin VB.TextBox txtDivisions Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -767,7 +767,7 @@ Begin VB.Form frmPreferences Begin VB.TextBox txtSpacing Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -801,7 +801,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -827,7 +827,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -853,7 +853,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -914,7 +914,7 @@ Begin VB.Form frmPreferences End Begin VB.ComboBox cboWireSrc BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -934,7 +934,7 @@ Begin VB.Form frmPreferences End Begin VB.ComboBox cboWireDest BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -954,7 +954,7 @@ Begin VB.Form frmPreferences End Begin VB.ComboBox cboPolyDest BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -974,7 +974,7 @@ Begin VB.Form frmPreferences End Begin VB.ComboBox cboPolySrc BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1029,7 +1029,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Fullscreen always on top" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1051,7 +1051,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Use 4 verts for scenery" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1072,7 +1072,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& Caption = "Other" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1100,7 +1100,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Skin" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1122,7 +1122,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& Caption = "Waypoint Keys" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1151,7 +1151,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Prefabs" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1173,7 +1173,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Uncompiled" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1195,7 +1195,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Soldat" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1217,7 +1217,7 @@ Begin VB.Form frmPreferences BackColor = &H004F3D31& Caption = "HotKeys" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1245,7 +1245,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "px" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1266,7 +1266,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "px" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1287,7 +1287,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1308,7 +1308,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "%" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1331,7 +1331,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Colours" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1353,7 +1353,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Window" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1374,7 +1374,7 @@ Begin VB.Form frmPreferences BackColor = &H00614B3D& Caption = "Height:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1395,7 +1395,7 @@ Begin VB.Form frmPreferences BackColor = &H00614B3D& Caption = "Width:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1416,7 +1416,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "px" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1437,7 +1437,7 @@ Begin VB.Form frmPreferences BackColor = &H00614B3D& Caption = "Divisions:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1458,7 +1458,7 @@ Begin VB.Form frmPreferences BackColor = &H00614B3D& Caption = "Spacing:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1480,7 +1480,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Grid" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1502,7 +1502,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Wireframe" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1523,7 +1523,7 @@ Begin VB.Form frmPreferences BackStyle = 0 'Transparent Caption = "Polygon" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1544,7 +1544,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& Caption = "Directories" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1573,7 +1573,7 @@ Begin VB.Form frmPreferences BackColor = &H004F3D31& Caption = "Display" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1593,7 +1593,7 @@ Begin VB.Form frmPreferences BackColor = &H00614B3D& Caption = "Pattern:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1614,7 +1614,7 @@ Begin VB.Form frmPreferences BackColor = &H00614B3D& Caption = "SRC:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1634,7 +1634,7 @@ Begin VB.Form frmPreferences BackColor = &H00614B3D& Caption = "DEST:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1654,7 +1654,7 @@ Begin VB.Form frmPreferences BackColor = &H00614B3D& Caption = "Back:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1675,7 +1675,7 @@ Begin VB.Form frmPreferences BackColor = &H00614B3D& Caption = "Point:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -1696,7 +1696,7 @@ Begin VB.Form frmPreferences BackColor = &H004A3C31& Caption = "Blending" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 diff --git a/frmScenery.frm b/frmScenery.frm index c679410..92e0f24 100644 --- a/frmScenery.frm +++ b/frmScenery.frm @@ -166,7 +166,7 @@ Begin VB.Form frmScenery Begin VB.ListBox lstScenery Appearance = 0 'Flat BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -186,7 +186,7 @@ Begin VB.Form frmScenery BackStyle = 0 'Transparent Caption = "Level:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -206,7 +206,7 @@ Begin VB.Form frmScenery BackStyle = 0 'Transparent Caption = "Rotate" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -226,7 +226,7 @@ Begin VB.Form frmScenery BackStyle = 0 'Transparent Caption = "Scale" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -246,7 +246,7 @@ Begin VB.Form frmScenery BackStyle = 0 'Transparent Caption = "Front" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -267,7 +267,7 @@ Begin VB.Form frmScenery BackStyle = 0 'Transparent Caption = "Middle" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -288,7 +288,7 @@ Begin VB.Form frmScenery BackStyle = 0 'Transparent Caption = "Back" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 630c8bc..dfb0c9f 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -12,7 +12,7 @@ Begin VB.Form frmSoldatMapEditor ControlBox = 0 'False DrawMode = 6 'Mask Pen Not BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -80,7 +80,7 @@ Begin VB.Form frmSoldatMapEditor BackColor = &H004A3C31& BorderStyle = 0 'None BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -101,7 +101,7 @@ Begin VB.Form frmSoldatMapEditor BackStyle = 0 'Transparent Caption = "Position:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -122,7 +122,7 @@ Begin VB.Form frmSoldatMapEditor BackStyle = 0 'Transparent Caption = "Untitled.pms" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -142,7 +142,7 @@ Begin VB.Form frmSoldatMapEditor BackStyle = 0 'Transparent Caption = "Zoom:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -162,7 +162,7 @@ Begin VB.Form frmSoldatMapEditor BackStyle = 0 'Transparent Caption = "Current Tool:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -202,7 +202,7 @@ Begin VB.Form frmSoldatMapEditor BorderStyle = 0 'None FillColor = &H00FFFFFF& BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -246,7 +246,7 @@ Begin VB.Form frmSoldatMapEditor BorderStyle = 0 'None FillColor = &H00FFFFFF& BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -273,7 +273,7 @@ Begin VB.Form frmSoldatMapEditor BorderStyle = 0 'None FillColor = &H00FFFFFF& BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -300,7 +300,7 @@ Begin VB.Form frmSoldatMapEditor BorderStyle = 0 'None FillColor = &H00FFFFFF& BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -327,7 +327,7 @@ Begin VB.Form frmSoldatMapEditor BorderStyle = 0 'None FillColor = &H00FFFFFF& BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -468,6 +468,7 @@ Begin VB.Form frmSoldatMapEditor Height = 8085 Left = 0 TabIndex = 18 + Tag = "font1" Top = 600 Width = 5730 Visible = 0 'False @@ -482,7 +483,7 @@ Begin VB.Form frmSoldatMapEditor Appearance = 0 MousePointer = 1 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 @@ -12371,8 +12372,8 @@ Public Sub loadColours() font1 = loadString("GUIColours", "font1", appPath & "\" & gfxDir & "\colours.ini", 40) font2 = loadString("GUIColours", "font2", appPath & "\" & gfxDir & "\colours.ini", 40) - If font1 = "" Then font1 = appPath & "\Lucida Console" - If font2 = "" Then font2 = appPath & "\Bank Gothic Light BT" + If font1 = "" Then font1 = "Arial" + If font2 = "" Then font2 = "Arial" Exit Sub ErrorHandler: diff --git a/frmWaypoints.frm b/frmWaypoints.frm index 1285210..f703a62 100644 --- a/frmWaypoints.frm +++ b/frmWaypoints.frm @@ -69,7 +69,7 @@ Begin VB.Form frmWaypoints End Begin VB.ComboBox cboSpecial BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 238 Weight = 400 @@ -244,7 +244,7 @@ Begin VB.Form frmWaypoints Alignment = 1 'Right Justify BackStyle = 0 'Transparent BeginProperty Font - Name = "Lucida Console" + Name = "Arial" Size = 8.25 Charset = 238 Weight = 400 @@ -263,7 +263,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = "Show:" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -283,7 +283,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = " Path2" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -304,7 +304,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = " Path1" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -325,7 +325,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = " All" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -346,7 +346,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = " Path 2" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -367,7 +367,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = " Path 1" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -388,7 +388,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = " Fly" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -409,7 +409,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = " Left" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -430,7 +430,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = " Down" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -451,7 +451,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = " Right" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 @@ -472,7 +472,7 @@ Begin VB.Form frmWaypoints BackStyle = 0 'Transparent Caption = " Up" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 238 Weight = 400 diff --git a/pwinstall/bgothl.ttf b/pwinstall/bgothl.ttf deleted file mode 100644 index 30e6ec049e72316998bb9d9f1b48059c6d5d81fa..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 35360 zcmd443w%_?-9J2YE_+Y*p3ObG*(6Kumn8|g!6t;Oh!`M*7!X1T33mt>u3{iaF#?Gw zDk7yyfl{QAA{9l8HE2WYY^Lan-=Y11)a`wzQ zGr#%G%xVLN8^)( ztlC3}cH!)K)24nr@VAQzS-B1U>E=vbGGF~C`aIr`#{15>Q|CfBkw<}GSyoK`k2o!=QeZ~oGStjd{PP>_|5!s{$+ zT-3B^;q<9XPTS~r#DSs_|Wvaj9V=^M=f%ejbq=Pfu^0j;WX#i z1&gOHobJrZ$^JnlUYJuqWB#;7i_#y;&dAGm-aBt@-PEON&eFv*7B?+&db83PJYJ`_ zFn2&M`c|fM5}R(*a{P zAj~8AXz5MFIZk$pJIO)3zf-(Uc9PA~6e&jBCLSc2(ioadmQ#t$k@m~OF;j!cP$89WBOAye z@)ns%mI`A4{}|FDze-xjaKN#T>=b%{g*{|5okI?gZDfZ~CaobWX^WUmuaJ*OjaVX< z0f%MeiWnml2}Fz##*xWnB}Ugtnj``YoRnPhRv{Vq+eB6hbtnmOF+51Fz%RSsdo6f` zY*I^3;+~0Y5{?MXfnO3O*3tc>N^;P1)IzFh8yksyKuD*bks4AbXVMxvl(YzvjIoGc zs%tSv4dk@&A@H_I-p9r&qzlKeLP{`B9mZK9zlxcdLQ}~h@jPi3z9C*=2dyF7#AZ?} zB?HPBvXt&6o7E%9Qk4!E`dYn`tRoxbw*tRpomfq;sba`*;i6DO_mN`(i~t{3FzzNY zS-2()l1AeS#Eg*A8^R-iS|K78c`0CRiInndLS6?oxFzvXvc=jCg>Jj|hZmDm1; zmxuWMSI9xYB$HS8H+C(OU-Rn&ynLCLoxJT|vFp+s;D!v+m-xMx@UDbC#_s%*mwR}* zo0q#VW2Jav7k~EW*vo8gf6nWEPT1V;BrlRlxW{Tllx%KaBrou}Wi=wcvAJb;MDjEK z<_-@3PlIj$l;7LV%jbEyjhD}nt)N>nd5(W$*CKhAJVWlmy=Teq`8Ni^GvsNkRGHU^ zC>aD#16zr>$7)2B3<7pXBu|ki`O{Bv7}&K)Hj^j#xHj{iHuG^kK|1)jSdEB!)@ld% zKU=e`MnuV4Wp_l-35LIoe2z8*$F+gqWB3zE8?Skc&(8Yb3S7_Y*=iI?E5BaD%hkMW z;pHQ|Ttyz{Yjzd?#;!%Q#Mb!=K8of1{xW{OlwU95{WbGv9^!Wv^RkI7#Qa~!7#8xn z1$VRAk>6w2B6t?tEA{-&bUvzS{JNH3PvwwI;ddV7 zPfq6LByebvJizZy;AJH*$MbR=e`_pnzk=VnkC&tQ{d>XDY=Gikeve&?*wqZ{LwPxb zzgNz$2lKLwm!+7cLcCYXA!FAfcn*7SATLXJSL=uFEfBUMrktm*wgvFG+w6iG9_4_!m*Ofd+o<-JiJW8dS$CEDfo@; zQ+7w>E1R{=M&afwIG*?6;&+_9jN^A=IfOC1jOO>FN(1R;YQ2u-fFAe;To|igaYI&&%j#0zMs1ANp^KUBt1RE8@lFa*J*CKw| z$T&v=!(!Kj)~($@Q~y8xA^)HDe%H=pfF7S(B}<|}Nt)BtDI|`l>-61U<^26bS9;nV zU!5kkvy+VJ3|Z=Y^~Q}cRZ^5Zu~Uxj6caU_Qlk6Pk5yhuPrGMKmGf1q8d4r?cF2@+ z+#Fkl9`KLdMt4KX(*X|=NWHQ}s+V_S-qa+i)IcOE;l2tbB^u21BX|aPGP}-nXA{$z z?law4RP2 z*_gIG!emXQ`-LX|hLbk;VzmQ?)*G1`x!)ja?5hAE1 zyE!g4CORrI!VzY-SuJLhF*L-W*J^sFGgcSwG@UuYM^oIDbEdesJ16G?FSDpibXoDw zE4tLU#K&#rpM00qg^zejxi*#RJ$tBT->SW|C{cO4mX1qQ_U&!ir~C`Il*1l6WV-TG zH?4h1oT7A#wMq>AOo^GLbk9*-^dkGrp|)8NYXSe)$~C!M`j%rOn>^v}t?3tQ7bOjG zt5sC3300+7wIWeP%aLM^>1uaZmm}wDSGVbksoRlbVl!yQ2h&-6CFhHrYsFnxa!mMl z%yjf9{+TTW1!g>ff|r(pEVhI^SW47o_V!LYrpLvmKHu&#_pSkNuGh{VP>Z$HryO0b zyf0i*PIY%ouW#>Ou3T@M^Af%P;>MW`?H8Ay`^o$rtLVt5XqoaR`!qZ;v!hYDMs?Gc zrMvgjku#sD?P&b)!zuGJJ&cOoxTqQoW8fL$t1+wm-0N`6@7Q?Ft_nmf7VTEb73mENTn$=H%t} zPjbhr)L6?HBUW~N5~XhXV|CJ)MPtS_Ev~q~Y4IzqYk%{`s)t{vZ9QuiiA#H;AG*Jy zY0>=^ix(YS+xnX~9!5>X{ficky}zmHzBLD5S-t9wBjWDwpO>a7?~GZru%cq|;xVlU zUs<#2$PujXU0C0rU{}JPL0WwyV`FS)DXw2)LcA$N5H)UDL!#|*2I7u;D!i4nC22IW zC^}=^i3$DU1u-_-?6jE-BqBUk>$D{$#D+xMLY&c|B*c&mig5W1P|(%YcW&8AU=!ZE zAg(FLfFVBfY@J}UC%W>fOjRm3pYHy7`T0qK9UqwKT$i2ZJJi(ep->SYQ`Rc~6q@@D zyGPm8F(c#N_cQveL6P?L^bbKcO*CK205uuU9^MaE2g2o(T(yPsaNiv$wT)uqa@?}gOwkDf2Gwc28i5y0d)t>ys zd>Ldp(IGq3g7ozCW6I~rREm8#ni7xlueat1&s-hzUis4H)TLZny0rA<7{H=nt?iSJ zVOJ&ktmHW@-KG|wlLd=JtQw0>WiXv7?(QiDzB8{D_Y_|SRd%u6Zg%Cm%;GvB(SN?y ze@^g7$NV4E`cDbjwL%V|RCU8kzk!ZyB*{Jp_=qSG`FXP1q+%R~NFvqSOxTZX2pB;3 zWvsKTL`GKB?)+X#LJy=_+N+lijj&kKF4^O^oxkL8O?KM=a}zx)WD9dZHLX4k*-j;xqeiNmKO^jVBY2;&g+t_BD7(qzHX=>OU!P5b_N?CJM`=WNWm z5u7&D7sVkkS=z)_Q=48d8AQosmenSiIKXMawlTX5s;lfG%L;nr0(Q&*j_p7PXz}|G zwhBAeOqsIAKc)4-y`rV(is!8smx6@3#Y!IKM|MDEdTy2&_z{%H5IVNka}N!Omw6%)PPwNBlXdtcB?5o z)DRsBzzuCy2q2w-j)PcfGsnm=hBRUVy`bH9I_aA?oubv;K5%7l~tjy+;Ub5&Jy z+2~5IQgu9kTys^~hOii&QNuRWc284vRfyo7^5T9Q7JL9EJkIrL7nNjY`SuW z@eocmIRVJ*x^nHED}TI#;qXn#NNMmI!(?a3Kb|a6?hzx{P}Uj?8$` zS;kN?<$-FOX?pFv)l-?Q^)4{5TuR4P2-ci~szFt@>m_xoD9A(?i%AuU3_5m(?QFoy z)&#bDPL3Jm#7u$wTQ;?pEiC&$Ez>O?Ue3xRLVz%J#W^EqdW zf{!2z+|mw_qIaI-RWvEd?Ud9QL}0E1ywpT6^$xmKl!iPZPqmb&1hqh`Krr2g6>{KWaruQh@ zrP2P^EaK1q6H8~T?_r*nQ@~g{pWk#+LYjQT^Ybz@q{19eQe3Q*5+5l>NK#Iiy3nGx z>hOJgVM<$QYfc+UO>xId>QG}?3@P*$<>+FQWJ{hL5i9E=R2j197|3@NBob^W2i5{s zAmlS_B)%;8E@B7;4dgor6d@>h+__=;;@TCj67Tp<-}=eS2c}n5U<=J$H)(A3jG9^N z{o~RG2?k$k+93bck_=nwAR%v1YU&{Wdjr#^uAVog&SrBXp zEEZI{I3}=+*rv$i0xZT4V#35(x=KA9>&R71I9iE9kk}TDrKl_J{C@93J5pYKb^y0q_)e--L%UaA>al!uR!}(jy3M z6-wM3`aIn+2he;;h{Py^89tvzUr}sKm|cpns6>-d00&lw%Hnn%Sz}qPYmJB`x)@1s z7hDk*(L@AeC~=!&s68|RlC3H}9)s`V+6iLNZ#wM#Gj`?<*X0pD0eGV@J7aVzp$jIB{%z?8KLbmc+i4IQFGciI$hLYsTECf`v%s ziuVmBa-}gTzj8!=cv5N&Cba9q35+B_)$sMi1(3N5#aEcpFE@BWz*+!i$XZ>6(U+MoKEm5DEozm~#8_y|p z=(M_rmEXLxU%5WLqGsCU{CV>x)jUM=KR7|Bt)DZ$YRoi6dHR>i-zMi3+%rnD$rC2+ z{@E9_xI*!LH>pwi_lbEc;4&0QIe5$ltR&D(lH!YiIjD{7ms(Y#4yGHvW3;M%qDRj+ z306fhb}S4N)TI@?)GfM1`nFJ@eCD4nl)fR{^SgEa+;y}~i0P@4T;E@WRL}!o9AYOp zU(`YhPaqS0*?OHR6l_t7hzyM}IbAAKn-tn+2iv!qL)B7Pf=Z4dx|9f#;!HKlDYoQ9 z^q#{7bha7+1>}G;Obg_49u_R4)BuW0d1i2b@#YmYrvRPnmGY#m-ZKAop>}YNHhmDg zD9P+;5yv$*j(=d{q>d+PXw~q1WnZ44n%Tdfav{Y(Lvl@>y?p#Qy}t2*b&d5*QfD%5 z8F1zxBYYm~bni2}use2pCNcfZx>}5Cwve z;|~xDGfzMS2a7THN~db6!|xV8dAYvb-`U>K&@PN=uYXzW@C#I%xblgH#ttE!X&!Yh z#wQq_j{`0ZAnWI|lQu12v5Um6rK%KT8chicz`>*tCjK!r@{XO1gLxnlK@x^M%uEhu zagfqVS5SK9+QV0LF?a9BFr}RUQl=sbSnp~rm z+tgwkZPm6R-bJO6Qb@AFbhW3r>r7Yg+(89m8g1Z1E#mc_-w1+V5$~5=8CQgF4rM5FLjlc^9&4}PFXVU5Xm5DpbfWSzabwT9j>h1~_Mv4RN%C2>Dp8c! z&{Tq~)-r%VS$c}kba9pg12hvl8DuV~H_(PGFAJNg;1|RS<(z*Y##cm-DJuUtdR|Ek zv@LyxwxPlM^t4rMBNA&dcvCQ3LSx*$4vfZ2agD5k1GL2SJM*uqGj zFUD>O1;SK1+G-%7qFtreTI@udp|@v{WCtd)SJ4kF&zsl-Tn9AXQaOaw1m+(#F$|1SV@*I8g2;* zR=_qjOrJ)h#srClrs%Usij>SuCtNKH>}^muZnkFTTt<3(w+1~Z&gyxp6Z_!&rWrFf z`4c;4Y!;N6?K7G6x%ro(4wZyJt;R z>KF`?qVSQcVeh`jm!<--5TZs1!|Ecrf8C*dojUz z6sSFuZkYtd{&A$hnxEfmc43HdTfss>@1+Q;>UoO3Kd0Hhyca`DSMHgw6mTs0g{zr# zK`*Klg$h7dfZp%t*oq)NUwjZ-4vsFn&IZS$)u5twhO=;nGe*&XGwx^zfC#h|2XJ^- zyt%OldvRBmbrW~b!L@Q-sZfpsg&VSpw-#sjK_T4+G*a?8)=v>&bCGGjJfj(0o~W#$ zYO~29gvUYLV3X>KYBjf+bUINVWs6o(k`YHU9F~kYRgNjc5gHFuFXNNUdlF=uSFUvh z?LFL?z}P?k7XUtB#o;O|^Nj>`*MOBrEj{D630pTb)Nk@X-QKWMwE7#`>+9PE?}k}V ziyg|jhK^>&PGgex(t(W~H64vJTEbE>4#agz9T|$@fUY;;{Seq>?FJblK`U+3XtW^4QVvNmB!>nTO_0Gb zW`pJ!2@IMY&GcM~#O0 zEMLw6O@(O`|Ae*v-@Zvt(>H(RKa0jTi3D0AdX<4J3S3X21uZqLj=lhFdT+b!I zjJPei1${9|!LCC`k}R}phz>Rq$b=fN0PA-E@Bl&MfU};^$#Q}Czf%bN>3 zD!7fyzD_jybH&elJ`-bxizC{Ld-gNVLq3BIdogU-T!&P3qG91#@Sa?`KgELT3F?qw z?=sdeTf@R)WiEZ<2400pdqK}CT-@)n`QW^7h zv7XnUXG?F-w3CRP^0OLMe~IL>rQDsvd^)r7qnU&K=SX@V!UkWdR#Dc zibeF=7C|_$z`tkSL3;8_v94#^`|s1?h|?Ak|4F2oXgi?4JmAY=`in{iaR}%y)O47H z9=7kMhix$tvN=>MK!qW?!U(z0S!5)Iwt`y<3|B$}%jIqwOfT@e>Z4&TyV3hi--5jUmhK|CTxQ{l@;f^4%&%WLy5bl46YF4?{-V?&E8 ze!yFc&Ywe1l+SAst^zvCVYPUe?$#a-=q!b#;0HPjByKzZ#oy!NOn)KW2Lb;Bv99G} zi^BINTPewCF`%&oTI3oFn!7_|;f?W4eq5a5FQ;wFVl<>&U8NvxATUdN(NYAt&zIas zV>xV<4nt!BasnC)VJxN4p&mpFjl}_#r5h0iT;yP6>B<*>Ja**=ItzRZchgx^{t98g zvRzP3T;V^sVq*1jVbszZK4IMtDPJ{Lj$cBLH&3XX9T6SG-Z8N@fIaarG?v{=V<}V( z(g^|V-LA2~r@{Fe(^!u06b|m(=^uqSjh(cnXFFY^AmM=`nv~E6w8=FVVK+gVLBTDJ zg^Ah?FTRL+invH3?gM^q=_`jdySctnsFe#vEn}+?kNHx$yS_4KWz~!HB-UnS^B$M- zcj1!1u^GA|Ulm8tavyyK0}JRY7}pQ=6*e%&Mxd`?TnU%`tAyVxSN(5@b;{#(kupgc zMAs_IgDsoTazI!8e+;DCKZ3;UiLd~>%! z)=Fl*&7lL&578Cs%QRA{svs!i{XkvmVsbgPL2|vD#*#!w3BtN{w3BXl<{4QIjSW!_ zq$;~CPT_5v|6jnxiBh>1r=ldUu&lV0P zjrRCI2OP)43llwKQUwE`8RRSg?PnD2L%?vmu5wttn;h=dRSNZkNugByKh;&Lgpd5G zJF)(omRDmhY*<;fMwoJM^Mnb_N zdP`RU5O#?i{-LT;XdEmSYKniLs&w6^s<533RVA^H4%e%yhz-a5sdU5adjChg_^Dj} z#C&BY$B}=>)zquKcw&mmEnIElxQZZye6E0|0_YgB`f4hL#&Cu(zKGBKuM`zGb(_T^ zC5L{HpVZGkQFv|Y`0-Pl=&JL|uD=6&UnTT!$m++ici%*gJvxqIkRo=RNcDisMP~R4 zeyFFI0AiH&uuFI?YPb3DO;shXlvqktj#7jWno2{9nH8NI(ZSNWfPCePYmDlG4)f*C z%09XZxccq7O788tiukVor$YL&i4#`%zgaPHi?GT6;qoeQ&(D_DJSBW~Y5bCgCF930 z36E>JI(|t-^Mr9T?M{pY!HSX!BME9MhvnVSR0@AgQ`^@Z|+a*Q6Kdr%fBbCgUvMcKi|lZt*S z(NC|YvYRkXrSQi!75a@*^e(NYBabR2bUFQ6`3YU3IFz+$3o3@>L0ekl@|hsV?N%S| z)l{^QK7K@1*(|jC_lZ^hnZlOQ!c#3n{B?})>{n{VO8FQ`f&QK^k$6p%80XL%!lhWF z)gmV*iE+eo#2R-b_6_Tsk$voD! z@G*6aRvV*!Y~kZwnR4~C=f2(3?u={y#Xp~$Cd}&i^VO{n3v+~rw|;x^N#L8lufz!X z$Sz_MhMEG|_w+`#b#-MiJzmJ4t%~^$^TB3kAFwd47YpI3Hn%4!)EFV!G?X~wq$Ein zEo#)ZBNp`$%^Q|Cla6>^Pqkb6g1aont@f|o|2;d)92_1<0 zkG%GHHtIl-Z*Fkl0T+A#8*n%YsTg*wMiYx+w;jv$tbU+!-n_~HO1d7GD!vVl`s&3e zX4P)}=Px(LIXCY8_IY50VF9slXXWd{6~r1P`)tIbH%5vv7RxsMZzH#fvE<%R#ECG4 z@JtW50y7tJ=$O9?)9CeDZ_IMW&ql_`pf+%W7+l`~e z*nUwSHw(g8TWwfH#z123hxVWOCxOi;CCOBa> zH8yNgs&039(E~*l_v3-Fg$?b@QPcjtq1OX;;|6SsncPm}AxXheeoEo8K@GF}+vLAv z{QZJ88<3CqX0YZ3#P4~KKgoX7Q_gAv`Z4rr z55p^d)W}d=!yvdz&EOxc`M7V5bgEBl8*i(**r(=P-x_#%Z$a=$u;!qW$u&|Ba$f?l zeTrO31{>o^MI7qk!I}+#`|dS^f3)V~zBL@`-qtn-Yc@idGV^{$_4aea!TUi<0^M<2 z&EP=IjqmVI|J!Ol4!+|-jhgq<+uFup4I9rviDBpdU_a-u*4cQt49i=q=!F2;ba$^A z{G&A=_pRX&^tQI~wi*UOZ_T-24d?$Hf~uPkKtu}8!iL*w1|!4n?lm9xt>F;#wziSg zfc9*@;SuM+o@R%2J;|&Kv8!zAw`C+%{7z^Mc`FRzUV@o~gi={|AG{3a`)o7}ff1Lx zF5ttYDNc<*oDjQ)JOX$XxhP`gF}U_b=n)9FawiF%JP@VLbj;wRgXtKhQ{!|*#cMJ& z@lg(^M(Gqa`Rs1~ky79K5v!H+FTF$))(l%;R?4L6B5{>akL*?!^NzR??K_s=i|-hY zg_AMH`&DD?;UJDZ0ecyX_TZ!=K)FT8buin4arMs=TuUn}moJ+zVachcpS{?$c*l#< zmda(zDkm&iLg&2L)U@-3#fx4*Z*<3vY)D2duGUQ!`h18>i-{(7or7v)qlw8F;+Eua zy53<9IUb2416;B@J~D!3SI7v7c1T)Ph{YudQI4@Oc0sMJNMKYi;An=!DnRn!!vv~e z7PysWa1)VPiB<^CJp7kCFY~=>uopz(pzGoICxzqAoHRbE3 zZoay1$OPqj`AYEAT;<@Y;gjjgDP?>1lsr)5*r??0b*&v%cnb4<7ExLYFyF=G1>g9b ztn74$Ju-|IkzD#%-Trf=M#F7c5 zW8|2+t^^V;*rS1`*>eT3e)4E8k2}{3586#HJU7OHCELOrFaX(b0a1lVN(NAbKoM}q zv&$Y7#nZpJNIb|q}r3uPk1&jF^YMxs;c*~CM3zf6K&RsM%;>nOj z>#Z4aOVjUjKKFQI-4xI0!MVdGyN4w$RlBsAb8@r2BPJ!sl(ekL&-dkHUGBIsQf!ch zBI;)dY4#0F%gRr8$COyYtnT-X=~?d?lS|%LS;O8_4Ne}K<}0)$IZI;lMQ?h9*6p<> z5#NM}qzPVaWkjKuR62)Z5yKzPyeom|PqwePaS|6m73vT)+--VCIR^I&^L?@hmJs@|>(h1uKR%Xv1IQZVLWa+twrcccG{cObp2L*T15Kl_~ z%*2FyQazcO{tZ=wiihV;@)e69= z4CWVP8?hK_9{!6VU+q4T(}Ucv3*AftM}|=_41}$2I3^k7pl*R#R`Y17z|`mG<7vfl1S* z)J*+HOH23UNz>{kPyAA>pW9fk{QIdb%Jur03+Byipt>j8sd3hf*_fo8_=H(?;tOIJ2s>??*T=B56E8J2A zG;y7!hlQ18v4CPu2$<08Wg>C!VweAysFJcR3&$_}$zw|i?F9?NJB5eI+SaTL4=8$$5g$!Z`YCO6ISlH`qBH>+7};fz4E~1 z+9@?t{;|3jSAP|!&1<+5R~*f=?Sb3M)UEK81Fj5%Sr=pFJ6Nn!7KP4@WhA;q zlx{oU47uXoUE3B7dpY~H;j8vlbjtgcYP!pRg`QT@*+;MxC?0yQfbG|2c!91%@(6l? z=pl*Z_3CTP3j~FpHh*|P`I32ol${uhNwNsvK<;31nsJEJBxhtqfld{qsVbpXW8zjC zw%frX5ijONn5Ne*jMG`$)(8YIg z;K()qH2S3yv1^91rlW%=n~~R)h$@d=)%|Jiu|_t3773MNue)}7!txIqxeU=$92~DM{Ro4 zM_C4v5N=UTi?vKk$pSIpZUpXI?I}Kiw5$_6JqVWT0KsI6V_%{W$Ti?%pr;Rg5L@~` zK5^!{m6IzU`+5Ji>Y3{vo;0DYVffa@6^CA2{ooTLhHahFimRzl37K`%wk%%o)RQBo zO?|3q{+2CYx34(6{TClD-PE@7qo4iazaGJw=v|>ARz;34O8QfXyiNNjz4{#4Mn5*; zG$)N@H3*ha9as`ylH9X=mF1M-A6p8!a4TXF1X9Xaq_VL7W?I>nY172-m7Ux-Q_H-o z*g?sNquvhuu_#f8R)f?zS$9Ewp7p1fRfu2K2zuUE4%-J;d#+w)aX{#&H?Eq+RQH66 z-?G1LwYB0NWxvunlXi@wPjDJ^XAcNIMGvY#4`8)Ut%~=6;oQ+fpGawGE25>p?FmH( zLd!U1-b^}%R?K31dM9*d#H50I4)eM7vWEEAK_Iaf&`g z*S@cO`JK}FG}~NsUhUpG- ziA?|%yX5+F;$QUS(|(@BgcwJdDMYVBoJ2@JLsCDGUu-6z`*KcTU-9&)0NuG6+>8x$ z^BPQ?Th;g<4`>0cTB*@2nzQm?>e9BI23>r-+N!fz(;Pzwr)-;E^O$GhhTc1V%qah9`81|0oPb=;p~j`@oexYOFtIX_L;+i0ke?!fob+CYsr%?y!Z!xP zn0s;-rN^bNs`>dl$~VV0z4E7LYgcNjCob4Lv3mZK!kDpJhi~7rzF*Y9YUT6|q8v~L z|M8c<{(j2mkF5UhcOG8(Jyt`g(u^Y--U1a!_l4^ugCKvVzASu3UN>kAIvhVhWfhYP zy8`B29@Y=EA}0_t3`ZZ^J~Uf;w?`+u<&TD)Csg>#UnIZP?iYGaZ(1wniZIbovID)8 zqnALmhj3X!2O6BXB*Wax=?dc*-C#skz7fst9n#J{J^S{^Z+&-2b?CpD#CoIW#y8S( ztPVG+^kwM5cK{# z2s~sY-{tYpQ8pPg4!00 zp41Zwg2Rb3CjwhIc*T~2>(0>0&*+~O=j@^ix_wMh;r&YO*g|@h&dnU|^$u6A4D0V5 z4*asy84k%`BSWa%=QfIzXupa0hlTvjM9t1HtI-grLh_3+Q`H!4oM~tb!%+-OA?W6( z4q$!YA6praUYH;kpxj8UW_ysBk+6*w??NgBGM=3H4r%a^|MgR6l+XWiS-Jet2maS- z)l0kSQksakoMpRz)z-FZ1s!{mO0-lts`yVSzg)JeZ7nT%oBHUpN~3bLOX)&b6_;&P z1<-dGmLS{E5WVrRIpnY&jtl*62{8qtju<49CA1XrG>~mTk8jF00gqciwxN(^WCo*} z%Qq}a!z@l2t(=mo{2nFl&~f2?vEF}-KCeupGwDiY&6jJsyTv-hZQvY7^nUP0vh<-; zfGaiV*H~ZLZ9)y)$bd#T92o|yOC)$vn4Zdome9epFhWxdsRrj61j8u%U=p`-Zb~*R zLecBRHs?YOj4ZuE4YHk}8NvZ|b=+dXP}Or0PSxzKE4NJ;0#Dk>XI5^RFo?yjaPRX+ zAL%E~WDe-FXN}_D9!sEhhX0lq-YTF(~ zC6gA%*SO44c0;sPvKt)|HMrbnM}om>jI%Lo`K?4CwjQ`+f~|@x*A$*U9Pm_tj4+}B zGR>5Hwmq4`?65QR-^^b?qL8pQEX-_5pOI#^rWlkRg0p=_gVMa@A-X^u}hqczE+G8c`+=ON5ED@nlI7}pd}2ov+LcL+< z%7S|jF6!ICq794lFYR3EFqzZq(~M?zFp4-RESOa8#>ps<^=TdQx~dVA5$Ow|--_GF zKUIPi(RRq!?j=XuFU0b>rhI=utX6dN2^Kw+f8(swqhfI)$eZCoX0o1KrT-Ec>EK5T zXowp0155;TzAJcuiye+?c4z>yNP1TK_a`f_F0@{wCLu&sH|)P(6W4eOEB#?|8`?jm z^dP&p2XaBJZ-BF(+hWj(M!h2`CRTFCK^rk{)T`{|6YAa=7ip!cex4+RvReeA5gl>* zvD#U2>KI4AfW*x-eg*@MU11gz`>_-cg)8e2_W$({I;0*KcfI{#1(hzA_6^lPCZA`KE@cL#)1x{soiHPxepV zwrED(5O>k=^t=a!t!&R9pqcV@aSP_xLx%ejZLY}JgcvJJq0yN{kIS_!^0x`w93k6O zzcp=LuSO+>@`*eDi_n zO6$~$1FL4eSv`j?udY0>yy4ABGn7Z!y~d;b-njiO^rMl(+D1&6H*(neVG};%*YI4m z4Vj2B+_(m6I|`g#fIr*iGgBhIPW}e(J4-NBODrlfAem)$BLpccQ7gKr)TE>%W;Ih7 zeSNPmx=niF`^j?N^+9L^tt=;N#C^g=tU^7D``2q^K~j-xTJhfoJ=PK?b&gIo7iTjH zvzgbKouJZ7w1cUhS&42Dq8_+8D|gz)=V6uK@oJXsuaBTmYVcPfFgvyPI!l~_j*x#Lx(8L z?r02VFf}5Ng86k+D>;Yj1IuB+g773GIeZhALcoFmB_1aAKY@j_xF9T5Lb?A40@9|r~A9xOt4#DSy_u!hj^&Gm?knd27OgLmFBb~XK^B)%}^CiW`*h37GDner>|8b~V z<6V&v7ReqS10qf(38CHwWS%0fACkvWMtlMe3al!oXE7QcAT~i41k?HNydfNSgqhoG zmglCLEh$P=gx$0eU(zhrRAF(LYwP)ocK752t35t&g>y@gCJGqm0Y;WRUGDQlM?n^Y zC~24f<4~JOt22xzC`(Z)D?c7YPem(@V)7A-LgyfIZG}0Tp!YE-xqsx=ktsZyr%%?h z=uI^Ps^JlUO8N3u#CWbQ17Wm!WP(?=qGe1NIP=FqQ1NsfeL6Xmg;fredKcvsOFwAlt)OBFO zzRMW<9t$J6`asXlwtEKFvP@7eBcjmKeBq}54*Sla`fu``VOz*^(S~_eaenB$2yJvQ z9E1%4B*k>~3dbZjlt7fAOsVR%zT>-CnLcn}dV0w~VKs~sRcV9RmqB#S!1T0%1Jlw5 z(IjM5Z}X+44=l+@^D#=SxWy}~#axDq_n8G1%ySa{F`}%J)zG*CocIF7co1c+nqF5{ z(H7c*@~UD`4021)sh)Sm0x9wP^WUGA(m{QAbPo4o)&yzHMwVNE8kBMj_p}$^tmy>x zp~_xF+VAD()WF9;cadkY=MbIGHd;4M@&Wr7_VzS1h|dIr^97u{TPwB5>wv*bveq{| zI>{B20UKjNtV?S#7}Gsbb{MV`V|ujLUEgO~d&KL;tjxreq!??sE!~r%!YL~Wu@>w* z5^Y;V7KArtBrQ@c;HIm~IXx^?3k#=@lZy%XeAoYI?QKp?sOFFh95`xhNiPL_fafiKb?&ZpR^bvVdM{5K>k z#s(2I+nc=4)Rn$$FUW%!#RH!cNbma~W7mX#j9;!wR-R9UEfvCRyn6aH=ooZUGWQ0BnB9hf^z8T^<0sF*GsCWi_W z{=EY;wwxPuemm5OcKCCxxZy#LR_9IccTo}ZcEc6U?hO()lpg7Ie}8tV^vwcgKdmTu zv-A=ug@$gWR|U2fv3j+B(V%+h$2?@3a&OMyp_y631e3SC+?zFY7^5`*FP=fg&zunF zL6Ts!e6X)ybd-agmk4@k$5|6(_1$SXI}YOxVvf{2PRj2*{pts#Je!m6;o)XWT3=Eg zIC28K#%=3!MwXhLmZvSl-e-{mZb&9xoXvU)3|(QYZm7P{5U%rSM*(t{M0n-cHQ4d5F;6Z2v6TQ3 z5F#I0APIgPl=m#CxjjsFwrUm!>h8sM(3NuNBb+^@g9IRP} znrhAsdf(X?teFpz@UPq6862ny%C9W)t5<&A5RBpqNVa`zJ`PB>WWkM3Z z_ZxahEelj6OT^~h2xZQ6vf$ISx;^Sk#||8ub>LvY^?3Cvqy3-YOgT5=yP`-gvbSyF zIK@iT-5_QqB>aXL9c8zLzyu$h?tg_Fz#~f=IZE}VrWQ9lgc0o=FTR zx?rpJa>rND_x;60b@h}f)#_^fy7lXSB5Ots88T`^%WB|)?t@ukDUuq%Hk|w zg#gwh*wb`O>%n&&qEF3$MU7gVM2SfhZ3F2-X3lZFZq|I8Oo`fw2PS5a-9}3gvsA`-if3^Y%{ytCKs& zG2Y?IXaSaDz>mCG)eQ|$t2L?(D@7i<0(StWITLtw1zbjfAZ*YIVbsvlwEkm8FPwAV z9N(<|>4`04#`zXc1g>t|HG=#bksLzCuz+17_1QHLwXkp;ICRH-Y1Y95vyL5*Gp}BS z!yYX_vgT(vgurVQp@DTz(#x&-Hli^gxP};XsuYQ^ENP}B_VT~X?#nQn!v&|#%}4fC zqFshwPA!KHy-cf>U80kYYFXDJj8>BWwf>PMkol{>jD4-aC$wr+-1RX{CZg1CVek)&;XmY1>jdrRCyMtInc^9XfNs-`&lk>V6gdTFQ<#|tHHD7}P2 z*h4Q3QDWKGzbLV|NB=T}ZPPM13Ckt+KY2KOS~%%I#*yyB7%OWVM}@F0ilbraxu>as zXTyBS{uV&958gza{(wC>&6gb$ao59P4c168_V%-3)geY(6g%|u1Xu+;ja+*G;p8d= zyJNb`xv;lRzGZQMa<5m1iHsChLeI&86X}?$fv#NSA03}tQtdyFDLSXr%@ubJ&&?g~ z$@0c3&93a>xt`R_C>px_$tX5&Yy>qJK?YgoEBQa13yZvZ5*ZpEmwCsjux?$7F(N8O z7Bl&1E_9hbIKy}!w`>Fr8Yj9S@G_Q&@65&%aBu`&1aK8(QRW`P*&sZZD9Me@9lYv$ zsvQgM4LG%ES#|L|x;ZI4BJsOV5+lNsl*eZcnn-J_24)owDH$@6?&?3n>zHScuXH=^ zi_S<)i=Jlp4A0FQR+yJ(&=nVzjV=Q9^xn9r*#w=Cod;`%L~*Y#!EOzsEYJj@nxU33 zCTEF4sH`){rp@#LmfWYD@qt2ho$Si_=pEBLrVrq~XHhAze3+sB z!*YhqVVoGttV?VK<(t);KtR{ve1MCqo_$tX$_!3VfB#1NwX?K9dH3vwkw}7T8Mz@~ zg7R;oSBnz;`#{e*v^9V>1{skavd&i;6A>ScqlgpTNunlNP2&5WM=Zw0#wQtKVcCcx z`Vh$)A+i&RgR4$-CM3l>Nx$BKBCAb_gLAUW zbNhRBngInRBk}^dPue}879L0v>_<(;vpDFW-nc`42Q?|dn)7rh=cMqoNPD5ZcnAV# z_&evxF8&TUDScb+Kuxc9ej%uxe~!E?c1n>4|DRpponT%T@*gvKUhpl6?bCq7#x>V6 zF0mne1V7-|H1j3|)tr|@mI~C6wKt)@{hdoc`pzZx4yeWdFJ&1}^8d{_@c+-Oi42DV z=fwp27U#+oM@b{CId~I)Mg9zX^41Si8zot#)@XHlLrAF6WVTps_Ap0yL}XNSOl+Lf z74J?+O!D+gPDxEm&&bTm&hhro&C4H9P*_x4GH{Tuv}|zskfFndj~IE+sC!4>H|G9| zvE#;9PN^XDi&0nyvY0=_`nwKnHwtU6PhgUt) zvU*MH+DF&@Wc_1pk8jwxslDTg%}+kH<>_ah-TK_N=ePfK$Io7Pap%u>?cVc?y}#V| z(*9p{zI@=<2VXh#n^zCN_WF@G-u&&+w|@6_*Rglr{r&Ox-am2jgH!+Y;U7+)`RI>l zKR)-T^A|q(^x~f{;pB*N47iXuA*Dp(|I@kwal}mHXf|Ywv2-e3f}^XS5Z)C&5q}{b zbtXBpoQ2L8UGed%_}KW=_~G%>6W{wrfc#0&!Vap!|CSg_vuG);pp)_LO1%4jwRI-& zQ5RPnf4kW%A;BCF*ab--u-TA=BqV^#CflMIB{V@=1UZ^|ut33BluNwNqE)LV(hpi% zD@Wu=L4i+5w3bkH7X`H*6b0lm5jD2rt<;9ye%}k&Py6YAKl7W}`Okmm&CHwkX6Apq z-OdAcZ6B@;+O^IhX?E?ET+3LDcfi}<;tt`~#NpTYh4J}u7O$8x{if?(k>e|mFF!uz z*wq?ybm7q}L=JsQP-j=Vx5Ji++C1g>&QN{(Zz~RqatwCZ&Ygofu|vo8W?9ENWV!6b zzS2i>4{wV;Adkx?Y2=#w*d==rD|w$|BeIFIzLsyW+O~z+>`T07 zF-yYOI-8A!fH~M++spS4U&TJ+U)eXDEBmm7_oh6JRj|*niuShr4GV?h;i`QWHay8a37h=P55#O|0ip9(8Wf`{qZeVBNM($kP%6`Q&vWC^sZE}a)i8a8J ztnA`ic|BOIeTQ|ve^KN2SvekHSNmN#j2*w@au5rD+p&7reY8lcLrO6tKL`ILE{1y@_ok)iT6dEpN%K)3nfYOoP$qUI-8qilZnlfu%N)HE*W>#0 z|33b| ze}=miw_KWC2haE);`iqpx+A41@iNk_$M3*WXdAXf@0LQ>XV?!F&Wqy}{LQq%cCEM7 zoqB7X&(_K4SDOBhQyPsvrSXh|zK3vG&Z77!{JgWYDSiLtpi5~x>!4$Wb1mg`@vdu^ zyu<(1u4f!0@uwu0%2UvIW4Ckg^qXTDE?xVs$1$F6pzR5F>i_OOr9Zo*(REq8!Idnx zCgw_N;tBFw5${SkC`AcBmb`>US>`U3rS3-7xJp}z!>PQddGN$jKzW7m_QY}VZ(N0P zGwycy;{@^YeOpm((v_6`A?-l_ab8@vI#O|Nc&wN5r{y^rA|N1blxmC z<8F5^mpw_VX+N!hjJI64Mz8Prj;yqDl>fAE)W$+FPG@SFCT zI^z|Q_sIJQE`~cnyKTm48y4cm;i`y#FEJ>!@Y7i3Tjd?)(QZC*yy9La7botQ%awks z2Yjx)cBZ{c6TV=l@GIG@F6o$KWVe$>Or+SjQQp;Yb2e`sTgp3Uea-vKIOd@b8j*w9 zk;#SbfB!+9`yjoY=wjaLV6DstpI9{~vv%&q>L!(amvq)Rz1a`Sx+OUNC8l~J187ZT%kgGO^$4C$@SHZr? z53q1JR?e3T*dMu&dp;MjV>Mo?c)ROI>~_`2M7|$B2@AA8;mu~XCOnmQ=%&eZnSq_( zpGqw@E-%Lp_LYM2M)uD}?yFs6wXJ+L68#$a1rlAYJTEkPz66P`^85y5`AtakTaf3s zAg--VV@9dr+J_*dwJ`_VzaM&mq$jIBpwJc15VDZ3IK^cXUE6*fPAkCys_Jb}(w zgBDsRjY#J8vOzYYyPB|6x*5&%6gp?CY%|%f(q1M1Gx982<2fYyPVQ&yGP(T%dM$!3 z*o`K88GW`FE!M5QUN_D478*=-*4yZp189>&XEe)E^vZGcOuKZL&iOz-M2B{wv;K~D z`UL&-DH`u{)1P0XF~7k=?kV{vdP=p_X`b{zd-0`5Zi@6=Ja@^w8?T!;XF=+9a~93N zc6NBqf+cen&6%ytGVILnD%$BI<{@7?Z*V^BeAd~)bJkN5?oRk^0&n2BJlI)Yndsp; zx^?bMcgX!}kMnyx(BnvwGbuM|Lekcr3wo|jPD-AV{7CYjliy1zOQ}s+l=4K%YbhV~ zI|5a_MDn?R-F?|%}$+|x-fM^>cP}_T5j6-v{`9)r8TDgDebLvN&k8JcHUlP zyD#H`j2#(!GrsNZ>;1#t5A}YdPfDMOeb)3jnR#jE;>@*~yEDJ*Tika_-<$e=(D!t| z`Td^i_narkQ|zhmRC%U)W_hml+~T>ZHv)A*E=Y7xTo|req>-FY(%e-T~ zHQpKCx!%RzJG>8iS9v#hPxUY9|HOdG0VmE)Ja_cD&_5Zwp)n83ow|g#}{@E-Gj$Xf22oyjgIx;LF0kg+D7?Quw>V zZH1o|Lj5Mdt@#1Cc|W*KH12JGyZ_!iCv<1@hW`14>WUI|W%H-aQClgnuG^9vd7Fl+_$ps^bC#Seo)!w}`>N!Y@hEKReeX)$cG zn24Q?g87ohZH|0NkJp147S6J8wxKV+l=$;3WdO;OFO|@lFI5&(V>sDxs^N6QuwAvy z!kegdzBE}_Dal82JPIm3`A85Aw^^E9mL_8PN5KMW=SS{p?TV~MMG_$;vmCG(niYLe zRV;oBml+1Qs#wNwRWWTC1S>5~Ej21ewrctYOS#ps*>H!YZ?SNzg(H?S3YJicA1ouj z1P&Plj)|`VgK?}V(br4CQ0xP+(o)va?RZNBs2UE&_khZKWpL49bWU0<1ZEie;+GIs4jD<0)PZ4(X|fn?=aICtqPFu$+F5az zosGm!5sreRti(~I^b=N&8f`J7t-hlz|It>X(N>qyaBM4STEPJHoC38M0#K#lEDL8F z`k*SnZxK!@49LaQB4C^o5apbJDCY!3IVT{O87lt-sEejo{t2+I&>XZb0qUY*t;-m= zVh>nESz}1Qhkj0rZ2{A{HV8c$&Y~BBl5OZ?R0iomO<8F%RgBgklqgO%oNgGll-n%a zVCgqm`X=}%C|fN?TP$cT7KD4XlwEcp|(Rg_0lw2dO0Jg9@KKnt=w`ex7^At7cIBk%Ef{eDJ$r~YS2$U6~?y} zw49%C*y5EZE2xX2@_z-~*ou77J`IsWC8&KGq7C!GY(t;L>sSksr(z}iAADKp8r zl6jLK)NwtY_`_f=y)(i1Z345a3kYxG>;&>uRM|3t+^`VKb=BZBa=3&Un1*ZVxl2gj z3aUh!WN9W*ZXMwnhFb0Og%NMq!zWrKMyMXwMKu~G*Q?zQJA@_pMF(M6h=DL zfvSnZrisF)iNdCd!lsGB)`nrzL}7Y=5Ghp?h2a53)kI;_J7Lp1^|Z-hW{z!OgGs6e zlM)RksTxdDHJGGoFiEuu3GHXz7=->!l&%;utfvKD!E+HlwG_=xH;0+Ne`CGEwQ- zW%TT_R*KlziEvdlt)TOPhy)p55la&xO&ww7#)!3K#P~2mdk!K-$5+I1j#@rZ%O`62 zL@l4Fr?2Y>tM+L(?b9x*eL9TKJB-gejL$o4e05kp9}{z!Ik=9jPWrtX zRE^w8>54kv=%lqZtn-addP&o$-r*eyi_!T;CwzODITtf7hYK$5L8*ENGo3XP_v+nS zSx4v|D(4kno_K!B6=|WbyI0O48`r=5g3j2~k2S@zdTw;-UKh>aLE Nx@N?P)6VmW`#0Y`olO7$ diff --git a/pwinstall/gfx/colours.ini b/pwinstall/gfx/colours.ini index fc41173..685d1eb 100644 --- a/pwinstall/gfx/colours.ini +++ b/pwinstall/gfx/colours.ini @@ -5,5 +5,5 @@ LabelText=FFFFFF TextBoxBack=FFFFFF TextBoxText=000000 Frame=0B3C0D -Font1=Lucida Console -Font2=Bank Gothic Light BT \ No newline at end of file +Font1=Arial +Font2=Arial diff --git a/pwinstall/lucon.ttf b/pwinstall/lucon.ttf deleted file mode 100644 index 2885d7e1e058b29c07189dfa9d40e856e2a4d581..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 115068 zcmb4s31Cyj*8j}ivL`o5lXOqIq%9QaPAQZ&KwF^fTcJSMN`bPqY-OnrDgq)1f)o&Z zK0y=}!3C5>{RCxkLq#@G%l5=w#2tm^^8d|E3f0f|ec!+2T~RyR)9rMh6@-Mzxc|$9nu*ie4S0tq z#Qp<5$4s0$f5NFn`k92d@%-;UOsX6^{kRT3s>rjhMv+gqZddBDSA4c3zFpkzU91lkmJ}`q*ieQ=in|z~@W2e_u`Y ztl1y9>Xr~1K9UgE!J3(sHO@1o6A7^~d=$cHL41TO|KrSPOa8CKpk)>0Y3qU*c70*G zWhox(FPxP6QA4?9rs5cg&s(zpRnH5zfO1$mMJllPN6bKG^A&!%##GtKU5a*%&bsZ#CY!x zl_g>#t3qWB$s?QD2m~IZGLlnjIXJ?LYFSe2uc>8?I`W%pS0Wayg;0hRo#psbxLGfqPvo8(6>GdurLJ z)}L3)X0`maT9#2ZbHA!(JIXemSIc4S8Q!6m9VpAZI(vdstN7J~S*zm7FH+0FHdnH;F<8G*Evq>5+qzZP%%52`anfwh)1HjH zyev=Gs)?0TtLJ)>JUyzXPOF^d={dckou|vxsUG#QS)Q4dvnprSR*rAidrn2w__3aD z)zfEHPpuqSIdRU^u`~Z%=?T?#@-Y4yJGExg*vyRLbWcXR_UXYpp$0>b zRn78@MV}L^X3eggSvlS_d*;~jmD9$~oZ_jT@b}1)zNDJWB-6-PG8Lt9WIi>KN-~*D zCtm~Z+#5t@?Mz(m}is$%>AePw|sUwxS_>oAy&u`dI{Zy z&Unwmow1ljHlFDiMT_VDRPKUt&cqx}SGn&$J@udJRr$+>q-Gdf$q>bn0I69d;|kpf zY4GPiJjV;7q|xg12BXPrk*zj+n8WD`kBE$lj)`@9;^Gq$y-CR_ty-tHY1=L>JtH$K zJEwhahrEuR@;et4`nq)OR#aTly+_Z|UcLMD?bm<6z(IqDlnotLK77PT|ESSp#*%Rr z<0~gjoK!V=%G7Dot7~S=oHct+?c90u7u4PLkA;is?_PY*lBLV;U4Gw+mG`e&{lJ>F z53XxizhUD;n>IiE&qx0C=$5UIZF~HQ?N2`S^p0n^UC%!E{0qDHy!g`Ieftl*{0e#X zzg|0d==C=aA31vL&9~lu=iTG)z5l@p^5Mx-r_Y@I=-kJjeA;;a!bKv8nHcnLQconX z_CmUdK1gqIZ*p&Q=lO;F3jTh6EC0S=6#5Axh0(&=*rl;QdmNrfPpl^%@-E%e(Ub2f z@DzC#c^>yX>Dd|QjEj#;iW?QTKJKY_E?$ba#M|N{$#E*@yOyCmagg7tp za$ciX_J(=Gz0ux8ZyRs6H{UzeTkl=sUGBZ#yUx4CyVJYd`?B{{?-B32-j9>=lYB{C zlg1=fBuz+~@`LI3gqz&0Tfp5zwgBfF+%e#M4md9X&a3%t0u{`{0AZA{CbmBICy(9Z z@1EUlRpFD<>a z{?d}mUtj*}@@JQyCgk!xm#`jX|sj0>X)xsZOb z!^PB#(dP@!cRrteKI445^Qq@k&c~gPJa0d5Z2Y6~i^k6yFEyTT{G{>y#>0)THSTNN z+xQ$IjgK^TZtU2Y*BIRx*%;C2v@O!lffa~#K$vAixXD2X_Qt_>Z28B%$nED|$ZE2ZJOWkpI0mzV zQgRPjM}8nb!kXGhmQ#*2l56B&WC!_~{6u~skC9#EEpm)J3sqP_)<8VH1EKdOd7HdX z-X+J$d*n-q+z-hIg9W~mYgOhVS`PA!u*!p2h~{x(L4>payr=p(KZ9>gQmwxI`R*47uip?l0{@8R^i>`8}c1_netSiB9*9yYROH~M0He84Y1Aw zM4={XrWSIG%G642)K0^wgF2~;hSLZd30v+ra-Bxg7#d66)I;NFJWZg9)Jv0SGEJea zXlt5EekW&W8`_q(qiHmqX3$KUMYCxRZBKJ)2bxDal1t<=?L_lwXIelDsgHJ{U1>L3 zM2l$&?M{2pp5TcWXesSQd(%F&FYQPB(*blK9Yp>hH^{%qXLK+fLd)n-I*gXn;dBHY zN&R#b9Zkp3v2+}*pyO#Joj@njNwkW*LMPKHbSj-ju8_~^baIwlBp;Jc$fx82`G}my z3SUPX=z6+=Zln*{GTnEsPKLjOe{rCaD$`WW3tAE!^y?et0d6n&cRpwG~qbQgV= zJWQXX&(jy^Zn}rQNME9R={~xj9-uGNSLmyde0#VAE|Kgd`^aJPB6*1%A&bfD*jzZ$Fj)svs^9jk$<*2tU1=9)+N?W)&n-Tt;Y7e?S{Rd zeUtr0SbkV#*w!$`5$#yyIOsGu%bi=D7hNT;m9F=~!^2lZm?K6U)KCPuD^ycqdS zRDIOSsEtvNMeT~(A9XnD{iu(lu0&mnx)Ci#%h6HMNzob6`O)2@2S)p&Cq>VSUKo8} zbVKx`(L17Fiar$mZj3QzV9c{Izr;4g?v4H2J;(iITjl3!2$H6eI5z1ljnwIBZ` zwVu^_Ve5}m2c%9+{YUD))bHCk+H`6&v(2k*-fVNSt*>o;+t=DT+f}uDx!w6RKCM&Q zFKM^Z_34guPkL&4`}8j9z0-%Lk4vAHJ}>>A^wsH`()Xr+nURyxC!;oFWya}DJ~J(I zc;<@Cx3ah_Q&xCZLRP!1VOcL^x6kg9-8*|z_E*_TPOqFPIfvU@+OKKSC)R%t4*)6UeERBdXMe>QlGp&UHUxO=kva4eJAvNx}UY*)BWxJSNGrCe|!HI z`oG%$&Hg6`#0+RPVBUcG0m}!h8}RUeUk3IXxN6`-1Gf$QXyC;`tp;Tb${SQaX!+ot zgC86G#o!-@)C}1^tZtaDj$S)a1I$_|u$H?;N8*+X9+W*jzl z*xvGl^3?KWIKn<++K4?PUK^P;a?;2bM}9lOX1mq!%aMtm;~|rfO%^my_+2hfSU}dHdwElfRupr^HUln^HDq#*}qa_Dnf7<>#p} zQwye!p1N%6uBo3+y*14{ZQ!(d)BZK>__QCVJEwP@K5hEu>8GYQRi{*suD-u|Z}s;z zku^m%bu|ZSuFoi%F?>eNjAb((p0Rso`K)cTyUZRsd)n;fvmcxNU$Z}+W1Z7^&gxoQ z?ZR4RZspuJ=gIR%&s#BX-@L&5lKC^{zdrxl1&#&d7A#q?Z^1Wp`nr_5zIEkw;9|mt-4cp%_GED5~&~W9^N~_U8qfPTg(Y=lQF?<(5JcelF2O! zUN_IBxpmrnHzjFqjg;oD7&qMFA92YtYThNwyb*&feQaASoo)N6$Jfb{Z~MX0spBQf zAe-GiK#p)1$y+Ql9Vad0`MOkd}zbvxN=C(xFMAyXB#|UnzT6$FCGodVQ5pAzQ!=8sCSzW$#6)V=ql+T() zQ~&!P`R`S!sqkUBEo~A!D^?Wu9~KuERa{iwwoR{r!-|Wd;^NBNs%Ffs%diW-1biy; zV!Tiwl!Vm*&8~bQJbQ133T>*mJNU)j#nqazQGhU7J7uZ&%nQTZ7NQp1Ce& z!^+u7ULjABmjy40pxdBpGs$(%O*YUPSSA&)(5@)wU>~K>E~tHibR^r!F0KlCG8Nw) zsT_dq(i_&zLUI5a^9p%}EaEmxMX*0oge~0Nq?G#v{+kHc4k_e1Sx%nfB&9z_@E)wA z^<*AAZ_H=c0_atIz7EI+oD1Cx$8%=@<@nqHcpOj`tRp8w*IuZr1{?r91^6cTnVNBZ z4DdE!3t)YyEwsnlxDBk$Qh*V_+L!=X3}84geEI-b-@5=u0XqN}0HXk`z5s9~bls0D zYcB$@3BYiW0S15vPyrlX#g+BP+GBWt26QH_%R_bBa9spg1z_#h0rmpe^XxOjpOyUp zR$m3!0{{(ZHmc8Lrj+%;XnPazF+O*}^&fzP0M;fO$Cx0UXf(&2>Hc4g3#uFdpdeKKJ4 z)C{;sc>rjHbr`(f!1YDIHGmJW9e`)l@vycSzcQYw0AMUCZ%8QD02tm3f5zX8#~59D z<@MwiZjNx%>E;Mm--aifjfbIYD%ZL(`K%nH>Vz?H2XcAw2D>yOcd(SgyF z(V5*F1!%5k_gI^p3|G}DU7K-Ly}ZVZ6Yf&u#uqeV+vv3f?Q388ze&1O2y zLwPNL$ub6Z0HZ&9z6{VjW;WLhk5>Q;_iVr_KqP?aGq$!Fu(iOx!`f{gI~x}(v-_-% zApk}-W^tWhw9M@G91fRuQq)rH(qUOvf5mE zEg=nm8R=Q}gj@!3_AEY&fhGYE$0yhmcsp+FsQDu1`yMxAC_nw7XPzty*>Sc3#?$%Nv0sD^_#L`=n6~3X1or@DW zXJSN3g2toQr+6X+YLa4Y2y+V#ugxr*B4cBEAP!`9SbBK-o2l7s*V`frEFQNf&BJ?A z3V5QI^*()n{TTfk{TBTp{RzEJpDJJQAGzA-4;%q8()^%>d?XF;pwIC@p86IXeIBTg zm*>w&7jxp1bDUY$wbsgEQg zT+1a~4qrmD-L{NWn>WW~vq#u8+45P&f2Y~oS@r^x7hVkn7=ZtMwpdSM61K@&qgl|n zqvJJ#9^=JJcID$$o{{c=TiG6;gh6LzIx*JdObj(CAzpHXIq83>7dmacd1TX)9XpmR z-LYe7aamb$@sJ_hfxlFECEFk0^W6_Ntbgsb^$iCrmQI_q&?-$f#9O5dMxti=oFjz+{9{WbjZHjlUIV1L0IKbljRrYCzZ_ftW5qk&G8tlXa<3;mTFPY zStFd`u5j7KS)DPrfrG)kW8OL!`t*6Claxc2pXNiCUC@QY=LTi z;5eqPkg+r*9C+3mmlFpK7w3qxa81CXXFP!L=NE4RY(YCr0Wn<6P7nkdV+sQ zO8tG8W)L)QHDpW$q^*J2Nhe?H9H~g+M5A7I7$aq`v9-L+c%Q5_+K4FIB!kXswpnF9 zo#*&4`K%uzEWFR5L*`X$3uIp;;RYdqp;Pbedl zN0fgm!yC9-Zg$}Q022QwJaR;605&?3?Q;zgktT*z1`tg^-x`?%9Ya`EsBU z^9)sX=)@r`(=5!gnB&D<9H1+eIb46bvO!o>zTm)(CmYZ@BDef?v>rifd_}cyT-d_yOy{h!-ADo2^nQBAfSUBbw$vK$zPc8VVeE+K22afH3{@v>{mk<6b zjq~sN?uYVyFVB5o(zAWfzclClMg7hl-39!=!CXa&-;+c#+?N+?&>L)eeMACpOAy0s z5r&f3ve>s{zm64RCB0rRkrK~vsoXkQs*@I2S6DS3s}yauI*FGdef4y}&sGN@C~(+^ z0NygvbD{E8g_jC*FtdH`pOF>?YnYG_|IOP|mpy*?#W8vJ%+Kt%aO%dVwmo_5qVg;4 zpnUu7gPLbco>;cwvDI-Ied{L99k45J&!fNJHAOl9-cO9*FvIW>6FsDFe_xy7rYWX6 z(@Ka#K{DEO2yzQV5cCE^rD2v~u|Y8KT1jt*?Ma;GI}7~%{6kIojq)Mj-n_{1A-K+I zmNmqKssl%l2A0snbmew_W7E(EaD|)O!q%D@)RcgUlXUb&Yi*Y9Cf?={ zO%9{JR2nXECYx2V*ofZgy3;T0r@#?(+Ef^jYa7F%UA#eR$#L--Rl0bHBa9@(Q}fdk z7CfT#^=5H<13w@np00d%VvhFduK%@;_7b=^b}IGC@1MP+`~r$Rrmn#6A*bWW5MQ>Q zr&6>{s|_z7V2OU*b26@sn~H?qj8yh3$sSBy-@Ya@q0da_9x}WyFcDS1YNV>rRgiz&tI_i zpW@!9`zVK$PhV4he&aLc6IzdmcQxIA9 zTbk$~&U0XU|E5M|ASB}!(5o+2aTxXrt;ut~`AHg<+Nm+x4DK+EqqRrtZ9T$0Q9sdB z*}67zfp=Nt3a{MSqvuU2#Np;+xDr>Xr_5CzGq81~t14!yXO5}XwbZoCWo-Enml9(V zWHHhvi(Z>(h_`D8no{iCK)Xqfamlis+MTH?+133N6NU1x?4=3}$_3eJB*L>4jDf^O3$(EA|yQ zUIW#LY$>NUq#A>>pl)Yiu`#X8^kYazD(7el?_~O?>6@UwM9WOuqh&3!kfCdQy1sfX z>BrhOqHSG0pC~v@E%h!_`fB@ELmeP#E~xd@UaE~u@uMRsf76Gm?iaeNo!zlrMC{FD z1Z?2>L0q9Y2uns7B2)@Xu|!xhpN2}X3mTagxlLvWY@B_& zvQBBh+?K)rP{+rs^ojBrMVkO+so{0V442R5<3-W}jSy4J%%FfW!ONPV(G3lBCQOdM z;6`Cc0k1;fCzJ}qv4Gj~6)Dw-9B|8*8~=ivT}N|tRBe^}B#;CIuLi!~uBOBQJ7h=+ z1>ig$dF)+$amCu=NRDXi(o4q!z_cy6v|M6XunyQJ$-*ZFu*?>r`{7qO9n`1-dQz zp4Z2BoIC4-*c~*k<5U0I@z4Gxi$`|{ex+C$C!tRhknTFk*O}@}F`PR##_DbjWn{+A z$zpX|)2zHTnYd(^$Hlv>E>0WAiBVdEFZDFxC(V2D!cP0uN!7B0*QrK9? zD2DBJW19a6sv!WpZ2QEPi6??)F?*CrfNWb)&5ryrZyv_2LnE55<)r$*3C=l0Hz112uKDxAN49 z$Nx<`dcIJqV0T?tb`IhW?`n17wSdSg7(32P2uDS>uJmNCuS6%d(skpy>qpQsu9BO> zE#-7NQP2xoNu$vVG7LVA45g{l+C)hYlZ>O1fUj~WP)^Vwou4-n12b!x?CYG?i2VVK zqT8;QK)yzl0~+=^eS`tUjAmh@oq+9`J&rfh8%ODl59bH=*6pRIzZLl#0op}5NY8MU zY$wd@!ePMH3~lWueqUZEO<_zgO~05S(qL_+G(oG?SZr(DTil%6P0bD)mBMXiGC%4* z+kH{IV72M2QN-fHDGHA|Pesgn3><;m2X;_MVq=m5Y!~ClHo;?shXa<5#ti(jJlOrG zQfsqSbO8BVZ#=w`R#p`~`}%9eboJ)*BX=KO_u~gWK-sf1pGfGb{Ps{;o|ij!VOsAd zZ~rNGJ&1KS;nrp09vI0E(!m!S#YbphU}!aV8;9L$u{=cP4b1+Pt)kPZqNp0UaMy%% zIYSJb<54*$6Mh)*3UoPmMY!kKbISY53Obv%+407)oo_0)X#ABGucUN`mQF>c+`Nu2 zjZhl@eMPy@1M|KZlw1l*>fmAQu1<|^}ivm{ty`kM7} z8hj7^F$Yfj9Uh0i^WUM|ZK}zPV98mY_Es4bTTJia>Q@fEb^5*v8hPzp(?cR3cu4u| z`RdUPm#CH+kv2dHHZMXI@G+3izG%^=Ez#m|2O zbv*cqUp3!Cvu#bl7Uwn}2<4&qzMR$XN4odz7nQThN|h0WuhdEZOgV3)gBk)meRL-F zieLst2M_~tnbADQ=fYN6Pq9^$aC}K43tGY(K#3r^RjtaXoe#SvxR!&o0JX85hWfKM z9Oc}{js-4bZa?5MZUnf3z#FWOUFgHB_L1*%YXyi69aIz17<4+ekHd+k=gA>tqT)18 zu&?fHP5O_(s>bAEZjay<+|eT&E>-A=V*w+CcSR8f zqbO-*jiliv9S<{Dz!nd5u=R zqg0(Mr;ik#R?8vb$%H24Qbt4_iJLj&gfM{^nYhs-y7qEPUHSCiuDx;pgz2 ziP!T6YA_I%Geb5-0La-|)^G0ijRR8+`K3 zcW(2s27Elymr=wI=Ew81`IS16w`;XJot@)&UZ>??x&T{T4N?}LE>gru3|Yk0lEbmq zp`L-v9hIdKRCPs~F=OlwtQubC`fywK2A;z>n?~?kZv^ z4ojrNYiaGMv`lu)u`Fuc{o1UhU1^ z6i9k|7_0(YPBv@>u7I{x6u>D(QBIxQvwi!EFK*wyhg%HdO@meVo^o7SN2k&3CgmEn zHr=FFlAx(r%RKldZ}S%F^^OjM_Uk(ANtg(Ny@Dw znNdF|XM@Dt7H~Hc(pHCbTy1~Vs9Y2leKw~MYf)iW%_}(33PJgl&JZUby3Uo z_eHLVvgqMe79*ovv9Y4dC|KfnTbw4$W}&z1Ns+NYc2SpD5NmZM+>sK9-uMHxN0^{@|aP6$IrDdJcdv31Z#SRifpA+E# z=2=4q`3fb@#$$cJ6)Jkf{$jnjM%*GkFP;!DiF#S|p{gcSc?gv{5gto+%njZqZ235B z$RK5AfLZ-B*h+$OgHlsf8xjod!WKYvL&MFrtlv$bb{_g=I?YugmWiB>NFpd_khPpF zLxTLp8pGlY6dqw>Bg@LdFYR+6u);J_9Q;0;j^4fIp=CSs<}2U)_$9>XugCZ8`;eCc zt{ujhG0VYwu(JvW?`Nfq1zGKZfftswXEMpe;q zI0=qzE5g)JbD#|3%>v@(kg!^+Y2FHiH*W=wFi+iWJx2V%HIAvVEF5G}%qMU-V%t*+ z5A+1S=|%vpV!t804xB9HXnr_<`GtfzV_mDzCoA^yWS7#AW65{}J73oQmE#$v?5e|!S| zeQ@xpfAR-j+si$%;ndj|I2aB$&+<`CKMJw1lzt4LCkl-bq`iT>>{~tuCun$`E`mDv zNS&8&EwnaU%_=VyE-Auy@ zx|ClnuFx$uc&Xl?*Ks-x7OGCx@>*WzIJgq9qvMEHhmJ8?PNI5j;B*FFH0WUdNm>(j zhp<6HW(XTJMtKC|Jkr7zxvI_2*T{IIuuw5@Or-isfNzpsSF*px*_rA?N;~@9H_B3F z8n=q8RlM}m!1lmUP9OLU32yq-g zMXbT#>M<+>FciU;NNA9-XVK#5wN5_ELcN$BRaRh1STIwyDc}N9In2swl!(vh9Qx2J z3gt}PZ-M8z{sDd9XGZ@D;86`cbY!qE%0@M8nWuzvM2oEM;e*s zf)_%gFKKL)vq>`297s7vq!&g~$i>d{ioVEQUor4+HRX$Cd?aYnV)O3}u>YV;@0 zXQ#c1(Zwh86OqO|fET#|*kYgz6+r@W%0@w5X?#3qGudpq2wQBjjpNllN3>Jc5l^DkB6e>j*PabWsNm3%KqET3dK%#ZbedLs zJ{&8B`G4T>N$dm#g-~)&!=~5JB&@XZQNoX`9~`OsIWk-^u+SJkz?P zJ=Io`_29rx%9KfEci*#N$Kt2o_s<$P=ILIKzpdnr>#nc$;830I(|%(xmR+~L6e=*M zX8im^Utijb;fKRdhhGU7sL|P3)LCr?-bA>b+S0Ic?eMV4VWQSr9Y({5iMPPYh){L0 z>V!bj3=|jJm%ha|PlXtR3(5t)H=9F-MVhR!s|rWPV0ImS;PinrO~;>GkdblU(!~#a z{^UBNlpE-NMfvPE2&XcXKbI=Dl4r<^2b%S&Xz zfS(d!4w3Nx;1KzXJ0$2r&lUPT_pEY7c@KMC^Umj9U%va@j}JbuCm|oZU;KOoZIk^( z@ukB@FLq-#@gnq}6QWQTU#kcj9bRPM!znQu;WE-8*w~pzA^W04>4neO9PE(3>8Jrb*ZY2fYX{AaBV5?rO&<<5Bmv zVi;$$@`adAu$Mu$_qQ+9tk4K{VgBp)&M!p0oP!oLpgQq3aOdQ<&e zQVe7#Bsl~gO*#G3mIoeOy>ULL3H-sYZJ2fCt<-;J&04d(p$UOSj?^h5h4#Ww*lmfx zDrWk4VT_|=5-KfFSJoS zc+yI``@FM+djwAQ31cK`H0Mh?{ICbM8Kp$9%CdTn7yC!sot4TQV=OGG?ga|v$a9fz z0duywceKxfyEy^dG%Ql<-lNOEp*ctU`5PXSQWg90E6UnH1oy(CDQ5y585QBXQMCcf zCQL%MMF%MlrZ0YhMe3jvWsXh09@%8a1EKHSK?0S^GrEqMiH$4NYR;Yw07_FC~Z{36G;+Jz470!7Tk& z`bNV^`)_^c%a@Q@zzgh$68^i_2F^*iZMdM9rauhYB8w(X!)b`>t_csiYeHKv*h&7{ zBf)$a0(VUz^J=)7EnOJA`5LX9PdhLt>5OLIO&qnJIZEF;qYUCAmERO1r8b$c3vdOV zVQx!?`JFk4@yVb*e#b>6J^QU02@B@9O8REPbNv-RS0!$QJ%I1}G3r`Xi&go0))=Y1 zlU^UyNz_rT#YH%CM~j7~SqgDL_W_GwAzEigi;JeY7P&YV;oaZ>>VeDG2d8fhsmDQb z=Ei|;!#HQCYqj~ES%pZgLlQ=i%fMurt}MJc9q{4=SuJ>#G*a}GHpkRH<_@Xl3T zgP+FsJ$yCFwQH-lY*`J6fbzm*(KO{l<#&W`K5V#f?C6CHM~}g!$B{kC92GC7*Gqk= zcD|Phii*uH)9J+AtkQ)R3S9<0LmEQW>5vr7N*(JrxWte)fw>Fm^au)R)}Cnx&7Rvj zJ*3fhHH=Z>7s%DtmX1@F;jT`IY~A!RBQ+{opI-qxshDL;hNDW%z1 z31un|b@Ro~a=96$yre@x}tOK|9nXyxJ+7lObXtiRdn`qN~TcIw3(l9 z^9?kq#&m&|g*@R~STEr$%AcGj*!pV?X1&EJMQI`oUXsKm@vXI~hE~QL(w@)Lc7h9~ zHz|_38Ag&3;vmBmI8VkK?jm#GI$5BrHOx2ON0xHS_!YWks_P_)IZVv(mBPhd4*m>?>I%F4Zt^$>*B?)nCFfe~I=l{t{X1(Wb+>V&a(ERDCCYW)!Gq0HXoZ zlmB<`iJvwo)33w(Y(K0#Kp*~1d0Y8_^KubNHC-F{D)0$?R2d6841uJ5Se@&!zRo(t zoHUYACn1N#M$B5hf!Ao;8++=Djph0w#>wIoeVu-eaiw0b)$1hDC>b>A2<7y!5>1J$ z?pE2G%6ph37hD)@zEsu|kUnc?iGYPP=u1I_cXj`o2^}(&4#$zlIpKxCdEf5Gl{pPP z=1vmKO{e&_H*+7D0SuR8rb>aK4$&F6lWK9I1wkl53%?30!LP!8#ic)fHRk`O# zKq@Ep?44LO_V#Lqikd#j61tGz6(^8>>lf%<#$!hfF8zY_{iYrN*c`99G-AXhO}v>t z0S8LY;c=Z-mbClG*X5J8MJw{-hWBh}xIe$w?v&*H4f~Q)cK6DMRYoZ1R?cyIFdA6? zJ`?GUtaqCXD~*FkL^U|z;6bW_6$!;5=MHA#B)mIc-KIbkqd=m~>m}hBeQ!_!6mXHY zX8lmRSk^W!WoTk_+jMw+{znR^JP{mTHaiIr%x+Z&-AoUa98Bvt9dg{sz8e?;jvhtc zdENTHQ{Ovhj?-QqG2*f|&Wu#xbBqA_D?orQzH@C$R(5JZfPD@7L4eZE$|a1YjQWK- z?k(&(D|{KU)ohnUxHYZj$q0~0VkOi$Z@2M2eeZgrMG6Q)fo8!#^oA0bgOoTKn>VU& z>cUJr9grhy8^a?{2avAkhyTzIzQ3Kf3(n7mNrVAFKV>n+iP?ljRJL*csM+gkI?vKB zzg?mW*X`>v(6>AIPVg&Vsx*c#Djs`LxD?51{O}ilyViyg#F72JaqA81E!;xK0}ifr z*nJMp8pd-D&Mt_eL-ntVvLtE3FeJeth#HU6=j`tskz|&h1j`iReE4$IG+;GLKBQ-w^K;ly8NJS6 zu?jd#q%o;9VaH>F?p{Cqbx7PvpjnuDkcce<8pr3hv~1r+KF_Sc^L0Du4LYc*SFg!~ zl*eh~ul6>Dg>BjtApank;v@1MNA<3%>h15;bdsyQuHI|YrjSu^0)9P}<;=vBB$a}V z<*ZiC7*Xk(f?5rJ4Qn+#gtvlO4QhRc`t(NzR;$Kk)!NM9EU3?_@fEeUL$Ef5J*#^E z;L(UDMXZ)vG2!oOS04Dg+Qs;Bt56H#^S4`A()v#A)!ViAT)SNh95U73oZK?Cg>4u! z^NGci5*4#XnLVp|g;dOX1Tnko?`l_`_`BN03Abxi%z`Z}>C0-_E_1KiE_TXn#1+l8 zX)S73Ha6GZXi>X3tGRZE+HSCgC0=Q(`UCa@2QpW4>+BqqlrMTc2CLOM9k3etL5e?y7Y~bJF4G{2rg8JVS}sAId)qu`+5K@BI)>XrM_p0rVy9B#4L zGzgtJWSc|p&=UMmEmXWycnI`09-SJjB*y#gyKr+s8^UYnmj=eT| z?y|B2$BuQK#P!|P`|EESKKkfl%u^YsaSU|zeUD7R0_4cY$^pbQt|FT~pRDl>^tj`r zE!i3ALR)KI$J9h2sl84w8585%TG|`gJyhbZ)K;ywMz@VOwwIE$t-^R)tKkvIt92zg zqIuDyr};W9`>&pJr%%0q^U+pM=8x&y zzGu5Gn~puWb-~t#!`$;VJ$hDkN^*+E@q@Zo=C+DJppYVoJf2_6&%}Cg`d|Yid7JXx zjf}Va=SkXmEH7r21=WIFr%s{a8S>1*(@2_8>7r9`7Ay^SL@dff=U zX#~6~@&!1Bv6@0BC7G3#XwA-TpB2Y4maO!qvUtd#YxGRrbtWFlXpct+5Bfuv=KQge zwSEwL)`uXAQptATM8e5jm^sYi;S$Y>mQ2fF%Q*8m%S`i3%VKlAWqqt{FkAc=H-XhZrwNL#k8KU*N%&Czh{rI{QA+=b$4y(*ttz!_U?7t*S(ncO#esPmli%* zSv78DW}nfUF5GN~46$7t{6-;(#!f;1!`Hvr)i%U9+$P1kv~GNV$qwIVu%N#<6ZA)ieGID^y?5>351T1q9B9(Gg`;{gt z?B7oXrD^}_7T^)R;jI%#5KIhwy zKBDnu?35qulutt^->f+EJkK}Op^r3s^{vfaXcbbqt~ZeKtg0bM(eYV{0RC67@!S7IYS3rK2QXUm}zn=LidoNM?|b zo}n`%d_c^8i_ON761!Y`A)KvH*tTq1F)#>hs1)@B40)C~8>OZfA}vE*vbP@P?pjp$ z&xY#JmDNvkS0ERZx%9q3G`*-if`e?m)x*MniYceC6DWu&f5NLVWv&~GW~pIiKQ|~gT)4;<7ei-u`1l{a7aSBHA7_$ryMOq*&z(OpcER+m2QW(q@MidbT3#?oYSAzJyUipnK3cRK4oP#sCEOEQE zL8)$_I^{ZjgsV~4Uod~u4m&1+tn-y2|zXm~p=lK&zZc1d!4+4l$nN2ZXtoYw#^52PM zS8kFTLU83~X`Cpjk$1Kq(m}0Z0#n{Al!Q2#;B1i{;( zWCjw+%^}#1y(dHz%nsEh}}fJE14#KzJ1>xzwK!C%983C5AryKoN)Nw z>9g!s*z2WgdJzaX{x}s+lSL}P%DMzG|+72c!TmTvlh#c z4O1r^01i4>|A{~ldFGO4kfa+Vu zn$Cs3t?K!*(8(}%zzhqSrf_!7_5|{Y*Zub%)eJvLKzHbr^;oJMuAQu1fgX`Ghb%H= zl%dCb`SgG2QO7kO8e_-N*ugP$DfS6`AGo?5sms%tM!;?znU`!|QSTc#+pxsIIp`St zB1}Jl1MiG6YYkc)I?@rrsM9Cvv-L&#UdCa%!TJ%#G5RUS8hxFyUcb_4GB}A*Z_>$O zPMq;Dg_~_oSt}5oi;0v&f&4=(DHC?FY6u0%laHO5OZAATKav6>1@jRg4TBC)%n|!% z6RbAm%9>pl`9HF-+O$ya-Hom_bPs2JUpT{`V535 zM|Q$0Yy+#%ff!MyFA_(V%vx>@l5n`nSeup?ZL%}UP7K9y%#=Iwy?P2GP^ij4mV|9b z3Pct|2Jd2ntWHJtcD*#*DE6SVxjvMEPlLPw9AyySevfaT{z8_mQ7 z?^C7)zB~8`GPPbRjy+8Iz?6x~sTb$td?02a9kcKTX2F0H=eY^m!J0Ddc+CXuY)!3p ziDsFW`JH7RE^!WCT-{)-0*y`3Yb4YlQcfkkiKj>^L#a7oB%I>i|R5A*wXamn16h6en`{A;R}4!?}BTE!>B7cJ?jjmN1? z_{C%`vIlOTH{eQO{2vKtqBejX8|x5WY$Wib7iO%-S)Z&BN-K^kl9=7laO1d`ed9Re zIrxH9pSm5Vm}B%fOX2se&ptx$3mdymgy z{U+liYP`cTR@a*(j*Z39cYTaq8yO?SiLz0S>L0ZxYD<(5m7+%fS!P*NUZHwq4T8>U zS97s$Z*w%5e`_+YW+Md!WKK4pr4=f5>vwe-(aG!0!r{JgymsSrU50f^87$7GIDK0` zM9ENQ^~_E#Oi#eCEzo|oG-U{Vk3P^NC$(S@`yY6&a>oTdFlE0;)7O`=+)T9<9uIy` zq$1i|5zRI>9xk2p!O%2TSPc=5aYPpzKMs*WpEw3Vu4D*6&5?&< z&zpAl*rlst)|Wrnb?z$V(oDmwgbNR^YK#BKh$9!c%F z{lD+`7fEs^!_3p~cHP(QRHq0M1@tB00ApGi8r@d+KXj(J5j`gojF;Yc{n;aLzVYHa z@4PD>d;8^=-hK0xm)~B=6c*OL(tg7H!(S;kqGjYk=`E;Ei4vFO+&~!+8LGvWA>^w) zg+9(cs=#<<^$j9ar3J z56JqpFVAR`AceZ)6nhFDOUj}x6;?)v+CbMKgH^^0c$zV&78ICkva&>Xm%d`68tJL} z>?#=HEfG=5@|1W)!Bb#KPMB2Ks~|YZl9@ZnIf&5ne>MDMkPW@iCv0S_7;;|dUE}+$ zT}ztJ1(IBfKP5;#Eb2~*Ae)ubTt8=J&_o#lQ?SW=GFIpyKlgr$tyQ) z+6&Gq;N6rN*Is+eTUXEAxTf&x&6id7Dtnui4yYY=#p<0;Y})ni;#Z1qFIu*&?Y}GE zcrv2Y1w376vIDW(oA5(^~H#)mEfx%2msS%L~ol=u=m3dai z67!0Tb>=M@d(HP}IK6JaD?>;VlgufGur+A!{Ml|u^UFb(sH!eYikcXdTw+R4_S^kj z(KNUfd!fD7-e{LmqvZdqnn~v|Nf3B&QkaCm4i_w>ar$(P6DT-x@@GpKm(1S2JI&mB z-F3|U?PIH=cdlNoo&M(O75yHrS-fL+zI1KP7w=p>DWDy^_nvL}( zj``s@a9UNM8bn_v_Bs=swtUcbHcC$r*Zy^A+L%gd z@~KlTu62j6D!X>kn@M}MPunxZ%V4#A4=mf4XdfZr%A%PzSee9z>&JtynKgA|d12>Gfb+^OnKG$8WCH*^?$cC5~mok^uws6JOt80lL;f1%BF1mK+b+y0?u6?~JvO9P5#+?nVC9gl5`p4YS z8?Z*kfGcq&%5?eQJ=-0v&C1TmO$;Xo<&@A@^2O$sE(0q8^U8z8z}6f&2Yhnpvw z=b6`-Z#ENz(FmnXwAPr$nP!<58`qfD8*ertkH#cYbWo114C*&o20ZMK0{|%tMa-8O z0qfe=N7y&5eknn_W}hMa+gJPc$xsPJ)DRgX50XB^du_rU(cz^A(Pn0n$pYQlC=hFa zRWjKSla`pl@{@_(ZF<~v$OH-j+eq6Q+s&Z$VRuW9qXe5IZAT6j0w)TxrzRtr$^Z<} z@j65V%HPMAg?vi%X@O}-KalM8Lh&@&toUohhGQsni0~)50SIXs|BloP7O*fRanM&L z7EachS?}@M0BK?SPoG@^*VMLJumc^9|3tmJ5xuL6_3n}A&{EN0wn=yhR86aFL^uP9 z=@#I3V9=YkTN*96D@?pe&Rjl!0 z(Og+InGjP`!DXmA7&IVbKy@QNGsqH=%?grQ2T?@HH7J#Pz3WaMhHYx42CZj9s<=no(>hEn+BExL+TXOV|1}q5NV?E7(1k*XMdk@Jql2c0XQnI-FHhO% z-5B1SvN^}>o}8W@bmXXx6!^U?;Oz>lL2O2+;+*DL;+Ea%0cBD~e)^=O^oUzmgd{^g zmd*F&C%-2Zh?8EC-i*`syz)$%kDhwqk7+z6$~+*=IkShZhq6d1_0laat^LE@FCBhp z)bt+HZebN#7xwjp?R!@|tsVTsA9gb&U9*y!T`O*7-Or(BQ;)&p?`iv@Bwf3E#66X_ zu`K}MkJl!Nu5NeE)6U`a+yrjB8dNIf+;&4Q!fm$+q>Cvlp$`EwhkG0T)4eDjq2GI+ zZPo%0XRjy%A=BNas~wWvnddHp3gDS;1-`*Dog6Ha@p7`q$e2IbcDN3%6)aDZM4n=$ z$d{G`mX)IRpU#|_IrA6%mF=fk|EW8Ao{4?KiiInx}g#cH4A^TV>NF z(`55u^V41Pf0KCL9sya0LFe|Kj1~;m-u4LM-DN6oBj=6Te+fP7B$|xo>d$JYF8YAe7D=y6MFJ-13dfV)dfvxH zCqkcS23UpQG68XqY#v~#Fv+5AfEo1(qH?V~S+18Gq3zSbru%65c8hH_?zqN)kYdLE z^=aE`c(zu53QC@%x826paKE^oVGE<0&Yvk!U!^?Mc$qxjxK`d~G;WkPBi+U-ooxj2&&J`v`y9UN2kIk5#JTqfS@`{WN$y+ka8LA^$P4uclghjH|TH|DH zul*J22YHxajuIz_95*WMK`~LWIsyOz!HI?d4MAu1ZzRr4-Lna5RhnIjP2M9=8X)Ky z2sgV^vU^AD4ZFT+?DGQ#JU_N+#k~2;pBwwafB`RzeQx>udGn^+c;l2SZ@iH``24u0 zxhq!8eQxaYBSt(w_Br~wY25Q88g89_^)0ttJ^fZ%RpW&*(o!x5uZX5W3StU~o{!`@ zypC}RPQsgvd&)|H+}0%;XLTT1?cOEs6@P`6{5wI->f$1rN&er9RD4djNR3@Oap~*LOBRhCdg>Hf zdNbP|{MQGDEm@Nmyg&(B=dm*$VPv$c-K08!@Um*Yb zJbK1UO@W#YkGa0WIDkfX)AGZfBWOVW8AH*yJ0NK~plM==8raPZLH5IWSdFIQ0+`4< zVhMs#Cz_@3On6G_pfm1&1}8YrC2JP+^BBBx@4AN=`qI&r`_JN(7)lIsxt? zl1n|JiI7WXk7c@QmjAbc38O`hpSV1_m}ENBNig9QKF_~RTp<(<%LfPdd(rW3$xv9G zGqX!|Mrw7!%*5&puWYZDXDZc5leYy?qfunzMQOZX%o^|Nk%GE)Qjc!q!MvC!<`sv= z3&~1yYO<7^Hr{Wvjt8K^nTiOuI=%oYUp+CjbP@uf0+ycGv8WvX`^mqPRYK(5<@ln| z4>(iy+lP+2BI*cd=1V?bG?<+$1p?2WI~;ZTLs@yUH^F8wL@g%Bgu@5G0felW-o1M% z<@leDre1(O(ciH+d~~93H#8-;l8taazzkjnmtDuthEAWwyEe8>sXlb*@ZrkJf$Y!x zhbqwD$FArM-*W&-iGnlp(9~1-uXPMQg3K)Taq0!1E~XbB=lHdca01Qb@+ODNo8x^h zcJH=cG$GDjey^HzzsPg+F&2N8xq8s<)x@RUK*B`RYK9*z2sv>(A|c zRex^htNIfi$*AIopR=Qq9RXI z#J-o1IsPU_#VGWP=0$P%geC7vX|cRjS})%zHOTL?6X0w@TDy@meUQKt2iKe69{{4b zjsp(b%6k*>Bt^~x>Eev$MgRa#H5z_dPnr$`0$>qG0C>Q6kOBHxo0}!uWRJ-$SnN@u zUbJ{EE^CTaw0Z=%qD3gRXfZ@8qy>O{Bsj?U-EYIWg!HuJsi!g`$#8r#mScE9+Kb*xf-h<% zzBQErRsjkQyzzyrp9Gb|E6;w^ALBZQHM9+nKs zDbiT!?a&{8JH??CB6~{yT1vv5gnk?pO>_&h2>mz<)H<`GKtIkBBn1rB_3<>k|0@vW zjG;3LxjbuV474nNJ!`0bsiqyM%-D}wtpqS6z;>C@fJ=0`Q^aIDqWmSzLcY4Y3$LWepsBbNNfV_$ zB5}s(G@m&m9$?=se_*A!pzZ7p4{g-?62k?Zdk*ALIB-Vfj6+J%RhA{vHnzovfTz_a zLw17b4LMO32WSG|#h_gb;2?A?tKZAz$R=E^ z;rAkUitf$8suIuVkq{m!Aw^C_GLA%q9l$W#O&~x~z??y7B#alv3Rs&0ItVaKR4axE z>ycrC5O<^aD{2ybZJpy($WU~RI1)P=-9-E*PQuEcB>T&>Z+&E!C zpb>B?7F*a+U?~JmjX%tj9Ai|z$`Pn9$FK@xdEi(TI_A~`dQMI>$rWc$oNbbDx7V|E zI^(4FCN`-XY{(y#Ewd$kX4zULk}f9i_6 zuD-sHwPC@6tH$ooF8x9KNju0&+Wx_MwD$Sp2;272ONTzi+DXOSb+m4`@!SV)3G=n1 zTf$ow(L8^NdpGcT_6e6oi)177A#Jq+Hl9h>sF2s)H22|*L<=wzudREm!5v@Z*6P` z3oIjkIi4Gh`TSjOGzdNZ?{cF%@SXhU+-TFm4s<6SlB3b@G3+REm+By8-3LV^jssex zoKjAKqZu0ur-9D#4DSf;9Y$j;mqE&19_flk%>cF3nmB)f&;8?@TMJjQ7}Dd(UR&SKp;Zb9Xcr?g=+sMPoj4L{?H zHgqOFJ~fj*;)^y6A2l?JvCDy#d=b%V18P*bgxS(Lko#20HsmY8+B{A=*3y%83B7qD zS~`j`h)NTi&heF*t!MD>yNO>)s1Xa#4_F(=u%&Dxlj7wT;@^4Mg}(-VB1(eU7QOO< z+t*%lf!IxiioaC+h1?CiWQ`u2X%EWKNktVG`gH^o@W>!=jI7&$T{Vl!p5Aino%c3A zGPz;ItZeqB_~o`M>$+5xb(=MKbMI^BjJkS6Zm&K#IvHZN$D}5-HyLOv#6&G_D|qcJ zNnR;ww#y4T(~#izIYK@Mm>p9P5Ib4ksnzWV2Fbk z6l;j=G-?;cCewr)kvCw=N?u^Ax5>_3B*cBu?Ac?X#;Z*^`h8cM~!w5D3UiZ2w&FpV->Mj6u$K0!=Z%89Ru-2TV$wfry*HZ3D;R!lPH z7!HhuhbvAl)PJG>5@Szj+f3lfidbf>?nOJI!|M_$Hv+zbp4xj-mj_$lXWtIHJ%9Ly zDc4+o_4<47EzPM;W!J@*OY0e`n3TD7^OCf_{buyKq3g9%uA7q?DjH5gjgLTcYy`Z} z1{X#9IsDFm)v5SBHe@jC~O6So1da zh*mnkne}8)AY~zsGm_I+52k(<+Re<><#AW$$ z(u1gjw3S*bXvu0ghxn#6Z75YrFq10gNQD($*%#j?xu>XWC8+14j_*UW`Utv~ST zzHn4@7RF78a=PJ-PPTv|Q&tsbM@$VKY1M#QCmxr@;Z_i|Qk53!7ixnXC(DIqOZO4s zge@w@wu?u8e3YeghP+fdm-Cr3XBykT=q#>pb3^39qIOnQ9 z#2hGj5fUtjGzt*{40oQvLux0(0=s+v=G$-oJtY>)S=HRU>a4$=7VH10h7xpt)b+$j zQcQ~5u^sCzxnanHftJizhG5sd*pC#wN{J%Q#3TR!2?915NJ9K07*z->>C%}j(C<+d z@yr>FapyQDyf3)Qvqud(F|U<;#e8(`mve(Ja`(sQ+VAG;i0;NZ;@O{eWc4>gv(j^h zO~NVmqW)}LCtkYvvrn-K(Xy zEomTp2W0cBpYEn-jKWGnktp0dn0hI0K8JsU>v7#*6u#!4JA0%)^3Yv8kCl(n5c=2f zTjlXF>U{UdDeZUjF`~OMMm)E)^Sz&>w%^P9!0#14$)rAfgmIh6$1{h&?-U!&Tel6@ ziDfNK(A#lJIC{}mf7+}4*}TvE+2ZCby4v}KI4&U73)l4%f<{O`A=Yw#Rp+}u>3E*- zcJsT1Pky6z562lneDV}UrWrxzGghho%?`IRa4VUd}r$)KJst*&J6eU2~1U59{n?o z8^{{ue*6T?N1y$I?kPNotGoEv52YCt*9!09yQs$vF|!in{^ikpR60~$<`i267~IT) z>i5eQuPit$Mt9KVQS8hM5`X{@4Sr*Sa)ev~+{z?T0sJ=|XgJQ|1ostnF@OW<6BFF`D_4U3UVQhX)-iA;68@o~bqpuLXP7;m%Pj~bK%Ye@ zXC(%rw#g2oG{i!+7G%4x++lGCkw$@1VoHj8q+5zktBEnJCMGmA8cr7X1Usj?c8t8^0#!*K6)YX z6=otX&3bSTv0wO*uWMYD21DCQBMF4vxNZl{TKrz!n=FziTE8ka^LmgaYz9C;O45j?zig>E$;*T-Fb$+_~_lGmyRpg7$EZCQU|@R zAJBBf@k+XS2-@AqXt$kEVeE-^G11g3Z0sFWL!ugz%piMo31To1?v-p)0x2NebCClZ zm`Avfz*cbzym-3r3XS9-5MoTMBUea-)9(QW8quM4C>~Rc%ak+Cq-M7D)GuNe?XFqZ zZmzzhYqG0(-!JV9eZQQ2MXT$vyR1v{u;sY;3%K(zhg4VLdw%|R<>P!DU^AV`uMzu^ zn4ktmGwpUDAKX!QJxcb*>HGp-zneUsVDvMB;tMOO{TN$LGMy=+B=@;-U`aE7>%ct|n9kJt}WPJgK# z;yitbV59x?cC?b}G^Fvj^0trUqYvE?ZQ?D(y#|bbZWIPFjy7J|0S27W z4wttAO%C;!ai|@}IwrRgj(1`mBov08tM2nsp$Bd0uwl?NQ0+mwwA{DZ-TcUDnq58; zv`$?@e$-FTw@W(vpc8LEcSXG5)lam!@7+JLd_ zXE0$b^?Oem`MtQB#-%;KS2+0_zZXv+c@w|))6m79yP03T^n$mU#2d8XcsEsdoxtB0 zKsH3KMFN>Omdjt0gXZkj)XR zI>D!mj7e~&#&$F2F1x+{g!WQ(P2b6*Dm@+QP?T!7`gVnVXPEv zNV|)f6TqAZ0!Xvs6{N5tBdnB)mJ7H19JyR&*|zlz#{L>?OF zOq{UmF}!-(67jz{g(&8sb9_&i3OaiSX~>sg&PXZaSP z{R`Kw=-zpJHR$(l%AmP?7PEGM&v3E6a{A(`&I!ox9j&jNmHb|;5vu3_FDt+IE{n3e_hMDExqMagyYXZf zFz-n=S#=U0f*@EC+%P(vyl60}g)D9(r^Uxv!wo_*xG8xq=BC$=1e|_89d3yu;TDZ->^vCEKRC@@qQMj8wWrXfCsmob;DRtXL_)$Ocs zp&Ys-d6?hm_5~HE)oeE==#{;6(!pa~fy4IVWEUjPsaX`sfW*lpRAiP;+o4;iXd?fk zGZE@Ugzvo5PDRM3Yr8ld;m+GZM|fc6DdHnMweme8B*fTujzoXRSBTCXL)y|6G!LTA zfYbS2eP8JJ(!QX3u`kZG@qN+x?vMFe=XdjSQh)LWj-u^+?}-lg(ix}UyRrS=#e6mN z;%nqD$+Q~ixpVkx(C^*EQEzuZ3!_RDX_OsD+SX)#FRl^?W4y(u7?cA%14(%D%lyem z>&M;4d9+Hmm&qbRk^;s;=SoV&y&WSC$0PKF&Jl;T7maLfn@{&{!V@}1wsbxr$o>nW zV4v_k#P8*H7LS4np9FVc)xpQYWxN}a)uaw!DTur{gS7`KT*#}%DnABk2TvgM7px*3 zwME$e7%hUE{pHlDI6ZX-YU;C>qNQ<$vXqo(st(JYZKAY0sW zPPcV73g7VGLIuC`*)y&keD3dF$42E zgWtV}u8Ld6K%@BovkoR_PkbFMkboLUh_ZS01;R)u9Y$%cs0ecvZ~;;^yi;|&>|vuU@vWD+J0uuwCH-2b{q)*Qm&I=^Oz+ zB-S&?G0A;(lAcX5MaWzNlPUZq9;nFRqLj$aJGHL?Z)*U70T^PSpn+}y@8t7`T|m_m zoxjt})JKYQB8{PAxkQL& z=#a5uiG*?MR4`FX3$_H~lxkEp@mgy91wO8%sQUsR7l4!(_i$lKsK1NRUmIjV|7beZ z%0tgbi;qf;aaj&Rp&J3O6hhcO`lEfj5MgCwD?8A~r;oOyOX zh_2eJ^hvMqW}^l857i{}77U7JQI$Gsfx~fOr8>f@P#aXV0gWhEXk1TmhL;#}Q6EzZ zv4Or9#yg=FVZu{0h-tRDSxeC>gN;~V=L^`ynxT)w4Y5{4qiJ|QO4&JLwd`O+il|j( z1I)71Fu>ZOcpDO1xlAPaNbiRw5SNGi{ZZC97Q?>wKX`Xm#A>r_(=r7nBxLD4ZTir8U*a0zdtTI!WLB_>=a{yR4W<2ej9<2QfORFIK{4X}4>C1|R9| zC^K5x_A?5p*pGFbFVaR-*iVC^nW)l&O4_o|;F;(3+70jyg8$PFvU*tv_~-gm&s?uJ z5SuQT6UzG-Eu5{iDd`VB(R?Xlc5x3OP$Ek4k<*BdR zWVDZ6#{%r8p8K?x?+&qOL~Jlj(dz!Dt#6-6T2IemBvXKAye!%+bzTIZB?Xzb9wvlT zt0{eMnwmN{63IYJ2$?+yCnX_>@61ecOU4Y8Ob04auMmf(;eWm9`j`@5YI}k$D4`;$ zh+Hc?#g^iaP@XAR&zn9)t6@Iv+xa&!KqhaRuYHS8HJj@0yJg3Hby~lK#vmo!4q=Yh z_Pq7ho}=LBKnCukKR$i*^Usey^%Ld*>jl!}8l2>II?35X=$4T!yN#q_{EQMw#^7@k zdQ3G_MIjS+ov(fgrpPGWixOiJP8kZ?qI1+0(*H?a;}tHkC#e>dz6Z!BO*v+xqkTi> zz8!PSz-Y{~%%%&OVniiu<)Ed(kaf7rL*=Dx?m~94I8E=i}o7vefZ?m7zo|dB8 zq$auM?7^me68AEFg!YmjR}^x1-?)tDpZoI9+(zV|$#+O>O6RNbh0$vGR}uy%SfqFr zK3CX}ct@r^Pn~X`sUj0xwS>WgYE%f8VprA(IvtM;6Df{Nh18%iqNS-<9KB!{b*L|g z#7y7Ci}X!kzx~HLecF2nOJL^65+=`=Nd7l`-iy!V-%z=KBgXTL&qh=&9$+#0QR}Bl z8f+XZj+SPLi-AX3Dyi0F)|>JO9lZ3li@-`#V6pEL`*290Cp(Vg{r;1 z6UeEE5D$7u5=gIIKvM*&Po#_<1eqt*>D8_zSp#?iS~n4`qe_t?A}91&p9^52xDAfE z!0&Iv@AV8bWb+t2GUby1<_I9O5qW}WMLp9q<=#eJ43gBm3TB+D4(BK>5^`bafBVUo zx8_Tiw${kOrY5lxe~nF?l`}r?BJqb{&Bxb;2{y25q!o|;E68j65x)$WJK&9U&L!Oj z))Dv((q3NI6#bl!oq(QwiJolWJuTu-M+8LPfzLKXo}*>y=2CN|IN*0A8S5;L3urQY zXaZ<5kjwIaLX!cX_49)H+)2T7?uTAF@9}xojKN~>wqG$J0d}Tsm$Ymj`-puD)2fGN z-$(6^+jAnf6wj|84>Id|OtEctiZ&e3g45?P0LEZ6DtS^LsYDqn4N%5QwaOx;Ua{J+ z+y$q>=`$eNib@V*QgpZ;ypZ^WHG=axI}5o_;BybCu(C`>9N53Uv+C~KUmUwL=LpTEN)O*__)v3wC@>BdiCu&NIYdsJ%*n4ru7713VM zX$nG>uO>L!H!dg#6~Uo6QXRD*UUEe7ZGofSvE9+=IP5SxlHAsS!c3_uYs6+oE(Z26 z1mHs5CPei;4mRReD?I%Kk&hHpmUsrKe^gIgP6x3h7m5&!qUkg3C+7OR`EyDM{JdHF zfc?a}Xzw3A{o2vfNA<6)POQ;RXeSt=@HE~w^yO8)PWte556ZSsQT`eZpd z*9Iy#Y!sRZbb?%~^cQDTOo(>+1$vq8?#6&hMNw!(^FiF`=VhD-B*U4SjXl{c>fY^G;Bih1lDEU7-Eu=^Ap$g?7q{o7tlQxZK*(-4HJbLD-Zsf5Dl|f@ zg#_{;QH%fMau$n>^H_ikR420ViolXYiaUr|(T*~6z3#t(b<^5dw+#=lQZ2J#=CgbD zG|hl)-OF5i0BbBlnbdQ8w4WbsXn6RChu{4BcdtMC1LlpNyWDQVxr_7bCVrmr*`uor zrwPv7o18Sqb&$b_xD0Njt8A&CuI|KD&Ya8c)31)EtBYYRb6+KUK)>q6RYv!Al;TVI z8FK(vEBSK|@OziFQA_yScwM6`;m+u6g9DDvf^)5|^ZH5^l6^c5Dl6PTY`| zB82Fv8Hzc@Z!md8w`9sma|5zS!7@*Ic)#cPSb_mT{?SSU_ZqD=9z-Nz!7l;fq!t$; z3<>HRfX}l*6(7$^^_Zw6XLgoI6|qXBtFL^w>${EXzf3IdYw*oFxa{_a|Ng}M6*DJx zEh-(_wdU#@D<2SNFzG$*D9YR(f4tlD#g-n2cQf_{s+%pnL;LUlUb^+BIg&y9^q;r? z>0F*R&5-!kwz0FcZLMouJ@#F?g&S|#&x z^Cq)MN{hEj@g)qz#RlJEtdH2eeTS#6HD7Igq5%e+9POU?^6zRe7V7+ z7t_e}6-n38xp?W_Y{0RJ=jecknqE`>M@j!Mf-ajH)k&q~W*{ZYak)5K}41 zHJJ)p9)#|6zf!7%<1HB<qor%=)<=iT(A8hD6Vc>>pb-8o)_=v%ko&@ zOvBikj6L18!?(Ts1X`5>?|%zsBoEmpW$TleHD_Z;^aebxq_EK(3ZW=Zt}ERK;;!sL zsiRYGNJacST$mlruFsaTyQI47!6PHuJ^9KJ>UylG|mXXEb}ibVPE8`qR1Jo56F%r@xeAMP#uT6^c( zt^1F4JN~>jI7gdyU&8L{{9oJlvKzL^gC1YTb}YBwaH`9F+P2*X|G0X)_9A-5Pg9Jy z2XX(Rb;dhUtP=^3%s3h352z;wbHw4aD=ChVjx~-?!8Z*yA`hbJU{iS;dPag?)mo3H za|SqW8w2=;QUD*-#VV%t%r5d%j;&tFibp>NoD3_Ezq#|)<~;{)5>Fr8dBxJdH6J^> zU+(qOM{N-EKxf4EfDNZm5H@gEUm!CuOIe}FcGc^(NQx>sK<6Y?n+ID(qub#TyfE2u z_7vhD$CpHT2edo689j93faDF7hoUFKzp)6vwzBo~PujU3e`b$5xSZLi&d z9VwaFZR|m9g0@s!qD^3TvTq^q25K*Av$gNEXIU+LLR|9TWN`=)u!qaZM8PAY*qIGg ze4wiukh7pyhNq(fvkD%wSYaI5zG>@gcQg-NKKF)j&;4JEhubbaFs+#6eKT~PU3jJ! zHc9VW)P1Tr53Dh6#qB{l4su{Dygn5Wdd@t#4AECoDve;3aeJ+9zX#B9FG|z<&R02V z3zRD@pathD4WjYbF0{WnzsFyY>4c_He5|yjw4|t%5@%f^>=So$^QQ;b3;{udZLMvORb)PjODf8v~$FONv&PY2o{n93F_e;{pe_J?W-{O|m z_fI}v_VA1Bp4MN{$~b3WqHtxjkJ)UqCYZz4p&^4c>YW_0Awfelmj|Rom+bX=MVB4S zJSm)H<#8fe387XrdkbFGgd{$)`l=@hM{EFu0)l+Q(8jSNe40s&Q8o+_*k$WNJS*FW zqJf#kgD0$>+g$z;oEuWnyvu541J+>ptnI_~D+>D`7hh>}f4sEp8mo8p^omi=wtvtV z!y1?8a~U=)+H!2FIJHUO&oWXD3=0>_es>uvRp`UD&J_P}Xna(nz? zv)hDifzyZU98@)%hnFz(5z;QCENoI}v7SH)m{0LDk~dAFOPN^R_4;8&AG*c5C4X?Q zc`*2jqHWH|`tqqMEa`#qnexm3)NaZ<&hDFeMYP9&uiC~(shxJq?4?nnKXU$CyJjBGVPrqDQll++W&ta9{99p;O_M2-~ z@40pAu|vPU7wN4{-{arDX6e!gw|w2d;Kf;Erw`mytIBg6lj_BhleRwGkX|}z`@-us z-n?V43{5r8StjzBtDa9$hqKlR)XI=(&w$Dc$0DmK=*{(JCiGUTz2m&|{Hy(&P|8u^ z^<$|>eN3S`44+Xrrc&`V9@3_`8ih?uf&oG~n`cvC0_9Z%?z4^6=gtiPvY}V!;*(>5lhC0F^I8G z1rUygzT2b;%>2`|I}VIkjU%>j+4va?f7DtZeQ6Ne`p@^OhiU50<^4vkISNv(`Tjc+ z|Mj=~Zq>fKWv_$u(|(W*@1m82n&}-)AEZ=!$0%dHvI3eQjHr+q8;+qdfk zDhR&Ex}x;0g>`GqWcRUqwK{DAMh@{j`DW}*SW?j>6EM|gaA}GlxfCSHZnB>@$lRDh zZt#QU5+?=;O>9A|T2Sdx`C@VzdIMrrUg*s&3uoOWjnqmXtcU%qMY6$AdfR6Fzjku?JfaNK{Uovj)D+0!dozs1@=wZERxUSHY& zfk#P3cZZ$Oh%+Cqav@2W9vzUNs@A*VWe5gTWjh2VGogHzJGZ= zB(6|i5iNI1Tn+WODV0mKp8z2EWYbA(zY|T`sofi!Htq)3!y`=n_B-YlJ#F7>KYsTu zXx2v?93E}&eTT$jZ9Na&$Hrh(d!Rq}VN}DypQ4*8?bX4{>|=w|>@$Ol?JI-p?ORb} zP{=apII>+O=3b6cSG8kMXtZlgXr^O&Xo+i4XuWx>V|_>sx}2eq(=Ir|%oldJ>|V3k zi|hf$d_Ki%_L`9j=o4J_AX88}&S7?Op@Q(+$g90AK?@b76VTlv{EC0&V^G)=lURj7qSyVv+C%Z^=yX2*SVZz1cukU4A zDr+sludbZfdnAiKqRnE$fT~E@7miuO9@n<-W3$=S6|Mzq?Wr5?yJ`alZoD>l?!uDG zefQV1+_pc`D(r&sx)Yw6RLp(lC8#pJ*)M^k(qu+3C57Q!Gex>9ef?2oxPN%EA(ZIB zx=8U6BcIvnG3lH)_40Ob-t5Qxn`Oep6AP>kfxu673RN=3+(TAz9oY@$OD>(zlO%>U zOiq^!c*-EJ6w!qF{qaxTpU1v;O{p5w#QY; z8p#it&OTtqM~`W!*Zi1OTY^4i;%wQ6HIO4LjaFafTx?nFT#>Xq%a8>hXcT-NNQ?0K zM03P!PIST9gu-iDx+&)sh#t8L`U`WsiRy0Lzx zcJS@{*!=fev`1SJ*2Gphg6RK;ya&9uN^K*t@C;thq3vPa0M-veSfg^<2 zQtsR7>}^^4S9&%dQD_5c>>1r(W1_1(2En~Uh(VAasFZ6C=l;Rj?!&~z?e>YHF9D^m zQNkc0hb>!xzuBoUv~=gQ1nJYx^(2PI(0349@mV z+-J3pkHR+LL40SB@1M!55CuzseUdNxRHw%$txI5vy4}<05j`HWh{l`zs>rTVu7VTD z2Jo@RZ9v6yD2>NKzaKNWalUbZ6sswIUSN_t&I^v&QhC+m&uEXM;@2eB|H;Q*-O_SS z@QB52uQTHZPwWfzW|P@yaMg`2yJyH}hZ~M-zmCQTbMzBhCz5WC&z<8S7y9Qg1N<(+ zsou-ItzFSaJ#tKu$OQNvYok4Efp8!{&?hi7U`R#~SuuN5GgxV%7^{M?0_iOtMC-^hA!3G&37Vr}{H;5GWM|uc({{aZLY}W_S}*OF@<|Q<^*yzCK4yz5 zCQ!}yiP3({r6!fhkOZ22g>MV0<$C0h3hX5nthKvr$k#~)-D?ztul4rrFxL0m z58K~H9x@fD=L$Y{sonvqGC;c(7f2SJZ+1FPq9XEO@j@owyVw(_-)jE3rRC>l`#H^l zcsOq@mBFB&MdR5WXfDIbN9|Lz){89oBo(El1)0*tjZRPrC?JG}e+o7x((Zja(mrN% z93#IPsqi`&3xf%Vv>p!ch*M|3wP^23Y1+F-A7EWtM%1l)fY!7&`eyB6O=f?(cKVI9 zGTxvz@b&!x-;3L(@O_J`l=+j!fRjZ#KhB~x53)3lueCw*3R~w(s#ySKlo5s0t*DYm z42M+4Bf)-QFo;HsH@E!zR^8Op;REUJl`Wi%iGye5`MvC_Gmr$F~a62JKQ^{2;Y zizvYCMd|r$-TRo&-j({dtzXZ&TyyWsOSMBI>OOh#v12PZs-k~g^E(Tx8fGnDJ{@hm zASR5@{G31=MMmd@C?sO6NIp9G>_%+De1}=|s#N~ZX!N>4?yp$QX2s=J3_d7|uzKMp z<@uq!QWtM32iB05UsR$Z-3m*L11=C*R;0wKizkW)8(P{N;w0^Z=P`6IJjY&Uvp1jJ zp;ZzaEPFvZke1@8^jHf%{f~J-&S>hRa$QaHhKCG z#xjKdSQdq90f6`gp$wzBFY8^c2wBy>bU}z(3WX?BqS0t=bV0N}YKRUET57nOQ@4=9 z6tuT^r82B ze{a)rlN7WfaWI8yy_rzGnhiCMH;#4AHm)?Ta4rvSac)cm%>xU#or!KBhv2+Ae&kpz z7q!FE#u(L=c1VxrY0})fz$t6u?)FI9UgCYhd5za#cMTpJ#U?~!1Q;{67o^H5046a{mk2OZKpx7YH@Z&^dK^FG`0^w%2J@t(g4Q7Op}09;t;sA!))ygy zH|&2~*3;Dte7Hxj%K9246mV&>*p-gM zx())E*A$cha-jZ{iqr}n!Sp>x+SC;lV|i3C$Y7i-q(vKp53hs457DusYw?1H1Alv^ zku9dU{R(Z9w)&EXG5!}vDG+J_J}UhF0^~q^zR)(6ZRfwgAoh>n^IS@cAo5{CM^=vcoPlyihkV}`jz>@8Or$I7FP)5Ur6)rL8)<-!Vio4m!PmP*6S zW26b@Yov7&paGx~!D2)WSdzFXrU8*|DIvfwfr!FlLLg++b_(VWuB%hzNKwxPUj zhO~#96iN7$hws#*z9psX?^^Hg*hKcgOKpu)pZdnB>{?&Uu93F4^%oDF)gBzz(04L= z<45Z$8ZWZjc<*fZ+%ckkE#$<0{N5&jDb+e3WUQDmw9u+pP=}7vP@n{yCk>|hb0qi) z1xGpu2?Y`h*S3fWEe$P{hC;Rti2&LafE~%GT?0RQSu}MU+v*ZsQ8rn!`#|;x9J*pc zIu~<+9S~lB6o&$=vz)(xFXy;3GeYF=?Vjrr@@Pr}k3Mnxz0E_f9$P=9Ma;hW@P3r- zE4y)e`4wWuZ-}!p%Gi`Q@qU#?GXV8t0KJPwo6lnZj>M)!xX3nkgJqbWM z_|d`cg}KnMc>mBxdDGcf4lv(7=0|3M-bI;M5Nn8~9dB^~y_)BoFWC6-fq2>IR2*(p z%ryE8qOTT}7j#(6VfHo{tTEZ>sV;0|ue)GCZb=!K7$$uy|S}X z!Y0E)@eE>J7Vl|Vq#baj{P@uQ$NNxb+}F`7j(j<@f5W6rtEhs+RI~|1mRRQ~6pBom z9tISM0F{!%;YTpV>=!IH<1A@~v{l-y0=r}OgTWFcoJy*{5Y>$h||N3iNj$;OiNL3vhoPU|BLZf-vNkLJD^PkpSle%sve!}o0f^k@P*a!>Qe zSirRFN!JBGrZ6g6W-u;wK^?*}WDblLGgd2OmD$R2^Gaod*=WY9bO6cB6jlrSCO&)n z;dz6iq^omi+<9YyHbIABg98$=v@e?p0Um>nzhO>k88ftIg*| zF-wGhWdM7gg#Nb5Itr+sH(U`@D4YIZlbIENNz5bDyo=P0o zHm46&{aHe%ZkVt4HU?K%9pzd>{`rL|2v zt^L?aM-^r|12c`tv@j*wcT0p7TdG(UTDyU51Q{=x3n($3iD^gm0X1y2Bnl;IgVM&J z=;Gou1M`Hf$f!zAbNj7X%JKK2=_*cq)FQft7rD^In)r)ek#uykel3lN>$%`4sKt@e5|H<-7~kb>qm&5?qja2 z95~ICG@x))_pHGy`zHpT-uC>|OG)}oTlHT!%XxMIe9xj#$#r~+QxdNvaX}1;7J7Y| z!QOV%y7L)|LkzmUJq6yP5FFDrN#l}4x51rcO~3@A40s``Pm;%rW~MD>nCOma&OFFj zs^F3qBC!8`FpbjyFa@tI=c{7TKm6nQ&$Vy9)EsDjkG$P;HqK7?q{+`%ul09o=bn~E z{-~Wet+i>dh@Y_6+1;6UhuX9*X>A{Veu&M-8Sy;krx;!?LP94Z#yAuU+l__o-T)SO z* zxZDqEQ>TiP`5GNW@S$6wjy(Jx0^HTyE)7KVvbmwpOYix zrS!~$qsd;S4zdpt%yUwv_FR#&sOP4X>w6mgx#hKDuCF#PFS(e|ZlXish&L(ul4wAf&}Q+Z7xlfeUrx_JplinK&KzT3Q+XsUrztljz0A_j zkn4Osy`XE)oQlbPdt|6)dtooDZT!?yKOT{mCil}4(t7nRE8RG*VOgTD>*(_2@X}#Z z^SX>F3lF!gaL()7UkkFY`}UvdSz#LaeBZH> zf_a)W$Gi$<1aFlrW;jM<$zvfrhin1H9JK8+J{XG3f>cDxWh4A0Z(}b}xt)J!n9)H? zG8QWU=Gnc6L{C#w+dt)gttX|7v#&_O)~{(r^R`ev9s8LqGjRj5qnPkdw2*SdBfxBq z&PeEyP~{nConu{Pz0tZZVD{;jnG=u>bD}6#VjDpx@mZ{>2;>uB>PEv05Hps-=`hFy zG0LefNp)-#NpbwEXcg1+Q|EtTmVw%xP?{)a5I4#wD#9Ul?78OV{7J*g{X?!<(Wk7? z6YMhelFNqV3@ZI3F}-9)6?;qTj)j)V`mXM_b6i8|w4BoMMTz4#58E)RSH+~~DyXLv zqqn1{iqI_@o+&SvMc81VbjC?(QAS#C1|u!_EKvcdg4?rq3{e?WR;lLO|A=V9` zBNf~gLsFL2K4==%`@QyK)U~jD)%34N5EN~FTpERDUD^7L_;Tw%(XIn%R|?u? z1A;4CQny>-4Y69mFU64dB*LCq1E;G1RF@!Z=L=6pm_Mcp>y`)i_7HU;EjLoc$>nvR znSIvMqT$KfVAgc@6?R&4VZB`#W7m;0H2x-xe=;;9vxG>cQh-XAljI)}VKl{FE1@

SjH{&^5Tv$>VS-`F*p1o#wTrVJLm zhYTFuZ9uCO4iUT%>a!g; z<>NA*k9;Gfc_TjC1TeW<7jU~7brsCI-CTft3^JX8M~TfewBUcp*jDG6&^8(#|7GXb||DW2=?W4;_nENKUw@9wT zyU8LP5Y0vBtWcG`u%N+vizAbElLh&Bn-y4s2Bah+x+5Y2`=4!R9{7VhUpE2SrEr9Q zKl{uVzi8)1jAseg?w*9Lrq%r6zPC(2}=oEt22uBzoh15D9@<;O|5Mg_aN#=B; zLARc9h>Og;*~Lt5u*{LoT*%90(URoWMI9YEw7+qtVo6eCNZp7C=B` zr?08MXI-C^QOnj*V{Sk2)V&RtOq`S0ZHfB_jQUW#*W&xwla*e%> z)s}G<+3Q9cl7sAakx~4tvsnzTRPLIlYUlv7k^;n2{9qI}-1Y8#4~Dg_>^<$tN1u7< zRhG7DsdilZ?d7y5hV5x;V8ch;TXFa8-vN!&LfU){TGNcyxM91as))gCCqDA7ijEN&wc zl9(TTsUBX}05qddKHk){Uuk*r#W&t~QQLjjt4CiwO1Zcgy!@Yk(>?}4@K0cN?gj8D zz(Uk!XT%%&gK@x*9vfLDNEkTT_-a*b`AZJN9o48TUkWCCq?5~Q==8&JK7B8$x7 zH38O{gu+~fz}OH}rrj{+#~PntUJ1C30aH{Lw~HxCB9`!4H-HyGm{MhiKH%qjZ}8BH zyrffQRiUnBqkesG%ol8Q^MUVvd59gXS~st{bj<4RmrO6HJkc~NmxSRXPq$kv1|S89 z>y4qB&j>oH=x-WOe`(PCG7uXmbD2_11tuiUvDBm?>7h_^&{r;6lI=*abp=IPv5y2e zR8)g$sUUDkst;}tHU{@26)BuaSU*S~PFAg#7>KQ1T;$S-$2Tv+sDgg!++sf1VXMH) z)${4?mBWZ#WyHjWJuM9lEmTE9TJ)v1qb)dL$3gF%;CB(fuAlWmTUm^|3o?e=l^m_` z1A0X)0DwB7ce}9GP*MxCHaOa?J;HARN3+F(JV+_iQ|zfysyu+_dyH;7dgTE=eLwu2 zv4f#gyq|J!I6OTb?N23eI(#s4zh_>88|AMo!V>mB{?-od$q;)-D+sbl&%AoaK)_i1 zu=tbn_LKsfuHA$dbM6zakHEymXTtO+A{Mdyrm=%?}+F&2DaPgaeIc1;!=c9l%xdS>YBDUuXD<_#@`FYkp)s zam^3bQ<&CXGxQwNX>Fv5SQk*toz$Fo%$<~5k*hkSPs6>cYa;rA&)v5d1l@h<#mz13 zg=VcOCX&y-0*bO&Ml;@R7BZq<v)`eoUniTTCid6QLWAh+OzCTI2ISCT-u!zT+ z+j@dg0s&`Aa*p|C3_bCrp3w|?656XjNnla#&DGOW$rJxqsDHnIa&Zw=ZaO0#Y9i;& zFTX%B#u!4GyMPa6;C>o2jufDgjPaptJxEtO-@9$X#qQn0kq({jy@|8X^5^n>qw}n+ z=b37$XhTPym4SSAJM*k;ZKipfiW+_M|5J^=sj@v@qfY?x_Fb$5ipeBK9r8khun;^! zk_Cz4sJDRs;Y~Y<)#!_5?aJ?-?IypwY11a{%T1fmDCWXHrt0#@fg9JC1g z*4(4*+pu^!o+s_vr+teM#)pqLY9X}mEQUHCyp8FQ-K8PtkR+Qm**YYmpwOU*`UX+} zAR}4uNpfl;^M#V}3%gl%qQGLIDQc=UZ8sTAT^9M^Q9eB&-5i zP^2*y_bd?8fg$JqaEe9-neh3?+E*z#jn_3_nZm~H+t=7&Sv|j~phveUC24v6GM3Nj zQPiX8imI&gqsd(@p2D;l!wpB-o(G>j)+R|iCMYjmLcUE@=ZNi zPpOZgkExPXN<$4p;Q>I1Lsdchmx2=472+h6xHhYSpqw1GVzYY1Kw@%&SxCiQ4%r(? z8B&rLjt6kEF?es1a9QfJrg{X1^`==yWF zUVY~3KfG#Fux7=o3nBkBWTLMkn>bjtTy1T{Z2b52Wj%}bFS=`ybL#nRXD!latjV=5 z-Q3pdo!7RscW$AfVL@|d{{rk_HWw&qtsgkOZQ!iS&mTDT!huzmeU);qvM!rFW9qya zxrQe9GQ8A=Z{7I~DlxaHK{JySGYjd?;V?j`AQ*ma?RaTjVUzSl>&!KUp*p@Uy~#QA zp(Ee=$-a&6`O(Q=fA6|5yz;<U{g+ zj?31qZmY;)Y@?@j-Er&4w$sA}?Kj+g!D)|l@0)+@gBO=~4t3wq5nS6FguAy5{rR+Y zXI*;DniYR|!v#y%tY5yKc4?c>*-E!n&Mte zyM(ll_S>}yRZ@}_FJom&QlXTOm}yS$7yg~KxZOG9;UnMt-azXIzrM89{@Y_O&VB!< z|K$DK)rbEF70$WCzjZWkKhXclI|qmEITrnn+M`&c`*0Uxjd`urq0i&h<;((i(X=_s zr{_+}pVoGgH@_|4d&ch8b69034>T?xn7)3&K<3neSw>~+T2`IWx(=H@ht^M46<&mk zUUehREI3|CzjF{`?Rq1<;TaEbWv9tW4Qp?I7iO2FT#N%y$Y~rzWA;+Wr(KEmP!~5^N_v&L`{Vsap>+NMY z#eN^2xm=B&zOl){O*ajByKzbe|E9TmI~L>u-2d^)T%5awd#$H8QT{AWpsU5(R*_~F z(vtsDoZPz-d&cfke@bT9S!h0ODUxvp%N%RfdpAzp zvHjroJ0>=I&pg?`Yw6BkHG4nVxpY_mlgG()rfzm{o>Svs1A1i}5>3@E#KC*c<{sLB zrHbQanX!-_@R)@+ge+dOcH#BT9LR9%7arS>k0U=+50&nDZgcA;&q9>rWH|$EkjAo8 zh<5gJ$YC`#OiAT{ARFkN!lW}AA+5m{be1%Rn=930+wb_s1?ODwjXSn`&-|*nec7(c z6HiojEo=9FLZjZ)HnXrsw4h-cmhqgK)*v2f!L7O(yvcQ@Tg>DB#yM^t?=pS`qagh9 zjdXnD6^)8`PJmErM}JX#0uW4G;J=kGaLNOBYs#NG(tRd z98cbF;mAV-5?8n1ShLZMw}Y#vRq3-&RJxY6yWekL*46*yll_3-JQ;B1iC^F;2eKQ6 zIk&k>kgM@VD`%tEq?DD#U%b%@-8MMDpd0TC!9;*gR>JE)+$DSpt<|0Kcm-6Gi-)$FXi!(e7SGr5YGQM1tK6Rd#+*YNUYQN?j^gBI zdIKRIv@Rl!tR1)|C6CEe-k$DWdgKE8b^G;$xVz^u^|bx^u?0uJZU4J{1-|1!_B4)W z!XC49gNIuJZLCJ)4K{2I$b_51(QQp%3{j5sA9Q9O#4QD24R5TSjr&oWtyA>W+>mOT zGJMjs>@>R1i}F3#!AVMdoD}qoTRk!9Dbj`x53^UVa)ycx7cE`#wd*>bet7k1S9w47 zc5FZT#+#=*-&U0u|84K->r1>2{N%BcqFFHBj;9M~V<}BKRy^^B0663ztFXL@p!`LyPS)xo4v2#dA>t#xZ zF|+2fOjX|5*5nL&Lz8uizK?na(y3aY9y|K_LG{qVBiMwoEsI(KKYX_dd~DDia*#w| z402+_6r5K*b`X5M`8XVt+9N5zo3sbkyg_=ngKUU#y+joBgBHOh4nepgQ#x`f$0Fos zscP*x!-&Ka+v9@+(Vp}8o6;U^Pwi!4`)SmgHJlxC=?1YZ_8u`oLlldU+$bvt&Atu= zq1{Q6GL3n9DoN@LXND*X&>`@AXJ}1a+LtBuG6y)6oOmEjv5vFWe5#+t%glzbh|z>I z*GO5+!UkhRT2^ykCOyNJM=k{c)Hgcg`jA?Ig)Hi0gCnhv$uc_uEy*>r=9mLgooOHZ z7p&9t4AjmQAVI@WW{Q``43@G2gfN=mr44zgf~`){us%|H%#(sx1MbVtS)6OIHUq67 z5C@%X9w#Ot!{9%*@o8;_Rx&8V$l46N2ZuURR>4%OgjdRumu9V#HQu^8>{>&3Z5g6E zhf%9!LhfjJt7y7?HysFB%2|i8hz931z6&03I+>nMPf(J1hn#Eya^bd(LnIT}5I$@k z(2`8z$Rrf(@*0R9!NWW@@xxYPY8h*Y2o5?0n2D*q0*=U1^sp24{-Pb+^>H`euQ^Pd zx#Ta-5Bd>`+P~@@PzAn08)WYji2eAZ-=))-iSW!R#LixreaHjxnwnP}> z6p;lmz?+MlMU*GVFP%#e!FjAJ6(KPws6mleHPBOpY=czZ)x;dhi|6GpA$gt0IjUJ+ zp#`3dyxFD_E#htS`Vuo>=rYIaRsg9tKVxEa&62S|yF>}6onr97h+kf*^<*e;0R zd{YKN?BoiF;XK4W-pU-s&9(Fai8+OknaRc`lElWUDL?31!?@|A2}ckxEn{Q8(Hd!p z{(%;|o_+Tbyx?3c%>HZmG7{r{JF>9K4a36t(tvYXf8D|~R9J|A_{&jFL=RFLh2Oxy z?rWU2D7rY;8P7(n!@fv&4n`1cVpEfECgr zk6I{Ev)@SnKt`^m>ojGXa5nMB*@feeOd}Zvj}H_$$%u70?LmC*=fJ12xMUk%4l)_X z^ahUP38qYI$}M^h(oUgi>R`qio`U1N8>ZtHP;UzQTr8?$*lygDnn;;nj1U($KxmS0 zIhP>eQ)5WA)G@o1Mox%#))4fb8FGdZ@yH=CBW`}Ma;*0aY0TI90TcG;CjKE%z)|?PL9%JLOFEX5-mPX>bfaIx-V0IQ0u^nUmBg)xh22ByctJ#6U%h`0ea4c z>5WZOve?FQSvf?W*e3s}MH6+TXn^nGM*ev7ECjsiBTUCixs!VdXvgFyvN84h#%Y}4 zLKbqU94F*dIdIKdz)FA3{XVHjBK9@uwkM57m}=G;#$7QOj})MAO8GpRVCE^Ua9)u# zAc18vsToXAXNj>LbTcWJPQ#n>G1VK!{ef8vIvLDNn~r3P6a(69Ps23b0Y9k$Xazw9 z4KY|2kZik&)?Ei`-iDcFafYT;E!)S03c zGmsE#;Cq_ekb)!)Nf#?aCC){)m^&gVi32b7EX48*+`lvraaVv~QxP6TYiLSyVQLdz zNz{ZX8#bSKP(~v1sDs>0)QO=-EfP5enoilMR>mS6m!_|h56s@!1JO1`C%vEKLcOS% zZJLt7i*lQ0+JjT`!_DqcW7C`>?$Mu#v#mVb7>VTw8c*=AI3&3|IVJvx8q$~*1E6z5 z=Hc$VZU@e6CkFB445wt2ju{IEyx0mu6!6sM?ADe!$d>TJl4~8I8Ht(5L<+vzKD$BXL>B|nygldH;O`5_y6=J%Io?39M;^R~nYcn`(35i2W(o^bEQuR>Y zIg#osd~^d%mLPpktu!_@-kOhBpUF6vvLd}_{bcNxEXMx93hQiZB~~uav+mJXuRFCk zvVO^QdzIffvU=eZyJcQ(q;-DYK4Z2!a^@V*UUrf-vb@t6I)j=C0c? zbM7gN+@&KY&7SAGr*4>rC%xPmBiLVKt-La8!%@8E?6?o)6mlgP@V9=DT~{_cC;ZYO z2EPmLrS#{;6nLo)d4KTYi^sa~yNfH!M|w8RY3|%`(n$II z=3&qqy18#)#ND;OXU{FeZrQ&6#&_;?uO7K>`;K<^D*M8>U3#T^!N{h~Tdr`=x6e9f z&AIOBBWJd*UhgiqVZhVenIm)NFI?g_;|a&9O|BZTZDgV8-o7HtMXV;^D(p0qv_?4#zf9A-PHK*B) z>z9w@&sk*WRxcUx&N{_*TNjSl!!sy&y^YhS;OLL$k@FDd?o8|4HRqh=&KX&;bnyar zu66opi%xOpk60HJIj)cQ2J(RaA+X^goKSHzF&$4l`FHW^#kdP*ar1PXVm$fRKH0)62>_{?;@aP*-UkAC>YqYu5{+I5(+d3rxD-31{JEFp36 zT@c8-G)TrH5`4=il~uR62b}LvhW?U`!|hGUvk%d`Ah@Kug^rLQy6doV`>-2flsFHo zakj$3Ej{?>m>1X1IUDbxN9VHKw%v!{{D^8r(O;{jY@n3FVGY6&EnK1^@nx@bJKX5# z_=$B;oLaI?9jU-A%~(ivj=tnZZw4pU!uz?=y0Tn#VoUaP=8q~V>{ifw-u}bI)CoN} z-Y=%7HMM1Ojcr&}ZkyKJ=Ag62K#msCFeJr8k*j3|`6O#8KTpPw{moQ8KREW3z4-?} zus0uj>IaVpC_U6xT-s_;tr8CfJp&Luxhi*9=;|OdgV#fjlDZ-v;o;v5w zN?IgdNpH43ZN?-i7EXeXH{nxu_Sk7pD+dmI<^ClrS1!S? zecq|7R-Fou^%bi4m8Veg6R*Ddp)WjUPvr_!$^7zN9`Lw7G9E{IxJWO; zQGc_Waf;}vvrj)IlRNY2rS{U3$MJHArpBcU^G?3iX)$3&((gEg|5#v$iXkrE6!cp)*ux&RRPwJ98G2awa<~ zyEKz+Rz17!yKfhM=UsKt-tLhzrjLyk&m8IAd(l+~uexZYXXMP{r$0UYjFFzb7hYwL zb3qh7_WW4WijnS-w{1Omc^j^+nDOaP&sedyXQb`&gInK*3oDw&D3jn>4!pJK8Qi_Q z$m-NKA|c%S-Ql{`q_FdH(sY9ef0D@qF@m+dq~(|KzbB&w1qF*VKDo9R0vE&wOAMuWG_J z0Hk>tcLSVc`Bq7{Zt>pksV&ORo`j9?!YNHnvzr>-CC#Uwyt?_^lX1$!$r*PMp4`Qq z*ZHQCo13QLp=05HI=umyct4vDoj{=C-YnZ&x@1PSU?ZDQeqjM-*>r!AaZ#uL*iVTec1ls95u^vrdU(3YdB@jTzV3A z%1N1%=4J54Q`zude|CH*=B`XmMI=94I0J!%c?Fg1&LI{R#7W;g+&;cT+J;Ry+ORxK}Q zO?pPygSU>o_lu4H(T?dze9)6Zy;4}G+7c08o1w&ye_*Gjwa6$%hsW2(f(=2 zKfdiBcW=I6+odyC-KaY{?z!}xpBvs_pXok4_YXd``qB4y-?{4A^UuHXq8UpzZ9019 zvA4RqF5B?-JBgQBctglO#LFobRxnR)o@$-a>`wEh6~+s8!Mhx9bN1~iIUEX&E*`%~ z-#cJW7?-;G$t=v8ZsYEC+RYS}a4W>Ln>z2h;-)_v!4pF-oVIS~-B;}Rv)fj#bG~=v z?~WbYb@LS)-*Lxmx69ssWZDPsJFn-`4exmGOy?#HnF=^{@9%LRKo;vi^K=GB30d>) zd3bKc%X%dza4OCOp4hd*TygFzhj#D_X*R&cU}1a4${CB7F3#Eo9OHcOS@oK=CiGO0nXF1 zwt4s3_B1@N^tA2R*=??~t!P!ODvIQAM=}lY&c<0Yc$gZkqT8TDW$Y_H`x@T4LN~pp zGUKjwTA{;AS_Ug>$dHZlkmHx_r}5e!UZz8u+kr70$V?h@*z<1lzwibBwrP(aIPj&+ zih~F5{Mg69=eUcdQH%p=+ z1Q?6%cmn~5;i!CK1g9I6n`?0CaY4M51DST#hV5v5(#Yocf$9~#y;sohS(`SUgV|6*bDr;Y`DCafF%=s1f~}_@TXW z1`gsr@25{6d-|ukOEc^#UO_cQOw{G7(OKz2U%xUExH~yxgc}e z%3>6K6i+K0f985d-O1Ngh7(RWSMR@+u$Xo5Q$LHa4n)tB2=;^%yw#om zL1iDud}PuI-s;WCU81ADz-o2cvwXDh4sGldh*R#xx7igI-m`i+~tf5SbZf31feJk{QNvi;y(d*9px zbCp`_+~9OM58|C&d)1woM^494EoZEly{xHu-HL51_N_RuVr+$HtytkMJf&&D!lrq6 zgfrtd<-M-i_S)%P)0LXtJl#2|yv%l%VuehpWh*S_j8o2>wS4LFwaf9^xaDV@lF2^t zR`v00%gm-Trk`~78{gefd~My={%-pEvv1nL$0yvh%NuK4dUcGoNmKWBpT-$_Oo%lGFsW^CMA-&@@YwuOdfBDdR zKhgC0FI{=xyL+!~yJtc0?gh7~v+cImKmI3w^2h6Me#d1Osr9%+NX@}|bLNR3>>s=3 z)VFnpPq$_sC_j+FgZ=A!zIf--E#03woe(riy?ukd&E9U` zXusWl2S%yy#H(-vyWQStci5eF+1_P$+1+*z&eGg%_u6~xKD!_9jJm}hum|lSd)OYa z_uBjH{r0W)ZT9cs+_ZPu@5cMU-ebSl{sa4V8*e4D@3artciHc=@3!A>f55)Sz88n+ z-Dlr#KVTok3+g{;KWKl*{;>TJ&H#DD{)qj@_DAt}*~jdU+n>O+`ceB+_NVPJ`!n{R z;8o*)W`EZHoc(z`gZt<97wpIEFWO(SAGg13KVd&c{Z@*x_XupJ$CMN7}*e~1Pw7-S7RKH^X1J0rQNBf`b@7Raz z@7k}~|BPp+Ubp`R$2fh@{=WSK`-k?A?0?1iBtNnLulNK?!FQi$nPFE|`8R|@R79M$M zQLXA6wNkB8c$KJHtJbOY>Rff6+Mv!?7vSDGtv0C()kW%Jg;$KKOH>QrU5OLeJk>_yzH zcB@{sNA;4)II86JQ{VMx?eq@4yr#=A5;&j52+8Uht$LB5%m%E$Lgba{m94E z$JHm)C)K0sQ|i-dOnpZEiTYFZXX>-+bL#VIT>ZKF0&aNtqWY40Tzy$Rp`KJKp21^-c9H^=O1O?`mTCS{WD&C^1AvL^?&ea!}rw>)DP8<)W519tDmUMV1X zJEuDj5T;yDg z$GqO=T;jAjTbxUs%bd%dE1WBxtxn0g%DLLP#<>=+vb-L-f19)2xzTyM^A2Z+^G@d` zjFa1)olb|->6D#a=oz}59_MCfx6|wFar&HojG}LG2An|$cM&)v&R%DqvmfuhyUqDM z=l7j=Iq!Bt=RMAQ@qWnLojaUAbnbKxICnYk!+Y`G?|i_y$GO)Tb?$TScOGyKI)CJR z5dF@FyunI)M>$j8*U{U)CwI$m|4_MeXKzE_@SdIJfx(`xzD#F-Z*TiRwo)GGDEAHJ z+xGw(Z13wVaN)t8zOLSKzS2HW?&~e@8fsu@pr@;QDAztXR37LV-0fC+hX=im{ylrz zGu`_u-Q~UvX!P`VdV{^~gWc|}<$->uzpv~J?d|u5x(CW-cUS-LfV-<_r0fj#?DGc8 zBjrA?Ohnzjp1v|@_4fDW2g`eU7;<~dgM(iAmf`l^Y}Y`!9nC_N^59TUf1hd}`rqW_ z!p?#Aj@{)Uk}1CvAhX(Nuq|nWrydbl4xVN`FM1D%*SGpTeV-LJ|XYXLcK)I`jDwI3(9sQO4tn&QOKznC-Py4`b zk2%Ptt>yX#m%o}vADa`ZhteZzx!@<=Y$XdIHiIQ!wpaN2?X z0yr7!Y47dq*|jS_IE>IBHnWw1{?6f!Ayw%C(IL`zZ=rvna~C|F9KR9p9yr4=WGg%U z-FsAfInyt$nL2!D|K7d^iDw3T`@4EN+Izuv79tUt-8I-T&{G*IwD<1mhu|blzNfEa zpu7jVo63=bgfbnIuA zITH~PW|_Y+A+@VV?dr{olTdCGSAfF1r*d;#bZ7fuxyB-WDIi4+b@vZ*s@qieyTax= zoY};_k>8whl-VrW*uwb2mU_|rmRgxDQf8}^*;+4?*(z7AlPlLvx^f*~$#s%Z1_yf@ z>X$rG{GN6=RiC$W0I4#MV(p0Cz9E;wIBTM~v3t0$t9@X2PjCD1P^P~N8F#nW(T-}F z%h`o8z4CF5AP42+M)|mvKaisOcbEH+o}A4?-A;L^JF}g+&Ftq7@7nJEfj%U0`pc1! z+cVrd)Klr*UqE|#g3Zj(Ys9d<7QDYpZEG8YR2ox;GyhWcjniDW|zWj0GI zWsz(%)h-h^n@xLV`OItS4*1%@^Oun z9^{Y0HFZrCFo>WL1of1;Yf~yiDV1xb`VfD(*OFz1$THW7WroEv*BS1I4fodx_rv_* zT}N5K8>YV)4WyC`r%?7fW4U4ZEZk7%sIYeuynPb9zYb?^6xnX&5BEm0%B}c=(OrLE zSA*n8YP>-PAe@sn$#5mxE<=lg^rWI4>ChNPMe_dEL;ZdIgHtn0U$*t)0OC54)LQ2hAD zJZ{Xrusqc6UDA$T+q<~jJJg;v&AB(?0y1Me@*p6W+Vd`JuT;pj_w4L!S62+HD~Hv# z9ylBg1Nu~{$GN(@-@B%#Yfrm#ZToQ6FyoZEdz_2#TN>=~n5QX3t;SB#l&c{c+G~1f zEKd?B2S!9YBo0H(!*ab=m$4obaCf4-*Tu4RvTTMJhUt)vE)KD5M9tgHvSI2#vh5jG zeZy*BPqtrVa|XKm8!(61(~jX$d#}f!GXxn;`%VS&b>J85c>SdJDMYo#R`EnW8x3W# zp}ERm8n`-xYD>R!@y%uDlAFs&k{HhQIv3ws&TL^&ZSPT+mYvIS{mPrm?zMx+0hire zE?mb~IbPh0Z|yE;Hc9ad%j){F!T}){m(`ZCb7OZ|-3X{ByG7ETx~yGo?p2%jsLg$u ztz0KtDofqX18Vc2y0)AV;%f6Q=dx}Xd9Vz_mYr+5+r4YLJG$H5w)TNecRQv;?lt|G zZV1!p$<>x&wWU4NF64HW)ks-&;jEIf>M1*5Qr!xuC);CK+1;+ny{f!NVS?2!tW*pu zBVm!R69hf-3`@BlcL&AaGkrPJX{$X9_Y(;86b0m41D&=#|@HC z_VP#mhIHVR-)j=v14HIJd=9fVxHA4`J9qPE zeiuz=I(PQ(YY=DvQ^M@fKu>$ua78``%=gYd`QE!LL){zJHG29+%*+vx!C{66J7cB} z1C7+aID^A|8O+mQBA5Qq!b&G*qrJmBz3wswvRS0HJ^ffW*)u$7CS>KQlVEskq28&s zX1Hf>&8I%!n&Aj)^{D%7&6)8*>y*iZ`qm5&6IzimFeYiuaCp?po|8`pU9I_a)YY0# z2U)H8bd=SaPX|zlk+hwBI>2eorz4!!d^+N8&8I`|)_gjIY0al&m{xc5@IZfU{oZkL zf1MMC*qn7N*NGzR3gaV*61*YPb##J%j0)l)W{?n5RmV1pjWXB=P)ERmWt}h(2cZFCKW2;{Bt8R4iqWBA zEb+CL>PbomC#D zOL1f{Ns{uJ7+HcalIo~!s%s-u;2T*Y)MtWFT*5$;#@q-j>HC61shC|tN7(YToCJn+p)j^<90;v2 zj$%dxMm2sA1%ikJZY_Wd0B{@_FlG$uM6e2+#EQjl2ngjGbi>zTG|zOP8EG++PaO$4 zG)z@MHwt_y8HUobj+qu3mJ5+#2|D2dP_lgLh$#RsHR0gcKrh zCaUE+C@cW%8?o|&FbqPz=BIvvFp@%%@J#{60=SM}*I^)Kk`xoAKn18Hkb1V+JO z3M45IrGO7Dx+G9Y05hEeQ3@ofGx;fpVG1NEP-DJ^@u5>D7^Xmy0uca@+JgSshMWxy zCQO76U&p2p9F9_i$ z14e`(G1Z`9x`)9@4yY4$GQ%gDQzW|PC3wwf)WgO05mfLAK^@@!w^2lnZgta zLc>!4^9e<8mm1x44`?2On9Gy=EfpsT6J`N=5p6^%CQJbzRJlx&0#OQtDd5))YSdCQ zF{xgvr$7jRdyQC&*XfA0#A=66h{`m&G}j4J)8m`vgyNRAtpJ;1OgoH?9I%~f4gSZM zqQK;>8v6v8ECfg4LU95gVrNSQ@nHb*9dIj!Li8Do3S&63SUI&3vl+8PQm;o2MV=c= z`7rPU1Nni^P^^((xye8$nt>!R5grABFDP6}xHxr5ghHm$MnXRb1FlyCq7+jD0+2K# z1Y#(G7L^lnEl`dGK!E)^hFjI}EFae#2W1EViNLg419Xb10SWZOg{gT4YWhu5uS(Kn z`s)~-meDA~d{7x`9@57~Yf)M#su4nC(#6KHv6xO#A)%NQ4I~7jp^vax>rFs2Vt#Am zg&4MGOx=6nwZ997TT8SyDTw-FU+P6s%oigoiBeL&pc0f4?xGle$HhW`TKvrLqC?~D zAaBY5BYi%&Gs0uUl}Lku;W$h&u@0nRKQRLPXik^{hOWWnV8AeJ3MD`>CY)T_PfHU3 z2hnM@-ws6Sr5fOaHdptPP!vFoX(kN}0U(`n3*(1^Nu%7aMR|%zfJtp&bc$&5Q%YKZ z04Sk^i>8qjBkiNv$apaTQ|5QT=(KP&2?#{Tz)-7>13IR8c$_p}2aIj0)sV0Gh}q)- zFfEuG;Okg(nHXNpK!n(pT0txr&=E|Km_YRd07$AlqBoNe&ab9m93>G=F`SSoC5a9g z2!R(&Y#51a(!vw@QXH8}i8h+m^;)KV*i$G&Yl&$hG=Me$Dn)!rC#e~UAcS_p=tC|Z(0N7?ATtlVRqC^VmR6-!6jap&KK+Y55*@PdaG?6qMuIXt{R*Wl^uiZHaBs-P zp`?;X!~(-{d z)%+4&J!29WLI5}@mkxqjp(IRc*IM(XblvIF!e}*OLZ~l5tqh6?MyL7!LNFL`gi62v3ia6RyRnjv>G3FGM%V)#9{gjH6Wkz>Lr1AmSpv zPQ4;Y*h|Dv=%Iro61Ry1xnLYD4r2Zed5`~$P5D4RlM}Aj8e*l8yBi-4!oV~@D&bg} zq!MXE6Ss6J@daUg8i?aB#DNflE+mBFm@A}QqgDQ%82O_#4rzqogBJW5D&R7>B%hj+ zDlVW`=MoVBFU3gN*r+dNhA?IXIiUuZVT&bX>Xccb%^_$j6aL@A~Q zgosXVBcwKJ^A_7N#G=TGc*vcwJbpSOV@sg*SWBZZc;wb8@WjpHBnTLa5uLvgVvP_Dr;h{$*A3yirlA@FE`lpMMw8NX z4I#Y*Dy7WS5GaBcQ7L7wh7dlfp~)Q6OiFO3o~}zF5HY|`2Ci#@)evl4jY|-jMXe!H z>!p?<=?zW@xo{?`216L%z$YM*Af}&m%npc%!{w|8NaRAl1083F&iWt&SDXPFtsA7g{A@D-& zGl)-oa|ui8ad0Onh|sLxcFC*pC=zCQaNaOOM2l29#Dfo1Jc_hHF*_@8F|I-@3}N8R ztwZ9f&$uKc9M?rwlDdhn$-t)h6bgKe*TJ}MXj$xcuC^>B3-~;kf@<+e&O_fr9hwHU zrJ2WIbbLIlKqMDDCJ_U1OdSs}K^O*ti3}!5!h|sZLQ^J^GN>KNB?u^&d_QI&ip`}k zM0K*kXtg>jmlD$`G^C|^%sL}}A{xGck0h-x;}60>5mG;`hR+m}BytG^3}7xLPhLR^6W z7zp__#U+}J?71m54UGvkA5v6U?ExO^1yx=I$N z%hgf|Pb#1or6$-5C0*CA>Z*1Ls*ES&P$P^M!JEmj!Fa$3_)fwSz`ZSjkc zBpsKNFYLu)843_?I|ighX6hXnigcg_f-FW-bb-iklGLm)455B_ezg=xjaVD0{754; zQ%fu~MA4yxwDP&)Lh z+>mL&kZBBXx+UT3xJXk9W~W9mpPL89m#VdapQ%Rvs<*f$vuIG@`<*eC2PB@3WP7X&{1 zicLg~2&)me(u@p4z*<~07M^t&A_m0$v}uk|G5`S$P+>2RqO@E|%F!4&#l;#(7Rg8Y z5X!zryR0ihiDv@ii{!OpkP^j+0XPQh%5~|Y@ugY?4I!kerBmoP;G!B%x?hgfgqo13 zO~R0QB9t@%j3Hbr7HKKwxqdBe__eeV)NpVYP9EtC0L&oSRN{op@ z13+5Fpi(4d5_V{bOt}=Nmr$P>`t?~%0&PikXqN%d6M{)>S|`oQCD=kJr$*7BT*DcM zh8zY3*~BD-F%XJtW2V5k7AMCvl~8ce7?1`}QZTX5h8bf8QY?aoLU7{n$VAA6XiZAR zQVMK`fzPGlG-OG~8i&QgX5sNkCnQk}$vBjJWKt9oCI~SKZEzW#w$E2+$W}3}L(;S| z_`)~|RisXY2H-fZ>yM9v9906q%p)(D(Bnau(GO}GC;~(-tF2lM>ND7;iLM9{N)REq zbKM{@(_qR9i~(1Pv_ue(+hVOlArOs^GY};PpdLb6hN2^e60i^g;=oNvAQ~wqkx<8Q zLx9Pi%d%EVqh{hoN~Ff&ytl|~tuFveM_dlN^g6ZwE7sz#}|Aw7gTh5Q<>=%=_+4L4frpTY*r1)6*fm}EQ}We9OFE+gPxkrDi=FDM`qK?T*IRw}7gNHCuz^~0yRB06JcAJdR}4}s-W6iLF2 z%+jGrfYjyEPY59$w>oJZ#-&6Xqmb+1O5*#NRq;Ay>^KnD_Y)=*hEyhFP$=axAu2A; zSv5{t6%@K!t11g%W=$BA?U;zLsS{czrm#kaBnUcB`~*~)i2y?kg9-vL2&1E_7$iqfr5YMf>Ci5Fr&5S5p*NVv%u` zWe)-hIuG+cNGw-iQE>-cBf9D3AmAF+D%Hf4zbX~*NuUA|ut}Vf%mP9Y9@ZA{kExJP zMI{ES5&dI_NN5qAtWL^tVQQo=vQJ!%8IdH$)mo}8;MH|$7$-!k2pGc!ts97w2h}v5 zfEf*>jVNJ@=?G5BM2bP$`GLM^IRy|LT6h7#;S!WI1S3tfluDIqjMWkg=d0uGLm_@F zT7=0Uqj6cRO;n?-V`Z@780!EL-~ujTG+K%n1QX-DqE5B5R1*=4;eyXFK7D*g`yhZG zg!$J9EneN=1OQ!OScpaSEK#OKb<}6lPz@=E>&6I~gu$2yrXaq=To&_RvNV-VLdFsp zgh(4&utZouV#Htp1n7*?^>u^^Y=#l64%ymhN&Da#F=3I;Ddz!K>eqvTmsI`wJc)_En*3=T*0R$-1%OX6yN4zxllZ5q)`jC@7H-P#WN9*uWV7%Gj z0=N@1;JN{N;kaHof;rKS72`TLFQAx@XVOxFuA`5qXe8q?d9)o#JE8@oOmGu|b7}@o z!xu@b4A9V#^+L>;YbmFsAR&%WmTHilDbXb%kdW#~Ej}5rm-*iWOR*rl74E1Op4Q z4Hdv@{jU{(USOuQVK^=9BgFiQZZX6dOLQZv2KqYI6q(X6oIGuqv0PRP08FeH3>$uR z%6dq?BvR<82BHbV3co%USWLADhG8(obpsM)K;(A;J)}Iapb`I^yo`OrL}J0$SfgZ< zA$lUjk6FdfQiHOJPrU0TFbASi`)BR`NOO zD(GCsxl%D0ADsw7_ND-n8}ZPD5(Ha5umplP8VDKyzvQ*xA`V5h6h%V13a65e20Wzm zZ~*K{K1t91iHL^j(HcvmMHX@*>Tf~15|4wj=lU9isS)VTg2NuavX4yfix|bCkAkVc zCuoEPEk%}D>V`j$QqPR-+^EE#=xm`J+br%g2jPkSFMLVXqjXh?&^0lKrEy;2r@n?q zORV;YNyD2<5&9#zeMtQhLDprj89O8vnSgk2Z8-s@1?qutXuO zAlfS21c*^iAS~(LfY5LXVlM{b3NZnh0(p&}&X8&OpFBj-C0_oAZ}S&k{zrppEFo4b zm$Mlcw3UU;0G34jQd4koV;FSAlpRQR1e(e35wHeKxZB|Z@bv&`)TB-;48^Si3}ON) z5C^FcJ{!-tAi-kuFpgpw#z_A|5ecthC!$dq#{d|TU;qyWNX$5-wi}SC?*;(m-2m1u znI{o>0`Bjb1;|tDyKq^|M!6gUOZbw!Qq2z_n8@R6zyg9;3W8V)(!Kz142b8$9I^z* ztW@g`guI&Ob_kg|TciyZoDj0eiG*-It8-GDI;yovtsADWR+WND93cU5yR=78YT<|v zN)yI3#$bY*Y!1AnoJ~R)mgG;>5CW zIVtP8Oh9qBx3#Mi??I;}KxFWev+g zu|#bmKoe4nk^ZCsoP4De|~lblKpid#V8I#Zj6z_ zBH^^OP%nxUEk!dfJO{DL1rU`8RtDi_DHd)fSTUuR7AV-+IL1Y!2|pk-cRdM}kWL8R z;tK~5+{lRT5wSEGD@s6t;6yCAO|d!wC~YxT6h^do^@NhLp$m;uQKJOZHyWqOY9MO1 z0M{DR7;7^NREvd#Zt5x8=M>GH={iMfZTov09ATG&J;wVODW@uuff?X^cKU5=hj|^c;0vmLM zo0vc}r8sn+B&&v`&=6hbJjv!FFG<9NA%5g4e6MP7NJ|3w+CWj1m^qaOBt}m_S;|GA z7jX^p<%sE>IO(GR!I;HL3@-=@X#*9cF1P|OTrN!8r8YF<$YkUdo=a`ik*0DICBTW8 zqroW4PAD_TKpTKXBRZ(L8ZL8&rh!$AGCtN+Fch$$6e*loz-rD!0cx3~97AB@lt!*K zvY}2(GEw#ixRGu#T@wiT#v}=q#3nd~b)gU^1@gsEG*}xIOA?F%0RCQ}(0CV6i@KDr3bU5CvMOEll&&LmLHB(*}$P zB(hr9tHFQZH)IUzW`q`$f*&?zfXjh_kb)Q@J`-t_L0&nIfeeLC1ojw;qN;(o3llb= z0i(YJ{OAx^Ne)Ts6Br^$J7FA2i}*AUa|R(WD#sp0H7%IRFdkr^gDWFR8g}bl0pbB| z@@3|NnFO8EC_|INfJ2B{;VduQKz&jdywtP51D8sW0HvV=DMg9 zhl~oKHn}ERli&=q#^>3)Ijj(2kc?-Yi7)igbqJ@wVY3Jd6KHA%6hIu`pTX~!B;Tauna z&F#v(MA3}#gsl?{@?BDx**eLP`IrqK(XYu{301|S1cUGm_%3TP9L0>Yuo=%gDCk_P!V<{Rk3+3u!CewKVX)9kI4r#jE@4~>*LKsPr-WG!AUx|Xp?wsF zAT2#?z#A!9StLPmEQ-lYomvTHPM^;E=<2WUr2vCY2Vv-v?P2(YsSyUh*%XNjZn~cW zfJ;_cA-IASW}gMZ{(=mLWB$PwJc5J>!Pzj=0+QVV$&DarAVJXkXc-rSAV^Vwge%lV zO_(K)NooQpF$zW=^ z!AhGiyypS~MhVw~hX#JdXSmo>tl%qZp}VO<3l&ED7@*3yF+;2JX2D#8S1k=-wgiDm zOD*Wa%m$1{8!%poAB$H)Jmg-_^1Nk-ONS#es+VrScvi-18>>{tMl%HZrC@Bdn})ck zopn*LMT3fNp%%OtOYcQwP$m$`1`H_i28>6c1Bdl^1ICleMc)TH%n%_8N65!@V+2~l zV2lznSO;}{iMgyFkknit32WFOOjtu8Rz*J2&;ZjVHKt8eiUDoFc%fy5v;pJMm|dfz zvpo;2`$fF($MxWFjDcWUxJy9L(pl0$OWTLWo(T7`!Z7wfe1KAihi)@UxKafQsW1d~ zMk&N_HN?LfB+XUA@lh!U*N{}?CE(hW^C2u#83pB0VF#3}-0p!_$HorG)roP`CF4~N z95|4+o4`6XTrtNb(aC`haTA0ZwCVa`wBidL(tZjdQt9e}u`x_e7%KUt11V%`REt4~ zu!1YZ;42K-%e)ZdOS1#x#gGQ>hkE2Wr2_|S&$7J3SdWAIXqPk{`w1d}zLW8gdw>hV z5cWcyBDs8paXKL!%3*~QG{LCrRYt4D#8i$Zux3egWx0ZV*tZf$7pEm4J(q}yDeZc= zYkTbQ*ch`x)fpgPVdBJ1NcjrQj8=-wL=6DGw)4c1!HR1aLMJhCV>VAFPfV6<@QE zMRqeTak#B}TU#502iP$f9Bso-id~i9E)Vn2}X8AfikoG?8|xVHhZFn6X@z3lN2>#damI$deqF0#Qj)5bMDx zgH&MDBHJ;xyN;#7&UlHNpwSROsn*uEZ5d-}+yg9y1u_+WU_?$v0f!3MmKg^ug;ip< z4ZKlt;&v)eJTdk}g|kNG0KfwkhnhdUZ5wUDc$^WT9CkRL zw_qsP)|IwZKg5-Cl@Exa!Fpfw0_4ILuNkLl3-+A$($O-?MBF#|YA$ z14Ik=1Ei7AjpY{;6xDhHl)V@VxzZESHq-4;C>_So01BtQ7|3Y$Vi0)fqR1XBI~)N6 zLe0%1>tTpWZMIn)z1%(_kpx-al~UyZZArkGNNE_G!K58;eHsR~HdLQW+td5p$rxyz%?7*cD518oqz{6#inJl>2!0SIne z&=nFJbUF$xSWp<(hKrI$HR5a^`)v$}G6iTMU&6JRhms#4`!X1C7sLf3O(`{J(kMFj zFl1_#wjZ^L$W_0R=7-`K*^kYdE0S4b_C)kRiHu7^?u;jA-#|Y5p8QznrGPbRSql>Vk zP<2v;qBuAYA1LNP-{nr*FLF~5B5f6G|0yrNU`ZU`s$r7^?vt<@#!E0pWs-&1$l~D) zS~`IQld!^04GRGOxB$jwD9Z|CB(HC|h_f(Y5ZSz5ID&4?NMe%ygVFj}0=#2f#%A#? zMw@;XSYHbsu9OZvs-rY`V_ifO)LXGoZHM=n-d883Zh*vol`YFUMvn>)H1d(X1+-$o zldM?8gL zgmICdj&GufIn^*~DBkc4Z?|wgM*2EOT{p4hBLFyXqKHZpxd|>U(Nsg4%^AAxV~xsa z3%l~rmM}y}c5c@rr1A4=y>N*Ov+BaoDAe=#x{uaOHNI|=7%RL!B$$MyP&NaFWs>En zEbcN%vz#B3PS^}S#ydRG@jOO?GYUpRA}*<3QZF2FVa8%;tWAKvJa0R|x9mP+;U@5ANcP3%0)^EaMRXrUW z0ZJ(lXhuvW!4flVG;~}i)}o>u{z!``3Xs|5*#d(;ja6i%RpG9ZQ!PenZ7r!%By*Ee ziaup-X5O#ob9BKewncMPP#YzXHNAal44X7Ez%9;h!GMWdF8VYu;pW<8>;#t4F^%#l zg*It;!pEC5@O|!u{4rMS_;}mCHc5{B{fTIuzmB1?v31L2H1fn~u_(ClXCREZib=0f zc&4popD5q}fjZ(6qZA-l zK~Ls|mtp|~i|0`o-7+La|2Qv|w z3=&FkAYFQuWjCV?HkVW<3;2Esqb`mqbnuj~1xw*xq&*rLGHUjN35#5e`(3KVLq^0_ zgs=kxt~ZIShUkIJ8bMS>niD?uXmUjeC3!)5D&8y$WQ2z3W$L6sZZQN?P$Bp9qZ3gm zeg0^mnPL^o0HD~ySZWY;FbSj?V#xU*2*beFJTTrz{1B5Ay@m|#!XkBG@WncmR#06O zJ4Q&ZLJ`C&!gLAo&YaQw#KgAj^Dq{BGlUhY^=fb-I1$+hkDj!Zq^NkCj3=NY_99M1 zb$^mZ6EsQ#8q@~wvCxUe$Hp0oqN;(2w)AM4yAo~&;sl%$k(TjO^|{g{?+@cB7UIyl zX$D~svJxuTAxIZeYBE4Al`*b@RB0yMnADj51G`fI*>lYb3B(4S(yv7Vuda|%{(JxD zF$;4&c~yjj`c3{1p^c>EXarVF8h|~=4s#uba!fLY&MKxLwjCG>X~1dZON_op$9^{hGt`HTHzb9xrVpOPR|UJPC>xRw!0T zV^EU-IYuQd%Ou`tSBo18;Xrk9sPrgwB|Jb^CU7LTAlfic3d}Bz=R+q@6OW@wJL!O$ z>&P;ZsZO5H`9`p@@PZg%fI=YS)`+tzX^0TfI0l0v#47v+CPm_jqC~P;u^xavv5}#u z)ezZqk=n0;#X7cF$CeJ%3Y4rGsK;uP7@sCFek`MWhbGI1E$LOj1)gxB24!NMD`Ip( z_r+m26L~IT0;I&;DApwnoz6EG-2U8SZ5B$33Q;3gd2cK zAQXZOxf{r8aRMNiM)!#N38IEpFQO{w5HOB`f-sHhE;%NO<01nS#i|iR+UD^-DpQk@ z`7+K77!ieqoFPLkm&}(5<^!&QZp|V=J=O!2FvwQ{0!b=C304j;;0 zbREAX^W{~GXmHKL_yM3i0{Aik^uwGc=7*(Azp#UjS^STyz$5ve)W=FM{o}NQZ4z3W zfTFA54pl`*c#G-ywU)G>QDe`VOO96mgTO&wNK#V44llpwV!4n6_OumGt|W9^Zt zV5+(8)tHvY6#cPW{62$)_98xQMj$ir=Ueo5(vPFwgj`cUuRok653wK5so?{k8R+^-b%L^*!qi>p!idI9qut zPEKBklaW{ATNepwY?Rm)_wqI(tZ@D&VC*z%f>i4_8T}I_Fr)R z>(A7$kY)-vw{a{pCbr;S=-G?(z--k0zA8{UaKIeSdiJfPim!0o8 z-*et@e&M|3=G^J-Tz9d1hP&Fmz`evRx!c_icegw2zRNw}-s^tY{kZ$5?w8!ZaR0`A z*8Qe?$o;8JW46g_#wZRhbJimt?kPwq@EgH)jSjzn{51 zb9d(c%p;jcGoQ_gd4WIvmIJo|L^ne5Bi?_|H9{Ym!c**9}eu8?caEyyj; zos&B+w>fuZZd^|C;+*?#;ZL zpOT-MUyxsxZ_S^ZzbJos{`&k)`R@EJ`CIe1=Rc5tF#oaqpXR@q|I7T}<-eYPHUE14 z$N8V}hQf@(yuy;gS%tL)UAVMxP2nAda-pxVw-6TYDm+m5Na0h3 z&ljF3{B_~E!Z!k_u5HwfTN?Q zj%h~6oE;r=e!Ck~=H55oTkm`C-F3lUTHU)&?Q?3M-}&#;wcJ<{HX56Z&BhjCtFa%j zo!HOVQS2A&SL`PC2z!aka2?LzHSq?x2kwiv#>4OqcoLq9XW|9;FuV+(h<}SOz*piG z_;&nf{5XCAzlPt(pW*Kb4M7q{q8`zV@Fu<@+7Z!2C!#0OhsY;}5F?3ih-t(;VhOR9 z*i7su4iTq_i^MhJ0r8ypNFpRfx{&qAW~4XSl59stlby(9vJaV04k5oL$CES2a&kGj zf!s#!Bae~i$gAW%@+tX_Qd0zFphT((Wu^kD5Gs;Nq4R30^$`kER~&7kH}E2s_B zHfkSrj5%XVdZvDs{Ywul|gPGo1X zi`W%x1-p&i%N}9Ru$S38>|^#7r{GYI<7#saIZw`yYt4mm9k|Y13fGs*=Z0{l+(d2` zw}|_m+sy6e4sxfsOWbwt0r!HJ@hH#mHTVX+C-2X<pO z)cq|~;r<@#YySlGvrj>d?CVei`?GiD)o9fe)m+t5 z)f&|n;NLOTS=H~Vd#Y!uk7`6ss5x~Vbz`-p_E!g~+p81QJ=Ez=`i%to&2Z9hgZfAH z9`!Nxd0^i?^>ZMfRzqownmU^L8V`-1CP)*mi3Rd?*Vr_fz`jAizHyqFngyDbnhMQ! z&3?^EAm263UCm?78$^W=h!LrWxFfzu8zda4*Bwbm@{l1&DKZh6iF}7FK~^CfkS)k= zWIu8YIRo6gfjmN9X%$*bD`@L#n`*tat+ZBcthSprRoho<*ACT|YA0#uXqRf&0r7s; zp3q*@Ue`XR?xF4lDnn6}LtW7(s5jaQ4MStmuBZ*oK?~6l=s0u+Iv-t$ZbWyX2hlU=W%Mrk z6#byr=qY^-eFJ@Sy}!P#K0=?U@2T&jx9f-M%k-1xgZ{KH@lW-pRHXq>R*)Jn2d{Ce36ZX(1z>Wa|rL8|)<8baFnB zZ9VxTxraPVo+f`IZ;_A5SCoRnC;`aUl=7xpQlV4~)tO46GN}S;7*$41q-IfzsPCyw z)Gq2Eb&C3xx=B5vUeYoerCGWb-H`UA{pdD8wOG0foknNV1L$IU3_XRO>txzydN+ND zK22YuZ_*Fx=ky0g!w`(X)L|Mio{TTkifPA0F^NnMrZ`^DtZm{0BiR(1MFlPw)`@ zgdHK1{<2_MxGYhYBI^q@94srAmC2?64VTL*WII6_o`o-W@5^2Q z3sE^Qca=Amn?MzY0SUXxd&zUwtQ$Ks}Q>P#vm{QYWcx>Rj~@^+@$t^(6Id z^?(8x3>Xgybro5rO1N@LN)Xu3FQHxO7i9#~hdSq3_9gJuWl zyfd21n%kiBo@(AAN<@#aNNuDs;)S$ALXjAxGm?hnAcK%%WHczeIml9EJ+dA2-D%`9 zau<1qeAJ?#?L=)et*+4$>BD%Rt}F)GpM1uiXOL?zr}n_NMkR zC_6+)>uT%j>)drdx>mYSU97Gf=(>E}FreHtUAb&KT3=i5ruWvj1|=7-?*V)( z03A10KV3gxzsgCsWBLoA;U4SXVQP#5wl%`c*jHF6)&cZeZ!8ZR3S^s%&Bc~s8?f!z z0qit(8M});!#?6D&f_B96!*c~;O+55JQ+0G0K5brhtCAXwhEZ`6Mhswk6*_h;jal5 zsI?kIL!vp+0%#UPbR~KN%Z3u8h$*1cmJ=1kPU0|ej<`zPA^srV0Lf62BkPcEK(epM zP_hHrg|v}5WFa|%90v+*KDms0NfLZo9j7i**Qp1479n7WKRD6zIo1Td>7(}yWwhJy~9!pvosG3%La%+JgT<|1>0 zdBnV86+kNkTbFfbeL;b>XA{^SYzCXp4rR+gf6WH{wVK_;?qUzJr`SvEE%pykUvf}i zELV$b#5L#qxwc#s*O5!+`hfNt3fgM|H89rJGevKS?)4-oBNY{&+9;W)#MxT zCcY&f%E$6u`QCgUKa?NEPvPeQr8e?E@;~uM_*48P{yP7Ne=Vp4N~k5c3Esk2LYNRE zbQRKsTw#dtwJ=_oDJ&3{3mb*q!hYej@T+hWDD~2yG>`_Pp{~Kh;A03fv^T^Xx*O6B z{S1Q*UmM07W*Qb4RvI=Mb{mcwE*Neao*3R65hG=+VQgUZF!~vTjnT#~#x!H5aiDRe zaiVdKahb8gxZSwdc+~id@rv<|@rm)hi_V2}adm0z;^orXCEO*^rKd|DmjajKzw)r% zg?|YTpMfgWDi}pAMI(g-sxSny<0M5dMII=^62)l6WW`*?62&^jR>eNWaZrRe6;D79 zB1%f>qO7NM2Q}DQ8K#U?c2TA&vy}anMat32Y0CM^)yfLxPURs`gIARglrL2Z6|OQu zKI{ovFhmutN>bTWxvIgcQq?5Y98iMmRohhuAP>H*y6e<|sG3)c>LzM0bxX*BW7J*M zy+H#GQcbetE!Yx%ayaLMaPt7aM2SfwfPeAG*Zjkl1Laay}(iO2GxyWG9e&dj7$XsL@ zD8C)ZK~Q~HkbB5;tqd|%xdQqC2QMJ5fZ81x+`fSVe3iej<*7qPq?pd`qfHjAY5$WPQ?u^dp1F_GALt z19DY6IgA`dPA2D&OUSk4R&p<7s^`gTn(h<)97@F5p&j72J02XYM$69&*q>xHr5KG@F612N|dz--d4w8E6Wh$q(R* z`EU3c`~rS8znR~|ALB2AUc1Bp$-fd50xEEVtI$;N71|0>LXwaoWDEU;5@C!m9XPlW z)Y=Z=fN(IHq13FHLN#mGwd@Q z2MS&@JTSaAYK*K=1O~P+T7ZE`z`!iy0AS!G<2>V1<62%pYb>m~;pT-4uF}T!q zY3AYs1dMR$?2_h^<5K8S>N447p34fCjV`-gj<~>HChQwJex3WDH7CN~9K7JC<|wJ8 z=17gMX=zyLOI(g9%1de%z+3&`IXn{~VH$1aCkoiMm3nH>W*XQEE%Afr2Fhcl7|Ffb zJGB4Kzg&s{Tj}_US2}! zr4q$1cr{UQ?C6S~W(GxgLs3oFw6&eTA;d3{X=iFX+2S>ls{yJ*c$^)$IlO)EdB|LFrUJ|oK}#@Umz za-mGG7-!4tpOI=4V{>xsCU41HY27R;T8yv;wY5fA<2#E%!NHc8cuR=8=$6_fz)$?t zROL0KItDzzPx3LDB|iy%lHf4FWcD&u9sc`wp!mD$WA6A0sdyZW`)EaRvFx;`_&9xt zyN73St#z99OZA&*yyL~V^99!rdNo~t=7p|{_tU!*Kj^R%mue<$IePoWsC9F9l{LIS zv=f!zXW-#}{QI9fy=bzsQ}^kr_Z}&9r{Y?N`b|AsuT%50M>zFJ->p+uR78f~eH2)4 zb>g?f>dwh5-4z}>qff;W-?Q&@9;Yh;X2WBWGI@3PAS9IFR||U1*XmZM?iRfre0KS> zRfX@=@20ivSATgkw=3VUw$UHl%j6T1W~CgWmli$Sw1eApGV$BK+7!#r3l?AW8LqB( zInP5?s$M!oCrsgjAHNhLe?i92rZPKyKz(K$8vWfBRqmXoLzBnvzN7CqYuWx@DQ#O$ zn_AC2v)<@2Z_>04o}YRH@p}|rz6xHpot||u_+j0*?K+JdeW=~2i47ldJ^#VufBzWx zFN1iMsj<|sa(2}DGy(qex%6qe>i>4S{(sH0Pm>(|r%6srq{A_U)mk0(*t2bRsd#Sn zJKzlIu@KT_j*woN{IFv6xQU??f32XqXZ(r|PnoDO9XzoclCmS zNe^DXOSMFA)@Mt9Ebv|Fp}X=Vr}0X>Lr=9&^zdWx(I+;!w>_^vF>Z7Bk3SThxIVpN zcs*-dD)aQrwerM;dyad4*W%gmWu2Cst7p6U&B}puwp|Eqo8HA^==+UOjG(%6RRNvV z^X<1i7G-QWJvg^nO8q(^Vuv;L`TcgqYwMqlYjj;z+RsPZ?8Su3zi*s=XYA7U*YgjA z>E^DzIQAkx`H=Fau3@6)cGRNK#V0$qJL8}DyzbFGjRHLynvc!CwzEy>z4KY2{crA) z7LrBBhMx}{R{nZgQ&Thk%>nM=Z)@)+1m(8#a33a>pm|b>?ov5CpRG_(RH*M!p9aXO z8oCzKTvzS>rn<-Q2$_^@`sY#q`#a<%nJPo4>F3Z1&dJKM<)vmMXNqw-z3c;$^K4>F zK}u#ue!49$UkncV%vA?e;m5&Mf55C{_VNkv2}qJkPF$t!Fg924hQZ*uZ-J;jtlG1k`0)7`Otct*sBIMxhbQ=k-3 z*^W6Rqj!cKdTk96gEN!!^F=SwLyXKw&CAJ$ariPAiOHE6Y037CoNSX`(m77nu!@8@ z6D!e<11*boOwLb-HOvkclteh*guRMbTbiSWy{V2=%khqqiFbto9mv^Y>HiLIaxYy#(t0Du~My0>BM_)mlG4GcYQzV-NHRNqsHg& zI=VeNe&6aJ^&M&yuaDA)@0@rrY1pJSDVtNHdPQ6rc+C*hZGXtf4|C+~f~;{@ez1A{ zI4^3qY*>K$4?&z1STx=LTFHIat2d@?$Qs=|(CUQ#!V)A(DnY`XeXq@`6p~ERLzilk zDtLTBT`m=mavaH3#YNJvB5LsT8z+O`r_X%qeskpY*5FkC93-HwrhElqQ>cVdv1P< z=FR_$n44ds++19utcXv~$QM&>dG?H68L7#3o0#E@MaQkSVjE#IEsrurld6m#-WF#Tls2``n>%w0751bB(TImw_EgZkS%-Nne9f^2&- zc$Ju88{iI@5d*v>Z!a_sBdwq$JyC~slr<`} zg%}@Z5fkDpVstzBr!~&moVA@bI4IsC!eLx|tTi}3qO%y6&^Fu>952R4J5E6pEwR=( zYiLw8duw!*7!w;59B&P_zq$MieQ*>U!8W)!U*As&h;=`h2LDr(5oUFVg^gy&m z#za`Fe71CoiM7PViC=mJgAf%Qkr3i&<;%M$_#J794Gx2@e-g~mv0^)Ge3aw#cJS{Y zF(xP$oJxoYiWOrLVq>D?Ebh*M>1d6J5Tl~w(Y6-nAVpZ5Cj>`F#aTKefb-U%2zNLo z${KG?tU9M^xW#A~g;+5pC^9J266Yz#SuChyC>m6#@LkZ6KWQ4DSBPnFTg6KRp@ZAUnq{ zrr5;P9QY{B*+_D}n4Fqg;Fxs~_q}rRvYebhz*VAbxPeEwgL6%ypJg4^GY+!v@im53x%TUu(Wv=ThO^b!92 zgNAdYQ7uPqSs(AY@57{eF8i*%>DI06c3E%_&tr9knaviZZcSW7o(-7gGcVWvX8O#8 zH;vuCkA8SXzx3^_Jatj?`r~8AbR4o_@Ssyu__LYJ;~#Vh&3mFsrwcA5l$RF%A7Tfk`|yIgu8)4SWK8fy>VKX*3p zw!_3^GI^PNC0`$t(~CoS?3}kXbVMnIw~!)5M49w4lcAk|wv# z$jVo|91t@`D~YeCfU@b=ewB88>*!fh~CE?afXT2^{g4{7jW5iTjhThV}kt zhu`veOZK!zKR7QGVDdNl!&+Er((&}DIa6T4^V;|JmHsyiRoRNk-)uHPznmBHI{Ut( z%VTVJ{@NikwsszLu(A~?zziNsm8}G%?A`t>d}ZOL9q6jrXWLso`C>Nvd~&zjoppV? zl_t69M#t-QU0MyP^2OKW@8u^!r$q&c=O6`&Q>$}!iM#*wG1RPV#2f&lA0R;<0DZ>l z^_tryGNp|y$o%z^74Lm2O~6~&(y6*d{)hh_|qAI|<(xlrmw!ts$Mx0Bpzx&k3!pUKkCT2ev zf0K`&vz2bQFW%{X`0(*--CDQu`o1Rlr4@+Q%2ryZM0aXX@k7BBPrBQtwo9*piJt@! z1^E#~owJo1^XE^{jPB7nW_5D-obfwDDorF`lb?^jkFV3jH~OQogo~*azVoBjdbSZ= zX=3&_`TF=)^{8L(C)eKOukw$4e&+bV9sTxJUC752;Qi@Bec$YVVNb~%^7u#_zXnh4 znX63vOaWd#=E_)TJ^AAK8qpPV-?W)AHhS{?X-*R}OaXwc$=~TqoV7;(Uaxn|!>hLdqUdG%#fPx(8c-2}xi4Y-qEpR(xP0nY_K7zF68#{2@Mg z!jACSb)P<3_1j^miI>?MT7kRdG)eLrF}(@p^Uz}-F?XOXbV8L0#IBD|Rj2uz-TB!E zRmrDa?kd7^w`NwFNYIMpU)Aa4!bd+3JHM;(x4zkzN9If$RAu516W`yf(w9~)S#KT; z`ziC6vVQu)vZTr$d6{9RnZ3L!eF>Cpv<2^2HCG;K-&gBJ>W<1*Ox}+8H&q6vq5Z{n zZEJVwJ>&OQA1~Z&{Qi>(gtxy>(|n4W%DW#SExGI>|tMrG!-)5g(zVg?_CuhshPD62B@h1ivG zoa~-H=__;6$(wm=E?Yb1ZS!325zwNSrComQ#zADEy>0&eu)*&F3#XsWnBVJBMC);e zrb{30ZM5*a?^nFJdFU-^bI&8_d z4I{eV?!Kb6sYJO!Dp9V19eksc>X0vmi_tr2vOF~d2FBGsHlNMHC3h3S)X=UoclNS!rYwRdC9ryg<|!444Z|p zrNCS*&gzihk1bU^X@{lr#@43(vXFfVwWmHGu|F(sVp;7=X%h;z^&V`B zT{x!e$AclhUn?4ZcVywiMz7NpS*O^y}NA21|=c7TOH>7U}}(CgZ- zyQiR22#+?_O?Q$i{`sCZXtU+j-caP++ZU7HJwIG*d8!bn6lcCV?wWRg?aSmVXRe)g zYr8A^TKSu@dK3Z3x%iav5d>UL|LC7@O6{pXuQ7PmQztKPZ& zO7+-Wqxprina}P77kjx692{ZaJ7wOykKucA&L5APkMRxC>r8&H3^%?Q+ Date: Sun, 13 Oct 2019 01:19:23 +0200 Subject: [PATCH 22/57] Modify save properties in frm files in the order vb ide wants them --- frmInfo.frm | 16 ++++++++-------- frmPreferences.frm | 4 ++-- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/frmInfo.frm b/frmInfo.frm index d9db1dc..c7569af 100644 --- a/frmInfo.frm +++ b/frmInfo.frm @@ -89,8 +89,8 @@ Begin VB.Form frmInfo TabIndex = 66 TabStop = 0 'False Top = 360 - Width = 2895 Visible = 0 'False + Width = 2895 Begin VB.TextBox txtLightProp Appearance = 0 'Flat BorderStyle = 0 'None @@ -149,8 +149,8 @@ Begin VB.Form frmInfo TabIndex = 68 Tag = "font1" Top = 840 - Width = 615 Visible = 0 'False + Width = 615 End Begin VB.PictureBox picLight Appearance = 0 'Flat @@ -225,8 +225,8 @@ Begin VB.Form frmInfo TabIndex = 70 Tag = "font2" Top = 840 - Width = 1095 Visible = 0 'False + Width = 1095 End Begin VB.Label lblInfo Alignment = 2 'Center @@ -248,8 +248,8 @@ Begin VB.Form frmInfo TabIndex = 69 Tag = "font2" Top = 840 - Width = 255 Visible = 0 'False + Width = 255 End End Begin VB.PictureBox picProp @@ -583,8 +583,8 @@ Begin VB.Form frmInfo TabIndex = 23 TabStop = 0 'False Top = 360 - Width = 2895 Visible = 0 'False + Width = 2895 Begin VB.TextBox txtScenProp Appearance = 0 'Flat BorderStyle = 0 'None @@ -917,8 +917,8 @@ Begin VB.Form frmInfo TabIndex = 22 TabStop = 0 'False Top = 360 - Width = 2895 Visible = 0 'False + Width = 2895 Begin VB.TextBox txtQuadX Appearance = 0 'Flat BackColor = &H004A3C31& @@ -1079,8 +1079,8 @@ Begin VB.Form frmInfo TabIndex = 34 TabStop = 0 'False Top = 360 - Width = 2895 Visible = 0 'False + Width = 2895 Begin VB.TextBox txtRotate Appearance = 0 'Flat BorderStyle = 0 'None @@ -1307,8 +1307,8 @@ Begin VB.Form frmInfo TabIndex = 32 TabStop = 0 'False Top = 360 - Width = 2895 Visible = 0 'False + Width = 2895 Begin VB.TextBox txtBounciness Appearance = 0 'Flat BorderStyle = 0 'None diff --git a/frmPreferences.frm b/frmPreferences.frm index b68c8ec..8c1d56b 100644 --- a/frmPreferences.frm +++ b/frmPreferences.frm @@ -30,8 +30,8 @@ Begin VB.Form frmPreferences TabStop = 0 'False Tag = "4" Top = 7440 - Width = 240 Visible = 0 'False + Width = 240 End Begin VB.PictureBox picScenery Appearance = 0 'Flat @@ -1044,8 +1044,8 @@ Begin VB.Form frmPreferences TabIndex = 80 Tag = "font2" Top = 7440 - Width = 1575 Visible = 0 'False + Width = 1575 End Begin VB.Label lblPref BackStyle = 0 'Transparent From 30b855b5a59cb188c94b55d4d68c0089f00420ad Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sun, 13 Oct 2019 02:01:13 +0200 Subject: [PATCH 23/57] Fix missing textures reset polygons on maximize --- frmSoldatMapEditor.frm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index dfb0c9f..3d4f535 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -11569,6 +11569,8 @@ End Function Public Sub setMapTexture(texturePath As String) + On Error GoTo ErrorHandler + Set mapTexture = D3DX.CreateTextureFromFileEx(D3DDevice, frmSoldatMapEditor.soldatDir & "textures\" & texturePath, D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_TRIANGLE, _ D3DX_FILTER_TRIANGLE, ColourKey, imageInfo, ByVal 0) @@ -11586,6 +11588,8 @@ Public Sub setMapTexture(texturePath As String) Render +ErrorHandler: + End Sub 'set polyclr when rgb modified From d80d81f7619e7f97b811c0a53f06f726cc56ab4a Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sun, 13 Oct 2019 13:14:11 +0200 Subject: [PATCH 24/57] Add script for bumping version numbers --- bump.bat | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 bump.bat diff --git a/bump.bat b/bump.bat new file mode 100644 index 0000000..17275ab --- /dev/null +++ b/bump.bat @@ -0,0 +1,36 @@ +:: Bump batch script +:: +:: Updates the version numbers for this project +:: Requires sed to work + +@ECHO OFF +PUSHD . + +sed >NUL 2>&1 +IF %ERRORLEVEL% == 9009 ( + ECHO ERROR: Cannot find sed + GOTO END +) + +IF "%1" == "" GOTO USAGE +SET BUMP_VERSION=%1 + +ECHO _START_%BUMP_VERSION%_END_ | sed -nb "/^_START_[0-9]\+\(\.[0-9]\+\)*_END_/!{q100}" +IF ERRORLEVEL 1 GOTO USAGE + +CD /D "%~dp0" + +:: Add more matches here +sed -bi "s/^!define PRODUCT_VERSION \".*\"/!define PRODUCT_VERSION \"%BUMP_VERSION%\"/g" pwinstall/pw.nsi +sed -bi "s/^Soldat Polyworks [0-9]\+\(\.[0-9]\+\)*/Soldat Polyworks %BUMP_VERSION%/g" pwinstall/readme.txt + +ECHO DONE! + +GOTO END + +:USAGE +ECHO %0: Updates the version numbers in the project +ECHO Usage: %0 1.2.3.4 + +:END +POPD From ccb6efd139cfb7b9b2e50e3f498fe0a43129c371 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sun, 13 Oct 2019 16:06:00 +0200 Subject: [PATCH 25/57] Add version bumping for exe version info --- bump.bat | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/bump.bat b/bump.bat index 17275ab..d0224c7 100644 --- a/bump.bat +++ b/bump.bat @@ -18,12 +18,26 @@ SET BUMP_VERSION=%1 ECHO _START_%BUMP_VERSION%_END_ | sed -nb "/^_START_[0-9]\+\(\.[0-9]\+\)*_END_/!{q100}" IF ERRORLEVEL 1 GOTO USAGE +SET BUMP_VERSION=%1 + +SET BUMP_COMMAND_MAJOR='ECHO _START_%BUMP_VERSION%_END_ ^^^| sed -b "s/^_START_\([0-9]\+\)\(\.[0-9]\+\)*_END_/\1/"' +SET BUMP_COMMAND_MINOR='ECHO _START_%BUMP_VERSION%_END_ ^^^| sed -b "s/^_START_[0-9]\+\.\([0-9]\+\)\(\.[0-9]\+\)*_END_/\1/"' +SET BUMP_COMMAND_REVISION='ECHO _START_%BUMP_VERSION%_END_ ^^^| sed -b "s/^_START_[0-9]\+\.[0-9]\+\.[0-9]\+\.\([0-9]\+\)\(\.[0-9]\+\)*_END_/\1/"' + +FOR /F "tokens=*" %%i IN (%BUMP_COMMAND_MAJOR%) DO SET BUMP_VERSION_MAJOR=%%i +FOR /F "tokens=*" %%i IN (%BUMP_COMMAND_MINOR%) DO SET BUMP_VERSION_MINOR=%%i +FOR /F "tokens=*" %%i IN (%BUMP_COMMAND_REVISION%) DO SET BUMP_VERSION_REVISION=%%i + CD /D "%~dp0" :: Add more matches here sed -bi "s/^!define PRODUCT_VERSION \".*\"/!define PRODUCT_VERSION \"%BUMP_VERSION%\"/g" pwinstall/pw.nsi sed -bi "s/^Soldat Polyworks [0-9]\+\(\.[0-9]\+\)*/Soldat Polyworks %BUMP_VERSION%/g" pwinstall/readme.txt +sed -bi "s/\(MajorVer=\)[0-9]\+/\1%BUMP_VERSION_MAJOR%/g" prjSoldatMapEditor.vbp +sed -bi "s/\(MinorVer=\)[0-9]\+/\1%BUMP_VERSION_MINOR%/g" prjSoldatMapEditor.vbp +sed -bi "s/\(RevisionVer=\)[0-9]\+/\1%BUMP_VERSION_REVISION%/g" prjSoldatMapEditor.vbp + ECHO DONE! GOTO END From 70d5828e1b978abd5be60ffa206e2c7906bb98d0 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Wed, 16 Oct 2019 00:53:33 +0200 Subject: [PATCH 26/57] Modify clean up comments --- frmColour.frm | 9 ----- frmInfo.frm | 1 - frmPreferences.frm | 2 - frmScenery.frm | 2 - frmSoldatMapEditor.frm | 84 ++++++++++++++++++++---------------------- frmWaypoints.frm | 2 - modSME.bas | 40 ++++++++++---------- 7 files changed, 59 insertions(+), 81 deletions(-) diff --git a/frmColour.frm b/frmColour.frm index 87f6fec..a796f63 100644 --- a/frmColour.frm +++ b/frmColour.frm @@ -1394,12 +1394,6 @@ Private Sub txtBright_GotFocus() End Sub -' -' -' -' -'-------- - Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCapture @@ -1492,7 +1486,6 @@ Public Sub SetColours() Dim i As Integer Dim c As Control - '-------- picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_colourpicker.bmp") picClr.Picture = LoadPicture(appPath & "\" & gfxDir & "\colour_picker.bmp") @@ -1509,7 +1502,6 @@ Public Sub SetColours() imgSat.Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") picClr.MouseIcon = LoadPicture(appPath & "\" & gfxDir & "\cursors\colour_picker.cur") - '-------- Me.BackColor = bgClr @@ -1542,4 +1534,3 @@ Public Sub SetColours() Next End Sub - diff --git a/frmInfo.frm b/frmInfo.frm index c7569af..7699a45 100644 --- a/frmInfo.frm +++ b/frmInfo.frm @@ -1713,7 +1713,6 @@ Private Sub Form_Load() setForm - '---- cboPolyType.ListIndex = 0 lblDimensions.Caption = "Dimensions: " & frmSoldatMapEditor.xTexture & " x " & frmSoldatMapEditor.yTexture diff --git a/frmPreferences.frm b/frmPreferences.frm index 8c1d56b..f9411ff 100644 --- a/frmPreferences.frm +++ b/frmPreferences.frm @@ -2521,7 +2521,6 @@ Public Sub SetColours() Dim i As Integer Dim c As Control - '-------- picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_preferences.bmp") picHotkeys.Picture = LoadPicture(appPath & "\" & gfxDir & "\tools.bmp") @@ -2537,7 +2536,6 @@ Public Sub SetColours() mouseEvent2 picScenery, 0, 0, BUTTON_SMALL, sceneryVerts, BUTTON_UP mouseEvent2 picTopmost, 0, 0, BUTTON_SMALL, topmost, BUTTON_UP - '-------- Me.BackColor = bgClr diff --git a/frmScenery.frm b/frmScenery.frm index 92e0f24..98c7b38 100644 --- a/frmScenery.frm +++ b/frmScenery.frm @@ -693,7 +693,6 @@ Public Sub SetColours() Dim i As Integer Dim c As Control - '-------- picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_scenery.bmp") @@ -707,7 +706,6 @@ Public Sub SetColours() mouseEvent2 picScale, 0, 0, BUTTON_SMALL, scaleScenery, BUTTON_UP mouseEvent2 picRotate, 0, 0, BUTTON_SMALL, rotateScenery, BUTTON_UP - '-------- Me.BackColor = bgClr lblLvl.BackColor = lblBackClr diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 3d4f535..5cef8b6 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -1290,7 +1290,8 @@ Const ColourKey As Long = &HFF00FF00 Const FVF As Long = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE Const FVF2 As Long = D3DFVF_XYZ -'-------- TYPES -------- + +'types Private Type TImageInfo Width As Integer @@ -1325,7 +1326,8 @@ Private Type TLightSource z As Single End Type -'-------- MAP TYPES -------- + +'map types Private Type TCustomVertex X As Single @@ -1471,7 +1473,6 @@ Private Type TConnection point2 As Integer End Type -'-------- Dim Version As Long Dim Polys() As TPolygon @@ -1540,7 +1541,6 @@ Const KEY_SHIFT As Byte = 1 Const KEY_CTRL As Byte = 2 Const KEY_ALT As Byte = 4 -'-------- Dim sketch() As TSketchLine Dim sketchLines As Integer @@ -1570,17 +1570,17 @@ Dim polyClr As TColour Dim opacity As Single Dim blendMode As Integer -Dim scrollCoords(1 To 2) As D3DVECTOR2 'coordinates for scrolling -Dim mouseCoords As D3DVECTOR2 'coordinates of mouse -Dim moveCoords(1 To 2) As D3DVECTOR2 'coordinates for moving vertices -Dim selectedCoords(1 To 2) As D3DVECTOR2 'coordinates of selected area -Dim selectedPolys() As Integer 'list of selected polys and verts -Dim vertexList() As TVertexData 'list of polys with selected verts -Dim numVerts As Integer 'number of current vertex being created -Dim numCorners As Integer 'number of corner of scenery being created +Dim scrollCoords(1 To 2) As D3DVECTOR2 'coordinates for scrolling +Dim mouseCoords As D3DVECTOR2 'coordinates of mouse +Dim moveCoords(1 To 2) As D3DVECTOR2 'coordinates for moving vertices +Dim selectedCoords(1 To 2) As D3DVECTOR2 'coordinates of selected area +Dim selectedPolys() As Integer 'list of selected polys and verts +Dim vertexList() As TVertexData 'list of polys with selected verts +Dim numVerts As Integer 'number of current vertex being created +Dim numCorners As Integer 'number of corner of scenery being created Dim numSelectedPolys As Integer -Dim numSelectedScenery As Integer 'number of currently selected scenery +Dim numSelectedScenery As Integer 'number of currently selected scenery Dim numSelColliders As Integer Dim numSelSpawns As Integer Dim numSelWaypoints As Integer @@ -1616,7 +1616,7 @@ Dim PolyTypeClrs(0 To 25) As Long Public shiftDown As Boolean, ctrlDown As Boolean, altDown As Boolean Dim rCenter As D3DVECTOR2 -Dim selRect(3) As D3DVECTOR2 'RECT +Dim selRect(3) As D3DVECTOR2 'RECT Dim xGridLines() As TLine Dim yGridLines() As TLine @@ -1818,7 +1818,6 @@ End Sub Public Sub loadCursors() - 'On Error Resume Next On Error GoTo ErrorHandler ImageList.ListImages.Clear @@ -2408,9 +2407,9 @@ Public Sub LoadFile(FileName As String) For i = -SECTOR_NUM To SECTOR_NUM For j = -SECTOR_NUM To SECTOR_NUM - Get #1, , polysInSector 'number of polys in sector - For k = 1 To polysInSector 'for each poly in sector - Get #1, , polyIndex 'load and discard poly index + Get #1, , polysInSector 'number of polys in sector + For k = 1 To polysInSector 'for each poly in sector + Get #1, , polyIndex 'load and discard poly index Next Next Next @@ -4170,7 +4169,6 @@ Public Sub Render() Dim sVal As Integer Dim objClr As Long - '---- Dim matView As D3DMATRIX Dim viewVector As D3DVECTOR @@ -4193,7 +4191,6 @@ Public Sub Render() D3DXMatrixPerspectiveLH matProj, Me.ScaleWidth / zoomFactor, -Me.ScaleHeight / zoomFactor, -1, 0 D3DDevice.SetTransform D3DTS_PROJECTION, matProj - '---- rc.X = 0 rc.Y = 0 @@ -5056,7 +5053,7 @@ Public Sub Render() D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 32, circleCoords(0), Len(circleCoords(0)) End If - 'vertex selection -------- + 'vertex selection -------- If currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB Then If toolAction Then circleCoords(0).Color = ARGB(255, RGB(255, 255, 255)) @@ -5080,7 +5077,7 @@ Public Sub Render() D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False - '---- + D3DDevice.EndScene D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0 @@ -6792,7 +6789,6 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A If Button <> 1 Then Exit Sub - '---- If spaceDown Then 'scrolling @@ -6816,7 +6812,7 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A moveCoords(1).Y = Y End If - ElseIf currentFunction = TOOL_MOVE And toolAction Then 'moving -------- + ElseIf currentFunction = TOOL_MOVE And toolAction Then 'moving If Shift = KEY_SHIFT Then 'constrained If Abs(X - moveCoords(2).X) > Abs(Y - moveCoords(2).Y) Then @@ -6853,7 +6849,7 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A selectedCoords(2).Y = Y End If - ElseIf currentFunction = TOOL_PSELECT And toolAction Then 'poly selection -------- + ElseIf currentFunction = TOOL_PSELECT And toolAction Then 'poly selection ElseIf currentFunction = TOOL_VCOLOUR And toolAction Then ' vertex colouring @@ -6861,9 +6857,9 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A VertexColouring X, Y End If - ElseIf currentFunction = TOOL_PCOLOUR Then 'poly colouring -------- + ElseIf currentFunction = TOOL_PCOLOUR Then 'poly colouring - ElseIf currentFunction = TOOL_TEXTURE And toolAction Then 'texture -------- + ElseIf currentFunction = TOOL_TEXTURE And toolAction Then 'texture If Shift = 0 Then StretchingTexture X, Y @@ -6876,9 +6872,9 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A StretchingTexture X, Y End If - ElseIf currentFunction = TOOL_SCENERY Then 'scenery -------- + ElseIf currentFunction = TOOL_SCENERY Then 'scenery - ElseIf currentFunction = TOOL_CLRPICKER Then 'colour picker -------- + ElseIf currentFunction = TOOL_CLRPICKER Then 'colour picker If currentTool = TOOL_DEPTHMAP Then depthPicker X, Y @@ -6906,7 +6902,7 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A ElseIf currentFunction = TOOL_LITPICKER Then 'light picker - ElseIf currentFunction = TOOL_OBJECTS Then 'objects -------- + ElseIf currentFunction = TOOL_OBJECTS Then 'objects Spawns(0).X = X Spawns(0).Y = Y @@ -6916,13 +6912,13 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A Render End If - ElseIf currentFunction = TOOL_WAYPOINT And toolAction Then 'waypoints -------- + ElseIf currentFunction = TOOL_WAYPOINT And toolAction Then 'waypoints - ElseIf currentFunction = TOOL_DEPTHMAP And toolAction Then 'depthmap -------- + ElseIf currentFunction = TOOL_DEPTHMAP And toolAction Then 'depthmap EditDepthMap X, Y - ElseIf currentFunction = TOOL_SKETCH And toolAction Then 'sketch -------- + ElseIf currentFunction = TOOL_SKETCH And toolAction Then 'sketch If Shift = 0 Then 'freeform linkSketch X, Y @@ -14542,7 +14538,7 @@ ErrorHandler: End Sub -'--------- apply scale/rotate +'apply scale/rotate Public Sub applyPolyType(ByVal Index As Integer) @@ -15002,17 +14998,15 @@ Private Sub SetTextureCoords(X As Single, Y As Single, z As Single, tu As Single End If End If Next - - 'next - 'end if Next - ' loop through all vertices to find vertices at this point, put into array - ' set their coords - ' set vertex list value to mark - - ' for each vertex at this point, find adjacent verts - ' calc new coords, call this and set new coords? - ' send new coords to this routine? - ' call this routine on them + + 'loop through all vertices to find vertices at this point, put into array + 'set their coords + 'set vertex list value to mark + + 'for each vertex at this point, find adjacent verts + 'calc new coords, call this and set new coords? + 'send new coords to this routine? + 'call this routine on them End Sub diff --git a/frmWaypoints.frm b/frmWaypoints.frm index f703a62..d614847 100644 --- a/frmWaypoints.frm +++ b/frmWaypoints.frm @@ -763,7 +763,6 @@ Public Sub SetColours() Dim i As Integer Dim c As Control - '-------- picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_waypoints.bmp") mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP @@ -779,7 +778,6 @@ Public Sub SetColours() mouseEvent2 picShow(i), 0, 0, BUTTON_SMALL, i = showPaths, BUTTON_UP Next - '-------- Me.BackColor = bgClr diff --git a/modSME.bas b/modSME.bas index 9914933..b479c15 100644 --- a/modSME.bas +++ b/modSME.bas @@ -1,7 +1,7 @@ Attribute VB_Name = "modSME" Option Explicit -Global Const pi As Single = 3.14159265358979 'mmm... pi +Global Const pi As Single = 3.14159265358979 'mmm... pi Global gfxDir As String @@ -593,8 +593,8 @@ End Function Private Function GetRegValue(hSubKey As Long, sKeyName As String) As String - Dim lpValue As String 'name of the value to retrieve - Dim lpcbData As Long 'length of the retrieved value + Dim lpValue As String 'name of the value to retrieve + Dim lpcbData As Long 'length of the retrieved value Dim Result As Long 'if valid @@ -794,7 +794,7 @@ Public Sub SetColours() End Sub -' Initialises GDI Plus +'Initialises GDI Plus Public Function InitGDIPlus() As Long Dim Token As Long Dim gdipInit As GdiplusStartupInput @@ -804,12 +804,12 @@ Public Function InitGDIPlus() As Long InitGDIPlus = Token End Function -' Frees GDI Plus +'Frees GDI Plus Public Sub FreeGDIPlus(Token As Long) GdiplusShutdown Token End Sub -' Loads the picture (optionally resized) +'Loads the picture (optionally resized) Public Function LoadPictureGDIPlus(PicFile As String, Optional Width As Long = -1, Optional Height As Long = -1, Optional ByVal BackColor As Long = vbWhite) As IPicture On Error GoTo ErrorHandler @@ -818,25 +818,25 @@ Public Function LoadPictureGDIPlus(PicFile As String, Optional Width As Long = - Dim hBitmap As Long Dim Img As Long Dim hBrush As Long - Dim Graphics As Long ' Graphics Object Pointer + Dim Graphics As Long 'Graphics Object Pointer Dim IID_IDispatch As GUID Dim pic As PICTDESC Dim IPic As IPicture - '' Load the image + 'Load the image If Len(Dir$(PicFile)) <> 0 Then If GdipLoadImageFromFile(StrPtr(PicFile), Img) <> 0 Then Exit Function End If End If - ' Calculate picture's width and height if not specified + 'Calculate picture's width and height if not specified If Width = -1 Or Height = -1 Then GdipGetImageWidth Img, Width GdipGetImageHeight Img, Height End If - ' Initialise the hDC - ' Create a memory DC and select a bitmap into it, fill it in with the backcolor + 'Initialise the hDC + 'Create a memory DC and select a bitmap into it, fill it in with the backcolor hDC = CreateCompatibleDC(ByVal 0&) hBitmap = CreateBitmap(Width, Height, GetDeviceCaps(hDC, PLANES), GetDeviceCaps(hDC, BITSPIXEL), ByVal 0&) hBitmap = SelectObject(hDC, hBitmap) @@ -844,24 +844,24 @@ Public Function LoadPictureGDIPlus(PicFile As String, Optional Width As Long = - hBrush = SelectObject(hDC, hBrush) PatBlt hDC, 0, 0, Width, Height, PATCOPY DeleteObject SelectObject(hDC, hBrush) - ' Resize the picture + 'Resize the picture GdipCreateFromHDC hDC, Graphics GdipDrawImageRectI Graphics, Img, 0, 0, Width, Height GdipDeleteGraphics Graphics GdipDisposeImage Img - ' Get the bitmap back + 'Get the bitmap back hBitmap = SelectObject(hDC, hBitmap) DeleteDC hDC - ' Create the picture - ' Fill in OLE IDispatch Interface ID + 'Create the picture + 'Fill in OLE IDispatch Interface ID IID_IDispatch.Data1 = &H20400 IID_IDispatch.Data4(0) = &HC0 IID_IDispatch.Data4(7) = &H46 - ' Fill Pic with necessary parts - pic.Size = Len(pic) ' Length of structure - pic.Type = PICTYPE_BITMAP ' Type of Picture (bitmap) - pic.hBmp = hBitmap ' Handle to bitmap - ' Create the picture + 'Fill Pic with necessary parts + pic.Size = Len(pic) 'Length of structure + pic.Type = PICTYPE_BITMAP 'Type of Picture (bitmap) + pic.hBmp = hBitmap 'Handle to bitmap + 'Create the picture OleCreatePictureIndirect pic, IID_IDispatch, True, IPic Set LoadPictureGDIPlus = IPic From 88df24a8dac5d0c2116bf25b5701fa5fa1e65273 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 17 Oct 2019 00:59:09 +0200 Subject: [PATCH 27/57] Modify use Arial in Display form --- frmDisplay.frm | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/frmDisplay.frm b/frmDisplay.frm index 3aaa36a..6336ceb 100644 --- a/frmDisplay.frm +++ b/frmDisplay.frm @@ -242,7 +242,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Sketch" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -265,7 +265,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Lights" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -288,7 +288,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Waypoints" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -311,7 +311,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Scenery" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -334,7 +334,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Objects" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -357,7 +357,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Grid" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -380,7 +380,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Background" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -403,7 +403,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Polygons" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -426,7 +426,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Texture" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -449,7 +449,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Wireframe" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 @@ -472,7 +472,7 @@ Begin VB.Form frmDisplay BackStyle = 0 'Transparent Caption = " Points" BeginProperty Font - Name = "BankGothic Lt BT" + Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 From ad463a0dc58b3994023202bcdd180926a741799a Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 17 Oct 2019 01:02:58 +0200 Subject: [PATCH 28/57] Modify format error handler code --- frmColour.frm | 4 ++++ frmDisplay.frm | 2 ++ frmInfo.frm | 2 ++ frmMap.frm | 2 ++ frmPalette.frm | 6 ++++++ frmPreferences.frm | 2 ++ frmScenery.frm | 2 ++ frmSoldatMapEditor.frm | 40 ++++++++++++++++++++++++++++++++++++++++ frmTexture.frm | 2 ++ frmTools.frm | 2 ++ frmWaypoints.frm | 2 ++ modSME.bas | 2 ++ 12 files changed, 68 insertions(+) diff --git a/frmColour.frm b/frmColour.frm index a796f63..129e974 100644 --- a/frmColour.frm +++ b/frmColour.frm @@ -668,7 +668,9 @@ Public Sub InitClr(initRed As Byte, initGreen As Byte, initBlue As Byte) updateHex Exit Sub + ErrorHandler: + MsgBox "Error initializing colour picker" & vbNewLine & Error$ End Sub @@ -761,7 +763,9 @@ Private Sub Form_Load() pureClr(2) = 255 Exit Sub + ErrorHandler: + MsgBox Error$ & vbNewLine & "Error loading Colour Picker form" End Sub diff --git a/frmDisplay.frm b/frmDisplay.frm index 6336ceb..9b2b750 100644 --- a/frmDisplay.frm +++ b/frmDisplay.frm @@ -548,7 +548,9 @@ Private Sub Form_Load() setForm Exit Sub + ErrorHandler: + MsgBox Error$ & vbNewLine & "Error loading Display form" End Sub diff --git a/frmInfo.frm b/frmInfo.frm index 7699a45..6475bd6 100644 --- a/frmInfo.frm +++ b/frmInfo.frm @@ -1722,7 +1722,9 @@ Private Sub Form_Load() txtQuadY(1).Text = frmSoldatMapEditor.yTexture Exit Sub + ErrorHandler: + MsgBox Error$ & vbNewLine & "Error loading Properties form" End Sub diff --git a/frmMap.frm b/frmMap.frm index da3fac7..01f25bb 100644 --- a/frmMap.frm +++ b/frmMap.frm @@ -586,7 +586,9 @@ Public Sub Form_Load() getJets Exit Sub + ErrorHandler: + MsgBox Error$ & vbNewLine & "Error loading Map form" End Sub diff --git a/frmPalette.frm b/frmPalette.frm index eb5e82f..c73aa6a 100644 --- a/frmPalette.frm +++ b/frmPalette.frm @@ -672,7 +672,9 @@ Private Sub Form_Load() setForm Exit Sub + ErrorHandler: + MsgBox Error$ & vbNewLine & "Error loading Palette form" End Sub @@ -721,7 +723,9 @@ Public Sub loadPalette(fileName As String) picPalette.Refresh Exit Sub + ErrorHandler: + mnuClearPalette_Click If fileOpen Then Close #1 MsgBox "Error loading palette" & vbNewLine & Error$ @@ -781,7 +785,9 @@ Public Sub savePalette(fileName As String) fileOpen = False Exit Sub + ErrorHandler: + If fileOpen Then Close #1 MsgBox "Error saving palette" & vbNewLine & Error$ diff --git a/frmPreferences.frm b/frmPreferences.frm index f9411ff..8bd15ff 100644 --- a/frmPreferences.frm +++ b/frmPreferences.frm @@ -2011,7 +2011,9 @@ Private Sub Form_Load() txtPrefabs.Text = frmSoldatMapEditor.prefabDir Exit Sub + ErrorHandler: + MsgBox Error$ & vbNewLine & "Error loading Preferences form" End Sub diff --git a/frmScenery.frm b/frmScenery.frm index 98c7b38..a9be8de 100644 --- a/frmScenery.frm +++ b/frmScenery.frm @@ -357,7 +357,9 @@ Private Sub Form_Load() listScenery Exit Sub + ErrorHandler: + MsgBox Error$ & vbNewLine & "Error loading Scenery form" End Sub diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 5cef8b6..3b0c5fe 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -1799,7 +1799,9 @@ Private Sub Form_Load() acquired = True Exit Sub + ErrorHandler: + MsgBox "Error loading" & vbNewLine & err & vbNewLine & Error$ End Sub @@ -1811,7 +1813,9 @@ Private Sub SetCursor(Index As Integer) Me.MouseIcon = frmSoldatMapEditor.ImageList.ListImages(Index).Picture Exit Sub + ErrorHandler: + MsgBox "Error setting cursor" & vbNewLine & Error$ End Sub @@ -1882,7 +1886,9 @@ Public Sub loadCursors() ImageList.ListImages.Item(TOOL_SMUDGE + 1).Tag = "Move Lines" Exit Sub + ErrorHandler: + MsgBox "Error loading cursors" & vbNewLine & Error$ End Sub @@ -2056,7 +2062,9 @@ Public Sub Init() initialized = True Exit Sub + ErrorHandler: + If D3DX Is Nothing Then MsgBox "Direct3D initialization failed" & vbNewLine & debugVal & vbNewLine & Error$ Else @@ -3598,7 +3606,9 @@ Private Sub SaveUndo() Close #1 Exit Sub + ErrorHandler: + MsgBox "Error saving undo" & vbNewLine & Error$ End Sub @@ -3897,6 +3907,7 @@ Private Function isInSector2(Index As Integer, X As Integer, Y As Integer, div A Exit Function ErrorHandler: + MsgBox Error$ End Function @@ -4005,7 +4016,9 @@ Private Function segmentsIntersect(ByVal x1 As Integer, ByVal y1 As Integer, ByV segmentsIntersect = (s >= 0 And s <= 1 And T >= 0 And T <= 1) Exit Function + ErrorHandler: + MsgBox Error$ End Function @@ -4091,7 +4104,9 @@ Private Sub initGrid() inc = (gridSpacing / gridDivisions) Exit Sub + ErrorHandler: + MsgBox "Error initializing grid" End Sub @@ -6293,6 +6308,7 @@ Private Sub applyLightsToVert(pIndex As Integer, vIndex As Integer) Exit Sub ErrorHandler: + MsgBox Error$ End Sub @@ -8585,7 +8601,9 @@ Private Sub startSketch(X As Single, Y As Single) Render Exit Sub + ErrorHandler: + MsgBox "Error starting sketch" & vbNewLine & Error$ End Sub @@ -8606,7 +8624,9 @@ Private Sub lineSketch(X As Single, Y As Single) sketch(sketchLines).vertex(2).z = 1 Exit Sub + ErrorHandler: + MsgBox "Error sketching line" & vbNewLine & Error$ End Sub @@ -8639,7 +8659,9 @@ Private Sub linkSketch(X As Single, Y As Single) End If Exit Sub + ErrorHandler: + MsgBox "Error linking sketch" & vbNewLine & Error$ End Sub @@ -8717,7 +8739,9 @@ Private Sub CreateScenery(X As Single, Y As Single) End If Exit Sub + ErrorHandler: + MsgBox "Error creating scenery" & vbNewLine & Error$ End Sub @@ -9235,7 +9259,9 @@ Private Function eraseSketch(X As Single, Y As Single) As Byte End If Exit Function + ErrorHandler: + MsgBox "Error erasing sketch" & vbNewLine & Error$ End Function @@ -9264,7 +9290,9 @@ Private Function moveLines(X As Single, Y As Single, xDiff As Single, yDiff As S Next Exit Function + ErrorHandler: + MsgBox "Error moving sketch lines" & vbNewLine & Error$ End Function @@ -9287,7 +9315,9 @@ Private Sub deleteSmallLines() Render Exit Sub + ErrorHandler: + MsgBox "Error deleting small sketch lines" & vbNewLine & Error$ End Sub @@ -9723,7 +9753,9 @@ Private Sub getRCenter() End If Exit Sub + ErrorHandler: + MsgBox Error$ End Sub @@ -10341,7 +10373,9 @@ Private Sub deletePolys() getInfo Exit Sub + ErrorHandler: + MsgBox "Error deleting" & vbNewLine & Error$ End Sub @@ -11985,7 +12019,9 @@ Public Sub ClearUnused() numUndo = 0 Exit Sub + ErrorHandler: + MsgBox "Error clearing unused scenery" & vbNewLine & Error$ End Sub @@ -12376,7 +12412,9 @@ Public Sub loadColours() If font2 = "" Then font2 = "Arial" Exit Sub + ErrorHandler: + MsgBox "Error loading colours" & vbNewLine & Error$ End Sub @@ -14533,7 +14571,9 @@ Public Sub getInfo() frmWaypoints.noChange = False Exit Sub + ErrorHandler: + MsgBox "getInfo() error" & vbNewLine & Error$ End Sub diff --git a/frmTexture.frm b/frmTexture.frm index 453f455..1e5bf43 100644 --- a/frmTexture.frm +++ b/frmTexture.frm @@ -91,7 +91,9 @@ Private Sub Form_Load() setForm Exit Sub + ErrorHandler: + MsgBox Error$ & vbNewLine & "Error loading texture form" End Sub diff --git a/frmTools.frm b/frmTools.frm index 0eb6452..58cf949 100644 --- a/frmTools.frm +++ b/frmTools.frm @@ -350,7 +350,9 @@ Private Sub Form_Load() setForm Exit Sub + ErrorHandler: + MsgBox Error$ & vbNewLine & "Error loading Tools form" End Sub diff --git a/frmWaypoints.frm b/frmWaypoints.frm index d614847..4379578 100644 --- a/frmWaypoints.frm +++ b/frmWaypoints.frm @@ -537,7 +537,9 @@ Private Sub Form_Load() setForm Exit Sub + ErrorHandler: + MsgBox Error$ & vbNewLine & "Error loading Waypoints form" End Sub diff --git a/modSME.bas b/modSME.bas index b479c15..312efd3 100644 --- a/modSME.bas +++ b/modSME.bas @@ -574,7 +574,9 @@ Public Function GetSoldatDir() As String End If Exit Function + ErrorHandler: + MsgBox "Error getting soldat directory from registry" & vbNewLine & Error$ End Function From bee67f22691b9167aca65a65799500dbbd3f9869 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Fri, 18 Oct 2019 00:46:23 +0200 Subject: [PATCH 29/57] Modify switch from colour to color in filenames and files --- frmColour.frm => frmColor.frm | 3080 ++++++++--------- frmDisplay.frm | 4 +- frmInfo.frm | 6 +- frmMap.frm | 12 +- frmPalette.frm | 56 +- frmPreferences.frm | 108 +- frmScenery.frm | 4 +- frmSoldatMapEditor.frm | 624 ++-- frmTexture.frm | 4 +- frmTools.frm | 16 +- frmWaypoints.frm | 4 +- modSME.bas | 4 +- prjSoldatMapEditor.vbp | 2 +- pwinstall/BMPtoCUR/ReadMe.txt | 4 +- pwinstall/PolyWorks Help.html | 66 +- pwinstall/ReadMe.txt | 18 +- .../{colour_picker.bmp => color_picker.bmp} | Bin pwinstall/gfx/{colours.ini => colors.ini} | 18 +- .../{colour_picker.cur => color_picker.cur} | Bin .../gfx/cursors/{pcolour.cur => pcolor.cur} | Bin .../gfx/cursors/{vcolour.cur => vcolor.cur} | Bin ...ourpicker.bmp => titlebar_colorpicker.bmp} | Bin 24128 -> 24126 bytes pwinstall/polyworks.ini | 14 +- pwinstall/pw.nsi | 32 +- 24 files changed, 2038 insertions(+), 2038 deletions(-) rename frmColour.frm => frmColor.frm (94%) rename pwinstall/gfx/{colour_picker.bmp => color_picker.bmp} (100%) rename pwinstall/gfx/{colours.ini => colors.ini} (85%) rename pwinstall/gfx/cursors/{colour_picker.cur => color_picker.cur} (100%) rename pwinstall/gfx/cursors/{pcolour.cur => pcolor.cur} (100%) rename pwinstall/gfx/cursors/{vcolour.cur => vcolor.cur} (100%) rename pwinstall/gfx/{titlebar_colourpicker.bmp => titlebar_colorpicker.bmp} (91%) diff --git a/frmColour.frm b/frmColor.frm similarity index 94% rename from frmColour.frm rename to frmColor.frm index 129e974..c1e8366 100644 --- a/frmColour.frm +++ b/frmColor.frm @@ -1,1540 +1,1540 @@ -VERSION 5.00 -Begin VB.Form frmColour - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 1 'Fixed Single - ClientHeight = 5640 - ClientLeft = 15 - ClientTop = 15 - ClientWidth = 7080 - ControlBox = 0 'False - KeyPreview = -1 'True - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 376 - ScaleMode = 3 'Pixel - ScaleWidth = 472 - ShowInTaskbar = 0 'False - StartUpPosition = 3 'Windows Default - Begin VB.TextBox txtHexCode - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Left = 4440 - TabIndex = 27 - Tag = "font1" - Top = 5160 - Width = 855 - End - Begin VB.PictureBox picClr - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - DrawMode = 6 'Mask Pen Not - ForeColor = &H80000008& - Height = 3855 - Left = 240 - MousePointer = 99 'Custom - ScaleHeight = 255 - ScaleMode = 3 'Pixel - ScaleWidth = 255 - TabIndex = 23 - TabStop = 0 'False - Top = 480 - Width = 3855 - End - Begin VB.PictureBox picColour - Appearance = 0 'Flat - BackColor = &H80000005& - ForeColor = &H80000008& - Height = 960 - Left = 240 - ScaleHeight = 62 - ScaleMode = 3 'Pixel - ScaleWidth = 62 - TabIndex = 22 - TabStop = 0 'False - Top = 4440 - Width = 960 - End - Begin VB.TextBox txtRGB - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Index = 0 - Left = 3600 - MaxLength = 3 - TabIndex = 0 - Tag = "font1" - Top = 4440 - Width = 480 - End - Begin VB.TextBox txtRGB - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Index = 1 - Left = 3600 - MaxLength = 3 - TabIndex = 1 - Tag = "font1" - Top = 4800 - Width = 480 - End - Begin VB.TextBox txtRGB - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Index = 2 - Left = 3600 - MaxLength = 3 - TabIndex = 2 - Tag = "font1" - Top = 5160 - Width = 480 - End - Begin VB.TextBox txtHue - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 2160 - MaxLength = 3 - TabIndex = 3 - Tag = "font1" - Top = 4440 - Width = 480 - End - Begin VB.TextBox txtSat - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 2160 - MaxLength = 3 - TabIndex = 4 - Tag = "font1" - Top = 4800 - Width = 480 - End - Begin VB.TextBox txtBright - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 2160 - MaxLength = 3 - TabIndex = 5 - Tag = "font1" - Top = 5160 - Width = 480 - End - Begin VB.PictureBox picHue - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - ForeColor = &H80000008& - Height = 3855 - Left = 5160 - ScaleHeight = 255 - ScaleMode = 3 'Pixel - ScaleWidth = 15 - TabIndex = 15 - TabStop = 0 'False - Top = 480 - Width = 255 - End - Begin VB.PictureBox picSat - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - ForeColor = &H80000008& - Height = 3855 - Left = 4680 - ScaleHeight = 255 - ScaleMode = 3 'Pixel - ScaleWidth = 15 - TabIndex = 14 - TabStop = 0 'False - Top = 480 - Width = 255 - End - Begin VB.PictureBox picBright - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - ForeColor = &H80000008& - Height = 3855 - Left = 4200 - ScaleHeight = 255 - ScaleMode = 3 'Pixel - ScaleWidth = 15 - TabIndex = 13 - TabStop = 0 'False - Top = 480 - Width = 255 - End - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 255 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 472 - TabIndex = 11 - TabStop = 0 'False - Top = 0 - Width = 7080 - Begin VB.PictureBox picHide - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 6840 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 12 - TabStop = 0 'False - Tag = "3" - Top = 0 - Width = 240 - End - End - Begin VB.PictureBox picRGB - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - ForeColor = &H80000008& - Height = 3855 - Index = 2 - Left = 6600 - ScaleHeight = 255 - ScaleMode = 3 'Pixel - ScaleWidth = 15 - TabIndex = 10 - TabStop = 0 'False - Top = 480 - Width = 255 - End - Begin VB.PictureBox picRGB - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - ForeColor = &H80000008& - Height = 3855 - Index = 1 - Left = 6120 - ScaleHeight = 255 - ScaleMode = 3 'Pixel - ScaleWidth = 15 - TabIndex = 9 - TabStop = 0 'False - Top = 480 - Width = 255 - End - Begin VB.PictureBox picRGB - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - ForeColor = &H80000008& - Height = 3855 - Index = 0 - Left = 5640 - ScaleHeight = 255 - ScaleMode = 3 'Pixel - ScaleWidth = 15 - TabIndex = 8 - TabStop = 0 'False - Top = 480 - Width = 255 - End - Begin VB.PictureBox picCancel - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 360 - Left = 5880 - ScaleHeight = 24 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 7 - TabStop = 0 'False - Tag = "1" - Top = 5040 - Width = 960 - End - Begin VB.PictureBox picOK - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 360 - Left = 5880 - ScaleHeight = 24 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 6 - TabStop = 0 'False - Tag = "0" - Top = 4560 - Width = 960 - End - Begin VB.Label lblClr - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 8 - Left = 2640 - TabIndex = 26 - Tag = "font2" - Top = 5160 - Width = 255 - End - Begin VB.Label lblClr - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 7 - Left = 2640 - TabIndex = 25 - Tag = "font2" - Top = 4800 - Width = 255 - End - Begin VB.Label lblClr - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "°" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 6 - Left = 2640 - TabIndex = 24 - Tag = "font2" - Top = 4440 - Width = 135 - End - Begin VB.Image imgBright - Appearance = 0 'Flat - Height = 225 - Left = 4440 - Top = 480 - Width = 225 - End - Begin VB.Image imgSat - Appearance = 0 'Flat - Height = 225 - Left = 4920 - Top = 480 - Width = 225 - End - Begin VB.Image imgHue - Appearance = 0 'Flat - Height = 225 - Left = 5400 - Top = 480 - Width = 225 - End - Begin VB.Image imgRGB - Appearance = 0 'Flat - Height = 225 - Index = 2 - Left = 6840 - Top = 480 - Width = 225 - End - Begin VB.Image imgRGB - Appearance = 0 'Flat - Height = 225 - Index = 1 - Left = 6360 - Top = 480 - Width = 225 - End - Begin VB.Image imgRGB - Appearance = 0 'Flat - Height = 225 - Index = 0 - Left = 5880 - Top = 480 - Width = 225 - End - Begin VB.Label lblClr - Alignment = 1 'Right Justify - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = "R" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 3 - Left = 3240 - TabIndex = 21 - Tag = "font2" - Top = 4440 - Width = 255 - End - Begin VB.Label lblClr - Alignment = 1 'Right Justify - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = "G" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 4 - Left = 3240 - TabIndex = 20 - Tag = "font2" - Top = 4800 - Width = 255 - End - Begin VB.Label lblClr - Alignment = 1 'Right Justify - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = "B" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 5 - Left = 3240 - TabIndex = 19 - Tag = "font2" - Top = 5160 - Width = 255 - End - Begin VB.Label lblClr - Alignment = 1 'Right Justify - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = "H" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 1800 - TabIndex = 18 - Tag = "font2" - Top = 4440 - Width = 255 - End - Begin VB.Label lblClr - Alignment = 1 'Right Justify - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = "S" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 1800 - TabIndex = 17 - Tag = "font2" - Top = 4800 - Width = 255 - End - Begin VB.Label lblClr - Alignment = 1 'Right Justify - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = "B" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 1800 - TabIndex = 16 - Tag = "font2" - Top = 5160 - Width = 255 - End -End -Attribute VB_Name = "frmColour" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Public red As Byte, green As Byte, blue As Byte -Dim hue As Single, sat As Single, bright As Single -Dim low As Byte, mid As Byte, high As Byte - -Dim clr(0 To 2) As Byte -Dim pureClr(0 To 2) As Byte - -Dim oldX As Integer, oldY As Integer - -Public ok As Boolean - -Const R As Byte = 0 -Const G As Byte = 1 -Const B As Byte = 2 - -Dim tempHexVal As String -Dim hexValue As String - -Dim nonModal As Boolean - -Dim lastTool As Byte - -Public Sub InitClr(initRed As Byte, initGreen As Byte, initBlue As Byte) - - On Error GoTo ErrorHandler - - clr(R) = initRed - clr(G) = initGreen - clr(B) = initBlue - red = clr(R) - green = clr(G) - blue = clr(B) - - changeRGB - - picClr.Cls - oldX = (hue / 360 * 256) - oldY = 255 - (sat * 255) - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - - picColour.BackColor = RGB(clr(R), clr(B), clr(G)) - - updateAll - updateRGB - updateHSB - updateHex - - Exit Sub - -ErrorHandler: - - MsgBox "Error initializing colour picker" & vbNewLine & Error$ - -End Sub - -Public Sub ChangeColour(ByRef pic As PictureBox, ByRef rVal As Byte, ByRef gVal As Byte, ByRef bVal As Byte, ByVal cTool As Byte) - - nonModal = True - - lastTool = frmSoldatMapEditor.setTempTool(10) - frmSoldatMapEditor.setCurrentTool 10 - - frmSoldatMapEditor.picMenuBar.Enabled = False - frmTools.Enabled = False - frmPalette.Enabled = False - frmScenery.Enabled = False - frmInfo.Enabled = False - frmWaypoints.Enabled = False - frmDisplay.picTitle.Enabled = False - - Me.Show , frmSoldatMapEditor - -End Sub - -Private Sub HideColour(apply As Boolean) - - On Error GoTo ErrorHandler - - If nonModal Then - If apply Then - frmPalette.setValues red, green, blue - frmPalette.checkPalette red, green, blue - End If - - nonModal = False - - frmSoldatMapEditor.picMenuBar.Enabled = True - - frmTools.Enabled = True - frmPalette.Enabled = True - frmScenery.Enabled = True - frmInfo.Enabled = True - frmWaypoints.Enabled = True - frmDisplay.picTitle.Enabled = True - - frmSoldatMapEditor.setCurrentTool lastTool - lastTool = 0 - - End If - - Me.Hide - frmSoldatMapEditor.RegainFocus - - Exit Sub - -ErrorHandler: - - MsgBox Error$ - -End Sub - -Private Sub Form_KeyPress(KeyAscii As Integer) - - If KeyAscii = 27 Then - picColour.SetFocus - picCancel_Click - ElseIf KeyAscii = 13 Then - picColour.SetFocus - picOK_Click - End If - -End Sub - -Private Sub Form_Load() - - On Error GoTo ErrorHandler - - Me.SetColours - - oldX = -16 - oldY = -16 - ok = False - hue = 0 - sat = 0 - bright = 0 - low = B - mid = G - high = R - pureClr(0) = 255 - pureClr(1) = 255 - pureClr(2) = 255 - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading Colour Picker form" - -End Sub - -Private Sub lblRGB_Click(Index As Integer) - -End Sub - -Private Sub picClr_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - picClr_MouseMove Button, Shift, X, Y - -End Sub - -Private Sub picClr_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - Dim xVal As Integer - - If Button = 1 Then - If X > 255 Then - X = 255 - ElseIf X < 0 Then - X = 0 - End If - If Y > 255 Then - Y = 255 - ElseIf Y < 0 Then - Y = 0 - End If - - sat = (255 - Y) / 255 - hue = X / 255 * 359 - calculateHue - changeRGB - txtSat.Text = Int(sat * 100 + 0.5) - txtHue.Text = Int(hue + 0.5) - updateAll - updateRGB - updateHex - - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - oldX = X - oldY = Y - picClr.Circle (X, Y), 5.5, RGB(0, 0, 0) - End If - -End Sub - -Private Sub picRGB_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - picRGB_MouseMove Index, Button, Shift, X, Y - -End Sub - -Private Sub picRGB_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - If X > 255 Then - X = 255 - ElseIf X < 0 Then - X = 0 - End If - If Y > 255 Then - Y = 255 - ElseIf Y < 0 Then - Y = 0 - End If - - X = 255 - Y - If Button = 1 Then - clr(Index) = X - changeRGB - txtRGB(Index).Text = clr(Index) - updateAll - updateHSB - updateHex - - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - oldX = hue / 360 * 255 - oldY = 255 - sat * 255 - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - End If - -End Sub - -Private Sub picHue_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - picHue_MouseMove Button, Shift, X, Y - -End Sub - -Private Sub picHue_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - If X > 255 Then - X = 255 - ElseIf X < 0 Then - X = 0 - End If - If Y > 255 Then - Y = 255 - ElseIf Y < 0 Then - Y = 0 - End If - - X = 255 - Y - - If Button = 1 Then - hue = X / 255 * 359 - - calculateHue - changeHue - - txtHue.Text = Int(hue + 0.5) - updateAll - updateRGB - updateHex - - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - oldX = X - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - End If - -End Sub - -Private Sub calculateHue() - - On Error GoTo ErrorHandler - - If hue < 60 Then - clr(R) = bright * 255 - clr(G) = ((255 - (hue / 60 * 255)) * (1 - sat) + (hue / 60 * 255)) * bright - clr(B) = 255 * (1 - sat) * bright - ElseIf hue < 120 Then - clr(R) = ((255 - ((120 - hue) / 60 * 255)) * (1 - sat) + ((120 - hue) / 60 * 255)) * bright - clr(G) = bright * 255 - clr(B) = 255 * (1 - sat) * bright - ElseIf hue < 180 Then - clr(R) = 255 * (1 - sat) * bright - clr(G) = bright * 255 - clr(B) = ((255 - ((hue - 120) / 60 * 255)) * (1 - sat) + ((hue - 120) / 60 * 255)) * bright - ElseIf hue < 240 Then - clr(R) = 255 * (1 - sat) * bright - clr(G) = ((255 - ((240 - hue) / 60 * 255)) * (1 - sat) + ((240 - hue) / 60 * 255)) * bright - clr(B) = bright * 255 - ElseIf hue < 300 Then - clr(R) = ((255 - ((hue - 240) / 60 * 255)) * (1 - sat) + ((hue - 240) / 60 * 255)) * bright - clr(G) = 255 * (1 - sat) * bright - clr(B) = bright * 255 - ElseIf hue < 360 Then - clr(R) = bright * 255 - clr(G) = 255 * (1 - sat) * bright - clr(B) = ((255 - ((360 - hue) / 60 * 255)) * (1 - sat) + ((360 - hue) / 60 * 255)) * bright - End If - - Exit Sub - -ErrorHandler: - - MsgBox Error$ - -End Sub - -Private Sub picSat_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - picSat_MouseMove Button, Shift, X, Y - -End Sub - -Private Sub picSat_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - If X > 255 Then - X = 255 - ElseIf X < 0 Then - X = 0 - End If - If Y > 255 Then - Y = 255 - ElseIf Y < 0 Then - Y = 0 - End If - - X = 255 - Y - If Button = 1 Then - sat = X / 255 - If clr(R) = clr(G) And clr(R) = clr(B) And sat > 0 Then 'determine rgb based on hue - calculateHue - Else - clr(low) = ((1 - sat) * 255) * bright - clr(mid) = ((255 - pureClr(mid)) * (1 - sat) + pureClr(mid)) * bright - clr(high) = pureClr(high) * bright - End If - updateAll - txtSat.Text = Int(sat * 100 + 0.5) - updateRGB - updateHex - - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - oldY = 255 - X - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - End If - -End Sub - -Private Sub picBright_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - picBright_MouseMove Button, Shift, X, Y - -End Sub - -Private Sub picBright_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - If X > 255 Then - X = 255 - ElseIf X < 0 Then - X = 0 - End If - If Y > 255 Then - Y = 255 - ElseIf Y < 0 Then - Y = 0 - End If - - X = 255 - Y - If Button = 1 Then - bright = X / 255 - clr(low) = ((1 - sat) * 255) * bright - clr(mid) = ((255 - pureClr(mid)) * (1 - sat) + pureClr(mid)) * bright - clr(high) = pureClr(high) * bright - updateAll - txtBright.Text = Int(bright * 100 + 0.5) - updateRGB - updateHex - End If - -End Sub - -Private Sub changeRGB() 'when rgb modified by user - - If clr(R) = clr(G) And clr(R) = clr(B) Then - bright = clr(R) / 255 - sat = 0 - If hue < 60 Then - pureClr(R) = 255 - pureClr(G) = (hue / 60) * 255 - pureClr(B) = 0 - ElseIf hue < 120 Then - pureClr(R) = ((120 - hue) / 60) * 255 - pureClr(G) = 255 - pureClr(B) = 0 - ElseIf hue < 180 Then - pureClr(R) = 0 - pureClr(G) = 255 - pureClr(B) = ((hue - 120) / 60) * 255 - ElseIf hue < 240 Then - pureClr(R) = 0 - pureClr(G) = ((240 - hue) / 60) * 255 - pureClr(B) = 255 - ElseIf hue < 300 Then - pureClr(R) = ((hue - 240) / 60) * 255 - pureClr(G) = 0 - pureClr(B) = 255 - ElseIf hue < 360 Then - pureClr(R) = 255 - pureClr(G) = 0 - pureClr(B) = ((360 - hue) / 60) * 255 - End If - Exit Sub - End If - - 'get hue from rgb - If clr(R) >= clr(G) And clr(R) >= clr(B) Then - If clr(G) >= clr(B) Then - hue = (clr(G) - clr(B)) / (clr(R) - clr(B)) * 60 - Else - hue = 360 - (clr(B) - clr(G)) / (clr(R) - clr(G)) * 60 - End If - ElseIf clr(G) >= clr(R) And clr(G) >= clr(B) Then - If clr(R) >= clr(B) Then - hue = 120 - (clr(R) - clr(B)) / (clr(G) - clr(B)) * 60 - Else - hue = (clr(B) - clr(R)) / (clr(G) - clr(R)) * 60 + 120 - End If - ElseIf clr(B) >= clr(R) And clr(B) >= clr(G) Then - If clr(R) >= clr(G) Then - hue = (clr(R) - clr(G)) / (clr(B) - clr(G)) * 60 + 240 - Else - hue = 240 - (clr(G) - clr(R)) / (clr(B) - clr(R)) * 60 - End If - End If - - changeHue - - sat = 1 - (clr(low) / clr(high)) - bright = clr(high) / 255 - -End Sub - -Private Sub changeHue() - - If hue < 60 Then - high = R - mid = G - low = B - pureClr(R) = 255 - pureClr(G) = (hue / 60) * 255 - pureClr(B) = 0 - ElseIf hue < 120 Then - high = G - mid = R - low = B - pureClr(R) = ((120 - hue) / 60) * 255 - pureClr(G) = 255 - pureClr(B) = 0 - ElseIf hue < 180 Then - high = G - mid = B - low = R - pureClr(R) = 0 - pureClr(G) = 255 - pureClr(B) = ((hue - 120) / 60) * 255 - ElseIf hue < 240 Then - high = B - mid = G - low = R - pureClr(R) = 0 - pureClr(G) = ((240 - hue) / 60) * 255 - pureClr(B) = 255 - ElseIf hue < 300 Then - high = B - mid = R - low = G - pureClr(R) = ((hue - 240) / 60) * 255 - pureClr(G) = 0 - pureClr(B) = 255 - ElseIf hue < 360 Then - high = R - mid = B - low = G - pureClr(R) = 255 - pureClr(G) = 0 - pureClr(B) = ((360 - hue) / 60) * 255 - End If - -End Sub - -Private Sub updateAll() - - picColour.BackColor = RGB(clr(R), clr(G), clr(B)) - - imgRGB(0).Top = picRGB(0).Top + 255 - clr(0) - 7 - imgRGB(1).Top = picRGB(1).Top + 255 - clr(1) - 7 - imgRGB(2).Top = picRGB(2).Top + 255 - clr(2) - 7 - - imgHue.Top = picHue.Top + 255 - Int(hue * 256 / 360) - 7 - imgSat.Top = picSat.Top + 255 - Int(sat * 255) - 7 - imgBright.Top = picBright.Top + 255 - Int(bright * 255) - 7 - - Render - -End Sub - -Private Sub updateRGB() - - txtRGB(R).Text = clr(R) - txtRGB(G).Text = clr(G) - txtRGB(B).Text = clr(B) - -End Sub - -Private Sub updateHSB() - - txtHue.Text = Int(hue + 0.5) - txtSat.Text = Int(sat * 100 + 0.5) - txtBright.Text = Int(bright * 100 + 0.5) - -End Sub - -Private Sub updateHex() - - hexValue = RGBtoHex(RGB(clr(B), clr(G), clr(R))) - txtHexCode.Text = RGBtoHex(RGB(clr(B), clr(G), clr(R))) - -End Sub - -Private Sub Render() - - Dim i As Integer - Dim redVal As Byte, greenVal As Byte, blueVal As Byte - - For i = 0 To 255 - - picRGB(R).Line (0, 255 - i)-(16, 255 - i), RGB(i, clr(G), clr(B)) - picRGB(G).Line (0, 255 - i)-(16, 255 - i), RGB(clr(R), i, clr(B)) - picRGB(B).Line (0, 255 - i)-(16, 255 - i), RGB(clr(R), clr(G), i) - - redVal = ((255 - pureClr(R)) * (1 - i / 255) + pureClr(R)) * bright - greenVal = ((255 - pureClr(G)) * (1 - i / 255) + pureClr(G)) * bright - blueVal = ((255 - pureClr(B)) * (1 - i / 255) + pureClr(B)) * bright - picSat.Line (0, 255 - i)-(16, 255 - i), RGB(redVal, greenVal, blueVal) - - redVal = ((255 - pureClr(R)) * (1 - sat) + pureClr(R)) * (i / 255) - greenVal = ((255 - pureClr(G)) * (1 - sat) + pureClr(G)) * (i / 255) - blueVal = ((255 - pureClr(B)) * (1 - sat) + pureClr(B)) * (i / 255) - picBright.Line (0, 255 - i)-(16, 255 - i), RGB(redVal, greenVal, blueVal) - - If i <= (255 / 6) Then - redVal = bright * 255 - greenVal = ((255 - (i * 6)) * (1 - sat) + (i * 6)) * bright - blueVal = 255 * (1 - sat) * bright - ElseIf i <= (255 / 3) Then - redVal = ((255 - ((255 / 3 - i) * 6)) * (1 - sat) + ((255 / 3 - i) * 6)) * bright - greenVal = bright * 255 - blueVal = 255 * (1 - sat) * bright - ElseIf i <= (255 / 2) Then - redVal = 255 * (1 - sat) * bright - greenVal = bright * 255 - blueVal = ((255 - ((i - 255 / 3) * 6)) * (1 - sat) + ((i - 255 / 3) * 6)) * bright - ElseIf i <= (255 / 3 * 2) Then - redVal = 255 * (1 - sat) * bright - greenVal = ((255 - ((255 / 3 * 2 - i) * 6)) * (1 - sat) + ((255 / 3 * 2 - i) * 6)) * bright - blueVal = bright * 255 - ElseIf i <= (255 / 6 * 5) Then - redVal = ((255 - ((i - 255 / 3 * 2) * 6)) * (1 - sat) + ((i - 255 / 3 * 2) * 6)) * bright - greenVal = 255 * (1 - sat) * bright - blueVal = bright * 255 - ElseIf i <= 255 Then - redVal = bright * 255 - greenVal = 255 * (1 - sat) * bright - blueVal = ((255 - ((255 - i) * 6)) * (1 - sat) + ((255 - i) * 6)) * bright - End If - - picHue.Line (0, 255 - i)-(16, 255 - i), RGB(redVal, greenVal, blueVal) - - Next - - picRGB(R).Refresh - picRGB(G).Refresh - picRGB(B).Refresh - picHue.Refresh - picSat.Refresh - picBright.Refresh - -End Sub - -Private Sub txtHexCode_Change() - - Dim tempHexVal As String - - If HexToLong(txtHexCode.Text) = -1 Then - - ElseIf hexValue <> txtHexCode.Text Then - If Len(txtHexCode.Text) < 6 Then - tempHexVal = String$(6 - Len(txtHexCode.Text), "0") & txtHexCode.Text - ElseIf Len(txtHexCode.Text) > 6 Then - tempHexVal = right(txtHexCode.Text, 6) - Else - tempHexVal = txtHexCode.Text - End If - clr(B) = CLng("&H" + right(tempHexVal, 2)) - tempHexVal = left(tempHexVal, Len(tempHexVal) - 2) - clr(G) = CLng("&H" + right(tempHexVal, 2)) - tempHexVal = left(tempHexVal, Len(tempHexVal) - 2) - clr(R) = CLng("&H" + right(tempHexVal, 2)) - changeRGB - updateAll - updateRGB - updateHSB - End If - -End Sub - -Private Sub txtHexCode_LostFocus() - - If HexToLong(txtHexCode.Text) = -1 Then - txtHexCode.Text = hexValue - clr(B) = CLng("&H" + right(hexValue, 2)) - hexValue = left(hexValue, Len(hexValue) - 2) - clr(G) = CLng("&H" + right(hexValue, 2)) - hexValue = left(hexValue, Len(hexValue) - 2) - clr(R) = CLng("&H" + right(hexValue, 2)) - changeRGB - updateAll - updateRGB - updateHSB - Else - If Len(txtHexCode.Text) > 6 Then - txtHexCode.Text = right(txtHexCode.Text, 6) - ElseIf Len(txtHexCode.Text) < 6 Then - txtHexCode = String$(6 - Len(txtHexCode.Text), "0") & txtHexCode.Text - End If - hexValue = txtHexCode.Text - - End If - -End Sub - -Private Sub txtRGB_Change(Index As Integer) - - If IsNumeric(txtRGB(Index).Text) = False And txtRGB(Index).Text <> "" Then - txtRGB(Index).Text = clr(Index) - ElseIf txtRGB(Index).Text = "" Then - - ElseIf txtRGB(Index).Text >= 0 And txtRGB(Index).Text <= 255 Then - If clr(Index) <> txtRGB(Index).Text Then - clr(Index) = txtRGB(Index).Text - changeRGB - updateAll - updateHSB - updateHex - End If - End If - -End Sub - -Private Sub txtRGB_GotFocus(Index As Integer) - - SelectAllText txtRGB(Index) - -End Sub - -Private Sub txtRGB_LostFocus(Index As Integer) - - txtRGB(Index).Text = clr(Index) - -End Sub - -Private Sub txtHue_Change() - - If IsNumeric(txtHue.Text) = False And txtHue.Text <> "" Then - txtHue.Text = Int(hue + 0.5) - ElseIf txtHue.Text = "" Then - - ElseIf txtHue.Text >= 0 And txtHue.Text <= 359 Then - If Int(hue + 0.5) <> txtHue.Text Then - hue = txtHue.Text - If Not (clr(R) = clr(G) And clr(R) = clr(B)) Then - calculateHue - Else - - End If - changeHue - updateAll - updateRGB - updateHex - - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - oldX = hue / 360 * 256 - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - End If - End If - -End Sub - -Private Sub txtHue_GotFocus() - - SelectAllText txtHue - -End Sub - -Private Sub txtHue_LostFocus() - - txtHue.Text = Int(hue + 0.5) - -End Sub - -Private Sub txtSat_Change() - - If IsNumeric(txtSat.Text) = False And txtSat.Text <> "" Then - txtSat.Text = Int(sat * 100 + 0.5) - ElseIf txtSat.Text = "" Then - - ElseIf txtSat.Text >= 0 And txtSat.Text <= 100 Then - If Int(sat * 100 + 0.5) <> txtSat.Text Then - sat = txtSat.Text / 100 - clr(low) = ((1 - sat) * 255) * bright - clr(mid) = ((255 - pureClr(mid)) * (1 - sat) + pureClr(mid)) * bright - clr(high) = pureClr(high) * bright - updateAll - updateRGB - updateHex - - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - oldY = 255 - sat * 255 - picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) - End If - End If - -End Sub - -Private Sub txtSat_LostFocus() - - txtSat.Text = Int(sat * 100 + 0.5) - -End Sub - -Private Sub txtSat_GotFocus() - - SelectAllText txtSat - -End Sub - -Private Sub txtBright_Change() - - If IsNumeric(txtBright.Text) = False And txtBright.Text <> "" Then - txtBright.Text = Int(bright * 100 + 0.5) - ElseIf txtBright.Text = "" Then - - ElseIf txtBright.Text >= 0 And txtBright.Text <= 100 Then - If Int(bright * 100 + 0.5) <> txtBright.Text Then - bright = txtBright.Text / 100 - clr(low) = ((1 - sat) * 255) * bright - clr(mid) = ((255 - pureClr(mid)) * (1 - sat) + pureClr(mid)) * bright - clr(high) = pureClr(high) * bright - updateAll - updateRGB - updateHex - End If - End If - -End Sub - -Private Sub txtBright_LostFocus() - - txtBright.Text = Int(bright * 100 + 0.5) - -End Sub - -Private Sub txtBright_GotFocus() - - SelectAllText txtBright - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - -End Sub - -Private Sub picHide_Click() - - HideColour False - -End Sub - -Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub picCancel_Click() - - ok = False - HideColour False - -End Sub - -Private Sub picCancel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN - -End Sub - -Private Sub picCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE - -End Sub - -Private Sub picCancel_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picCancel, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - -End Sub - -Private Sub picOK_Click() - - ok = True - red = clr(R) - green = clr(G) - blue = clr(B) - - HideColour True - -End Sub - -Private Sub picOK_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN - -End Sub - -Private Sub picOK_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE - -End Sub - -Private Sub picOK_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picOK, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - -End Sub - -Public Sub SetColours() - - On Error Resume Next - - Dim i As Integer - Dim c As Control - - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_colourpicker.bmp") - picClr.Picture = LoadPicture(appPath & "\" & gfxDir & "\colour_picker.bmp") - - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picOK, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - mouseEvent2 picCancel, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - - imgRGB(0).Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") - imgRGB(1).Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") - imgRGB(2).Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") - imgHue.Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") - imgBright.Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") - imgSat.Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") - picClr.MouseIcon = LoadPicture(appPath & "\" & gfxDir & "\cursors\colour_picker.cur") - - - Me.BackColor = bgClr - - For i = 0 To 8 - lblClr(i).BackColor = lblBackClr - lblClr(i).ForeColor = lblTextClr - Next - - For i = 0 To 2 - txtRGB(i).BackColor = txtBackClr - txtRGB(i).ForeColor = txtTextClr - Next - - txtHue.BackColor = txtBackClr - txtHue.ForeColor = txtTextClr - txtSat.BackColor = txtBackClr - txtSat.ForeColor = txtTextClr - txtBright.BackColor = txtBackClr - txtBright.ForeColor = txtTextClr - - txtHexCode.BackColor = bgClr - txtHexCode.ForeColor = lblTextClr - - For Each c In Me.Controls - If c.Tag = "font1" Then - c.Font.Name = font1 - ElseIf c.Tag = "font2" Then - c.Font.Name = font2 - End If - Next - -End Sub +VERSION 5.00 +Begin VB.Form frmColor + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 1 'Fixed Single + ClientHeight = 5640 + ClientLeft = 15 + ClientTop = 15 + ClientWidth = 7080 + ControlBox = 0 'False + KeyPreview = -1 'True + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 376 + ScaleMode = 3 'Pixel + ScaleWidth = 472 + ShowInTaskbar = 0 'False + StartUpPosition = 3 'Windows Default + Begin VB.TextBox txtHexCode + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Left = 4440 + TabIndex = 27 + Tag = "font1" + Top = 5160 + Width = 855 + End + Begin VB.PictureBox picClr + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + DrawMode = 6 'Mask Pen Not + ForeColor = &H80000008& + Height = 3855 + Left = 240 + MousePointer = 99 'Custom + ScaleHeight = 255 + ScaleMode = 3 'Pixel + ScaleWidth = 255 + TabIndex = 23 + TabStop = 0 'False + Top = 480 + Width = 3855 + End + Begin VB.PictureBox picColor + Appearance = 0 'Flat + BackColor = &H80000005& + ForeColor = &H80000008& + Height = 960 + Left = 240 + ScaleHeight = 62 + ScaleMode = 3 'Pixel + ScaleWidth = 62 + TabIndex = 22 + TabStop = 0 'False + Top = 4440 + Width = 960 + End + Begin VB.TextBox txtRGB + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Index = 0 + Left = 3600 + MaxLength = 3 + TabIndex = 0 + Tag = "font1" + Top = 4440 + Width = 480 + End + Begin VB.TextBox txtRGB + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Index = 1 + Left = 3600 + MaxLength = 3 + TabIndex = 1 + Tag = "font1" + Top = 4800 + Width = 480 + End + Begin VB.TextBox txtRGB + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Index = 2 + Left = 3600 + MaxLength = 3 + TabIndex = 2 + Tag = "font1" + Top = 5160 + Width = 480 + End + Begin VB.TextBox txtHue + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 2160 + MaxLength = 3 + TabIndex = 3 + Tag = "font1" + Top = 4440 + Width = 480 + End + Begin VB.TextBox txtSat + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 2160 + MaxLength = 3 + TabIndex = 4 + Tag = "font1" + Top = 4800 + Width = 480 + End + Begin VB.TextBox txtBright + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 2160 + MaxLength = 3 + TabIndex = 5 + Tag = "font1" + Top = 5160 + Width = 480 + End + Begin VB.PictureBox picHue + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + ForeColor = &H80000008& + Height = 3855 + Left = 5160 + ScaleHeight = 255 + ScaleMode = 3 'Pixel + ScaleWidth = 15 + TabIndex = 15 + TabStop = 0 'False + Top = 480 + Width = 255 + End + Begin VB.PictureBox picSat + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + ForeColor = &H80000008& + Height = 3855 + Left = 4680 + ScaleHeight = 255 + ScaleMode = 3 'Pixel + ScaleWidth = 15 + TabIndex = 14 + TabStop = 0 'False + Top = 480 + Width = 255 + End + Begin VB.PictureBox picBright + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + ForeColor = &H80000008& + Height = 3855 + Left = 4200 + ScaleHeight = 255 + ScaleMode = 3 'Pixel + ScaleWidth = 15 + TabIndex = 13 + TabStop = 0 'False + Top = 480 + Width = 255 + End + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 255 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 472 + TabIndex = 11 + TabStop = 0 'False + Top = 0 + Width = 7080 + Begin VB.PictureBox picHide + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 6840 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 12 + TabStop = 0 'False + Tag = "3" + Top = 0 + Width = 240 + End + End + Begin VB.PictureBox picRGB + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + ForeColor = &H80000008& + Height = 3855 + Index = 2 + Left = 6600 + ScaleHeight = 255 + ScaleMode = 3 'Pixel + ScaleWidth = 15 + TabIndex = 10 + TabStop = 0 'False + Top = 480 + Width = 255 + End + Begin VB.PictureBox picRGB + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + ForeColor = &H80000008& + Height = 3855 + Index = 1 + Left = 6120 + ScaleHeight = 255 + ScaleMode = 3 'Pixel + ScaleWidth = 15 + TabIndex = 9 + TabStop = 0 'False + Top = 480 + Width = 255 + End + Begin VB.PictureBox picRGB + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + ForeColor = &H80000008& + Height = 3855 + Index = 0 + Left = 5640 + ScaleHeight = 255 + ScaleMode = 3 'Pixel + ScaleWidth = 15 + TabIndex = 8 + TabStop = 0 'False + Top = 480 + Width = 255 + End + Begin VB.PictureBox picCancel + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 360 + Left = 5880 + ScaleHeight = 24 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 7 + TabStop = 0 'False + Tag = "1" + Top = 5040 + Width = 960 + End + Begin VB.PictureBox picOK + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 360 + Left = 5880 + ScaleHeight = 24 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 6 + TabStop = 0 'False + Tag = "0" + Top = 4560 + Width = 960 + End + Begin VB.Label lblClr + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 8 + Left = 2640 + TabIndex = 26 + Tag = "font2" + Top = 5160 + Width = 255 + End + Begin VB.Label lblClr + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 7 + Left = 2640 + TabIndex = 25 + Tag = "font2" + Top = 4800 + Width = 255 + End + Begin VB.Label lblClr + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "�" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 6 + Left = 2640 + TabIndex = 24 + Tag = "font2" + Top = 4440 + Width = 135 + End + Begin VB.Image imgBright + Appearance = 0 'Flat + Height = 225 + Left = 4440 + Top = 480 + Width = 225 + End + Begin VB.Image imgSat + Appearance = 0 'Flat + Height = 225 + Left = 4920 + Top = 480 + Width = 225 + End + Begin VB.Image imgHue + Appearance = 0 'Flat + Height = 225 + Left = 5400 + Top = 480 + Width = 225 + End + Begin VB.Image imgRGB + Appearance = 0 'Flat + Height = 225 + Index = 2 + Left = 6840 + Top = 480 + Width = 225 + End + Begin VB.Image imgRGB + Appearance = 0 'Flat + Height = 225 + Index = 1 + Left = 6360 + Top = 480 + Width = 225 + End + Begin VB.Image imgRGB + Appearance = 0 'Flat + Height = 225 + Index = 0 + Left = 5880 + Top = 480 + Width = 225 + End + Begin VB.Label lblClr + Alignment = 1 'Right Justify + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = "R" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 3 + Left = 3240 + TabIndex = 21 + Tag = "font2" + Top = 4440 + Width = 255 + End + Begin VB.Label lblClr + Alignment = 1 'Right Justify + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = "G" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 4 + Left = 3240 + TabIndex = 20 + Tag = "font2" + Top = 4800 + Width = 255 + End + Begin VB.Label lblClr + Alignment = 1 'Right Justify + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = "B" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 5 + Left = 3240 + TabIndex = 19 + Tag = "font2" + Top = 5160 + Width = 255 + End + Begin VB.Label lblClr + Alignment = 1 'Right Justify + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = "H" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 1800 + TabIndex = 18 + Tag = "font2" + Top = 4440 + Width = 255 + End + Begin VB.Label lblClr + Alignment = 1 'Right Justify + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = "S" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 1800 + TabIndex = 17 + Tag = "font2" + Top = 4800 + Width = 255 + End + Begin VB.Label lblClr + Alignment = 1 'Right Justify + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = "B" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 1800 + TabIndex = 16 + Tag = "font2" + Top = 5160 + Width = 255 + End +End +Attribute VB_Name = "frmColor" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Public red As Byte, green As Byte, blue As Byte +Dim hue As Single, sat As Single, bright As Single +Dim low As Byte, mid As Byte, high As Byte + +Dim clr(0 To 2) As Byte +Dim pureClr(0 To 2) As Byte + +Dim oldX As Integer, oldY As Integer + +Public ok As Boolean + +Const R As Byte = 0 +Const G As Byte = 1 +Const B As Byte = 2 + +Dim tempHexVal As String +Dim hexValue As String + +Dim nonModal As Boolean + +Dim lastTool As Byte + +Public Sub InitClr(initRed As Byte, initGreen As Byte, initBlue As Byte) + + On Error GoTo ErrorHandler + + clr(R) = initRed + clr(G) = initGreen + clr(B) = initBlue + red = clr(R) + green = clr(G) + blue = clr(B) + + changeRGB + + picClr.Cls + oldX = (hue / 360 * 256) + oldY = 255 - (sat * 255) + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + + picColor.BackColor = RGB(clr(R), clr(B), clr(G)) + + updateAll + updateRGB + updateHSB + updateHex + + Exit Sub + +ErrorHandler: + + MsgBox "Error initializing color picker" & vbNewLine & Error$ + +End Sub + +Public Sub ChangeColor(ByRef pic As PictureBox, ByRef rVal As Byte, ByRef gVal As Byte, ByRef bVal As Byte, ByVal cTool As Byte) + + nonModal = True + + lastTool = frmSoldatMapEditor.setTempTool(10) + frmSoldatMapEditor.setCurrentTool 10 + + frmSoldatMapEditor.picMenuBar.Enabled = False + frmTools.Enabled = False + frmPalette.Enabled = False + frmScenery.Enabled = False + frmInfo.Enabled = False + frmWaypoints.Enabled = False + frmDisplay.picTitle.Enabled = False + + Me.Show , frmSoldatMapEditor + +End Sub + +Private Sub HideColor(apply As Boolean) + + On Error GoTo ErrorHandler + + If nonModal Then + If apply Then + frmPalette.setValues red, green, blue + frmPalette.checkPalette red, green, blue + End If + + nonModal = False + + frmSoldatMapEditor.picMenuBar.Enabled = True + + frmTools.Enabled = True + frmPalette.Enabled = True + frmScenery.Enabled = True + frmInfo.Enabled = True + frmWaypoints.Enabled = True + frmDisplay.picTitle.Enabled = True + + frmSoldatMapEditor.setCurrentTool lastTool + lastTool = 0 + + End If + + Me.Hide + frmSoldatMapEditor.RegainFocus + + Exit Sub + +ErrorHandler: + + MsgBox Error$ + +End Sub + +Private Sub Form_KeyPress(KeyAscii As Integer) + + If KeyAscii = 27 Then + picColor.SetFocus + picCancel_Click + ElseIf KeyAscii = 13 Then + picColor.SetFocus + picOK_Click + End If + +End Sub + +Private Sub Form_Load() + + On Error GoTo ErrorHandler + + Me.SetColors + + oldX = -16 + oldY = -16 + ok = False + hue = 0 + sat = 0 + bright = 0 + low = B + mid = G + high = R + pureClr(0) = 255 + pureClr(1) = 255 + pureClr(2) = 255 + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading Color Picker form" + +End Sub + +Private Sub lblRGB_Click(Index As Integer) + +End Sub + +Private Sub picClr_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + picClr_MouseMove Button, Shift, X, Y + +End Sub + +Private Sub picClr_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + Dim xVal As Integer + + If Button = 1 Then + If X > 255 Then + X = 255 + ElseIf X < 0 Then + X = 0 + End If + If Y > 255 Then + Y = 255 + ElseIf Y < 0 Then + Y = 0 + End If + + sat = (255 - Y) / 255 + hue = X / 255 * 359 + calculateHue + changeRGB + txtSat.Text = Int(sat * 100 + 0.5) + txtHue.Text = Int(hue + 0.5) + updateAll + updateRGB + updateHex + + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + oldX = X + oldY = Y + picClr.Circle (X, Y), 5.5, RGB(0, 0, 0) + End If + +End Sub + +Private Sub picRGB_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + picRGB_MouseMove Index, Button, Shift, X, Y + +End Sub + +Private Sub picRGB_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + If X > 255 Then + X = 255 + ElseIf X < 0 Then + X = 0 + End If + If Y > 255 Then + Y = 255 + ElseIf Y < 0 Then + Y = 0 + End If + + X = 255 - Y + If Button = 1 Then + clr(Index) = X + changeRGB + txtRGB(Index).Text = clr(Index) + updateAll + updateHSB + updateHex + + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + oldX = hue / 360 * 255 + oldY = 255 - sat * 255 + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + End If + +End Sub + +Private Sub picHue_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + picHue_MouseMove Button, Shift, X, Y + +End Sub + +Private Sub picHue_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + If X > 255 Then + X = 255 + ElseIf X < 0 Then + X = 0 + End If + If Y > 255 Then + Y = 255 + ElseIf Y < 0 Then + Y = 0 + End If + + X = 255 - Y + + If Button = 1 Then + hue = X / 255 * 359 + + calculateHue + changeHue + + txtHue.Text = Int(hue + 0.5) + updateAll + updateRGB + updateHex + + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + oldX = X + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + End If + +End Sub + +Private Sub calculateHue() + + On Error GoTo ErrorHandler + + If hue < 60 Then + clr(R) = bright * 255 + clr(G) = ((255 - (hue / 60 * 255)) * (1 - sat) + (hue / 60 * 255)) * bright + clr(B) = 255 * (1 - sat) * bright + ElseIf hue < 120 Then + clr(R) = ((255 - ((120 - hue) / 60 * 255)) * (1 - sat) + ((120 - hue) / 60 * 255)) * bright + clr(G) = bright * 255 + clr(B) = 255 * (1 - sat) * bright + ElseIf hue < 180 Then + clr(R) = 255 * (1 - sat) * bright + clr(G) = bright * 255 + clr(B) = ((255 - ((hue - 120) / 60 * 255)) * (1 - sat) + ((hue - 120) / 60 * 255)) * bright + ElseIf hue < 240 Then + clr(R) = 255 * (1 - sat) * bright + clr(G) = ((255 - ((240 - hue) / 60 * 255)) * (1 - sat) + ((240 - hue) / 60 * 255)) * bright + clr(B) = bright * 255 + ElseIf hue < 300 Then + clr(R) = ((255 - ((hue - 240) / 60 * 255)) * (1 - sat) + ((hue - 240) / 60 * 255)) * bright + clr(G) = 255 * (1 - sat) * bright + clr(B) = bright * 255 + ElseIf hue < 360 Then + clr(R) = bright * 255 + clr(G) = 255 * (1 - sat) * bright + clr(B) = ((255 - ((360 - hue) / 60 * 255)) * (1 - sat) + ((360 - hue) / 60 * 255)) * bright + End If + + Exit Sub + +ErrorHandler: + + MsgBox Error$ + +End Sub + +Private Sub picSat_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + picSat_MouseMove Button, Shift, X, Y + +End Sub + +Private Sub picSat_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + If X > 255 Then + X = 255 + ElseIf X < 0 Then + X = 0 + End If + If Y > 255 Then + Y = 255 + ElseIf Y < 0 Then + Y = 0 + End If + + X = 255 - Y + If Button = 1 Then + sat = X / 255 + If clr(R) = clr(G) And clr(R) = clr(B) And sat > 0 Then 'determine rgb based on hue + calculateHue + Else + clr(low) = ((1 - sat) * 255) * bright + clr(mid) = ((255 - pureClr(mid)) * (1 - sat) + pureClr(mid)) * bright + clr(high) = pureClr(high) * bright + End If + updateAll + txtSat.Text = Int(sat * 100 + 0.5) + updateRGB + updateHex + + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + oldY = 255 - X + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + End If + +End Sub + +Private Sub picBright_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + picBright_MouseMove Button, Shift, X, Y + +End Sub + +Private Sub picBright_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + If X > 255 Then + X = 255 + ElseIf X < 0 Then + X = 0 + End If + If Y > 255 Then + Y = 255 + ElseIf Y < 0 Then + Y = 0 + End If + + X = 255 - Y + If Button = 1 Then + bright = X / 255 + clr(low) = ((1 - sat) * 255) * bright + clr(mid) = ((255 - pureClr(mid)) * (1 - sat) + pureClr(mid)) * bright + clr(high) = pureClr(high) * bright + updateAll + txtBright.Text = Int(bright * 100 + 0.5) + updateRGB + updateHex + End If + +End Sub + +Private Sub changeRGB() 'when rgb modified by user + + If clr(R) = clr(G) And clr(R) = clr(B) Then + bright = clr(R) / 255 + sat = 0 + If hue < 60 Then + pureClr(R) = 255 + pureClr(G) = (hue / 60) * 255 + pureClr(B) = 0 + ElseIf hue < 120 Then + pureClr(R) = ((120 - hue) / 60) * 255 + pureClr(G) = 255 + pureClr(B) = 0 + ElseIf hue < 180 Then + pureClr(R) = 0 + pureClr(G) = 255 + pureClr(B) = ((hue - 120) / 60) * 255 + ElseIf hue < 240 Then + pureClr(R) = 0 + pureClr(G) = ((240 - hue) / 60) * 255 + pureClr(B) = 255 + ElseIf hue < 300 Then + pureClr(R) = ((hue - 240) / 60) * 255 + pureClr(G) = 0 + pureClr(B) = 255 + ElseIf hue < 360 Then + pureClr(R) = 255 + pureClr(G) = 0 + pureClr(B) = ((360 - hue) / 60) * 255 + End If + Exit Sub + End If + + 'get hue from rgb + If clr(R) >= clr(G) And clr(R) >= clr(B) Then + If clr(G) >= clr(B) Then + hue = (clr(G) - clr(B)) / (clr(R) - clr(B)) * 60 + Else + hue = 360 - (clr(B) - clr(G)) / (clr(R) - clr(G)) * 60 + End If + ElseIf clr(G) >= clr(R) And clr(G) >= clr(B) Then + If clr(R) >= clr(B) Then + hue = 120 - (clr(R) - clr(B)) / (clr(G) - clr(B)) * 60 + Else + hue = (clr(B) - clr(R)) / (clr(G) - clr(R)) * 60 + 120 + End If + ElseIf clr(B) >= clr(R) And clr(B) >= clr(G) Then + If clr(R) >= clr(G) Then + hue = (clr(R) - clr(G)) / (clr(B) - clr(G)) * 60 + 240 + Else + hue = 240 - (clr(G) - clr(R)) / (clr(B) - clr(R)) * 60 + End If + End If + + changeHue + + sat = 1 - (clr(low) / clr(high)) + bright = clr(high) / 255 + +End Sub + +Private Sub changeHue() + + If hue < 60 Then + high = R + mid = G + low = B + pureClr(R) = 255 + pureClr(G) = (hue / 60) * 255 + pureClr(B) = 0 + ElseIf hue < 120 Then + high = G + mid = R + low = B + pureClr(R) = ((120 - hue) / 60) * 255 + pureClr(G) = 255 + pureClr(B) = 0 + ElseIf hue < 180 Then + high = G + mid = B + low = R + pureClr(R) = 0 + pureClr(G) = 255 + pureClr(B) = ((hue - 120) / 60) * 255 + ElseIf hue < 240 Then + high = B + mid = G + low = R + pureClr(R) = 0 + pureClr(G) = ((240 - hue) / 60) * 255 + pureClr(B) = 255 + ElseIf hue < 300 Then + high = B + mid = R + low = G + pureClr(R) = ((hue - 240) / 60) * 255 + pureClr(G) = 0 + pureClr(B) = 255 + ElseIf hue < 360 Then + high = R + mid = B + low = G + pureClr(R) = 255 + pureClr(G) = 0 + pureClr(B) = ((360 - hue) / 60) * 255 + End If + +End Sub + +Private Sub updateAll() + + picColor.BackColor = RGB(clr(R), clr(G), clr(B)) + + imgRGB(0).Top = picRGB(0).Top + 255 - clr(0) - 7 + imgRGB(1).Top = picRGB(1).Top + 255 - clr(1) - 7 + imgRGB(2).Top = picRGB(2).Top + 255 - clr(2) - 7 + + imgHue.Top = picHue.Top + 255 - Int(hue * 256 / 360) - 7 + imgSat.Top = picSat.Top + 255 - Int(sat * 255) - 7 + imgBright.Top = picBright.Top + 255 - Int(bright * 255) - 7 + + Render + +End Sub + +Private Sub updateRGB() + + txtRGB(R).Text = clr(R) + txtRGB(G).Text = clr(G) + txtRGB(B).Text = clr(B) + +End Sub + +Private Sub updateHSB() + + txtHue.Text = Int(hue + 0.5) + txtSat.Text = Int(sat * 100 + 0.5) + txtBright.Text = Int(bright * 100 + 0.5) + +End Sub + +Private Sub updateHex() + + hexValue = RGBtoHex(RGB(clr(B), clr(G), clr(R))) + txtHexCode.Text = RGBtoHex(RGB(clr(B), clr(G), clr(R))) + +End Sub + +Private Sub Render() + + Dim i As Integer + Dim redVal As Byte, greenVal As Byte, blueVal As Byte + + For i = 0 To 255 + + picRGB(R).Line (0, 255 - i)-(16, 255 - i), RGB(i, clr(G), clr(B)) + picRGB(G).Line (0, 255 - i)-(16, 255 - i), RGB(clr(R), i, clr(B)) + picRGB(B).Line (0, 255 - i)-(16, 255 - i), RGB(clr(R), clr(G), i) + + redVal = ((255 - pureClr(R)) * (1 - i / 255) + pureClr(R)) * bright + greenVal = ((255 - pureClr(G)) * (1 - i / 255) + pureClr(G)) * bright + blueVal = ((255 - pureClr(B)) * (1 - i / 255) + pureClr(B)) * bright + picSat.Line (0, 255 - i)-(16, 255 - i), RGB(redVal, greenVal, blueVal) + + redVal = ((255 - pureClr(R)) * (1 - sat) + pureClr(R)) * (i / 255) + greenVal = ((255 - pureClr(G)) * (1 - sat) + pureClr(G)) * (i / 255) + blueVal = ((255 - pureClr(B)) * (1 - sat) + pureClr(B)) * (i / 255) + picBright.Line (0, 255 - i)-(16, 255 - i), RGB(redVal, greenVal, blueVal) + + If i <= (255 / 6) Then + redVal = bright * 255 + greenVal = ((255 - (i * 6)) * (1 - sat) + (i * 6)) * bright + blueVal = 255 * (1 - sat) * bright + ElseIf i <= (255 / 3) Then + redVal = ((255 - ((255 / 3 - i) * 6)) * (1 - sat) + ((255 / 3 - i) * 6)) * bright + greenVal = bright * 255 + blueVal = 255 * (1 - sat) * bright + ElseIf i <= (255 / 2) Then + redVal = 255 * (1 - sat) * bright + greenVal = bright * 255 + blueVal = ((255 - ((i - 255 / 3) * 6)) * (1 - sat) + ((i - 255 / 3) * 6)) * bright + ElseIf i <= (255 / 3 * 2) Then + redVal = 255 * (1 - sat) * bright + greenVal = ((255 - ((255 / 3 * 2 - i) * 6)) * (1 - sat) + ((255 / 3 * 2 - i) * 6)) * bright + blueVal = bright * 255 + ElseIf i <= (255 / 6 * 5) Then + redVal = ((255 - ((i - 255 / 3 * 2) * 6)) * (1 - sat) + ((i - 255 / 3 * 2) * 6)) * bright + greenVal = 255 * (1 - sat) * bright + blueVal = bright * 255 + ElseIf i <= 255 Then + redVal = bright * 255 + greenVal = 255 * (1 - sat) * bright + blueVal = ((255 - ((255 - i) * 6)) * (1 - sat) + ((255 - i) * 6)) * bright + End If + + picHue.Line (0, 255 - i)-(16, 255 - i), RGB(redVal, greenVal, blueVal) + + Next + + picRGB(R).Refresh + picRGB(G).Refresh + picRGB(B).Refresh + picHue.Refresh + picSat.Refresh + picBright.Refresh + +End Sub + +Private Sub txtHexCode_Change() + + Dim tempHexVal As String + + If HexToLong(txtHexCode.Text) = -1 Then + + ElseIf hexValue <> txtHexCode.Text Then + If Len(txtHexCode.Text) < 6 Then + tempHexVal = String$(6 - Len(txtHexCode.Text), "0") & txtHexCode.Text + ElseIf Len(txtHexCode.Text) > 6 Then + tempHexVal = right(txtHexCode.Text, 6) + Else + tempHexVal = txtHexCode.Text + End If + clr(B) = CLng("&H" + right(tempHexVal, 2)) + tempHexVal = left(tempHexVal, Len(tempHexVal) - 2) + clr(G) = CLng("&H" + right(tempHexVal, 2)) + tempHexVal = left(tempHexVal, Len(tempHexVal) - 2) + clr(R) = CLng("&H" + right(tempHexVal, 2)) + changeRGB + updateAll + updateRGB + updateHSB + End If + +End Sub + +Private Sub txtHexCode_LostFocus() + + If HexToLong(txtHexCode.Text) = -1 Then + txtHexCode.Text = hexValue + clr(B) = CLng("&H" + right(hexValue, 2)) + hexValue = left(hexValue, Len(hexValue) - 2) + clr(G) = CLng("&H" + right(hexValue, 2)) + hexValue = left(hexValue, Len(hexValue) - 2) + clr(R) = CLng("&H" + right(hexValue, 2)) + changeRGB + updateAll + updateRGB + updateHSB + Else + If Len(txtHexCode.Text) > 6 Then + txtHexCode.Text = right(txtHexCode.Text, 6) + ElseIf Len(txtHexCode.Text) < 6 Then + txtHexCode = String$(6 - Len(txtHexCode.Text), "0") & txtHexCode.Text + End If + hexValue = txtHexCode.Text + + End If + +End Sub + +Private Sub txtRGB_Change(Index As Integer) + + If IsNumeric(txtRGB(Index).Text) = False And txtRGB(Index).Text <> "" Then + txtRGB(Index).Text = clr(Index) + ElseIf txtRGB(Index).Text = "" Then + + ElseIf txtRGB(Index).Text >= 0 And txtRGB(Index).Text <= 255 Then + If clr(Index) <> txtRGB(Index).Text Then + clr(Index) = txtRGB(Index).Text + changeRGB + updateAll + updateHSB + updateHex + End If + End If + +End Sub + +Private Sub txtRGB_GotFocus(Index As Integer) + + SelectAllText txtRGB(Index) + +End Sub + +Private Sub txtRGB_LostFocus(Index As Integer) + + txtRGB(Index).Text = clr(Index) + +End Sub + +Private Sub txtHue_Change() + + If IsNumeric(txtHue.Text) = False And txtHue.Text <> "" Then + txtHue.Text = Int(hue + 0.5) + ElseIf txtHue.Text = "" Then + + ElseIf txtHue.Text >= 0 And txtHue.Text <= 359 Then + If Int(hue + 0.5) <> txtHue.Text Then + hue = txtHue.Text + If Not (clr(R) = clr(G) And clr(R) = clr(B)) Then + calculateHue + Else + + End If + changeHue + updateAll + updateRGB + updateHex + + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + oldX = hue / 360 * 256 + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + End If + End If + +End Sub + +Private Sub txtHue_GotFocus() + + SelectAllText txtHue + +End Sub + +Private Sub txtHue_LostFocus() + + txtHue.Text = Int(hue + 0.5) + +End Sub + +Private Sub txtSat_Change() + + If IsNumeric(txtSat.Text) = False And txtSat.Text <> "" Then + txtSat.Text = Int(sat * 100 + 0.5) + ElseIf txtSat.Text = "" Then + + ElseIf txtSat.Text >= 0 And txtSat.Text <= 100 Then + If Int(sat * 100 + 0.5) <> txtSat.Text Then + sat = txtSat.Text / 100 + clr(low) = ((1 - sat) * 255) * bright + clr(mid) = ((255 - pureClr(mid)) * (1 - sat) + pureClr(mid)) * bright + clr(high) = pureClr(high) * bright + updateAll + updateRGB + updateHex + + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + oldY = 255 - sat * 255 + picClr.Circle (oldX, oldY), 5.5, RGB(0, 0, 0) + End If + End If + +End Sub + +Private Sub txtSat_LostFocus() + + txtSat.Text = Int(sat * 100 + 0.5) + +End Sub + +Private Sub txtSat_GotFocus() + + SelectAllText txtSat + +End Sub + +Private Sub txtBright_Change() + + If IsNumeric(txtBright.Text) = False And txtBright.Text <> "" Then + txtBright.Text = Int(bright * 100 + 0.5) + ElseIf txtBright.Text = "" Then + + ElseIf txtBright.Text >= 0 And txtBright.Text <= 100 Then + If Int(bright * 100 + 0.5) <> txtBright.Text Then + bright = txtBright.Text / 100 + clr(low) = ((1 - sat) * 255) * bright + clr(mid) = ((255 - pureClr(mid)) * (1 - sat) + pureClr(mid)) * bright + clr(high) = pureClr(high) * bright + updateAll + updateRGB + updateHex + End If + End If + +End Sub + +Private Sub txtBright_LostFocus() + + txtBright.Text = Int(bright * 100 + 0.5) + +End Sub + +Private Sub txtBright_GotFocus() + + SelectAllText txtBright + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + +End Sub + +Private Sub picHide_Click() + + HideColor False + +End Sub + +Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub picCancel_Click() + + ok = False + HideColor False + +End Sub + +Private Sub picCancel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN + +End Sub + +Private Sub picCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE + +End Sub + +Private Sub picCancel_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picCancel, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + +End Sub + +Private Sub picOK_Click() + + ok = True + red = clr(R) + green = clr(G) + blue = clr(B) + + HideColor True + +End Sub + +Private Sub picOK_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN + +End Sub + +Private Sub picOK_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE + +End Sub + +Private Sub picOK_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picOK, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + Dim i As Integer + Dim c As Control + + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_colorpicker.bmp") + picClr.Picture = LoadPicture(appPath & "\" & gfxDir & "\color_picker.bmp") + + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picOK, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + mouseEvent2 picCancel, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + + imgRGB(0).Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") + imgRGB(1).Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") + imgRGB(2).Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") + imgHue.Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") + imgBright.Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") + imgSat.Picture = LoadPicture(appPath & "\" & gfxDir & "\slider_arrow.bmp") + picClr.MouseIcon = LoadPicture(appPath & "\" & gfxDir & "\cursors\color_picker.cur") + + + Me.BackColor = bgClr + + For i = 0 To 8 + lblClr(i).BackColor = lblBackClr + lblClr(i).ForeColor = lblTextClr + Next + + For i = 0 To 2 + txtRGB(i).BackColor = txtBackClr + txtRGB(i).ForeColor = txtTextClr + Next + + txtHue.BackColor = txtBackClr + txtHue.ForeColor = txtTextClr + txtSat.BackColor = txtBackClr + txtSat.ForeColor = txtTextClr + txtBright.BackColor = txtBackClr + txtBright.ForeColor = txtTextClr + + txtHexCode.BackColor = bgClr + txtHexCode.ForeColor = lblTextClr + + For Each c In Me.Controls + If c.Tag = "font1" Then + c.Font.Name = font1 + ElseIf c.Tag = "font2" Then + c.Font.Name = font2 + End If + Next + +End Sub diff --git a/frmDisplay.frm b/frmDisplay.frm index 9b2b750..9cd13db 100644 --- a/frmDisplay.frm +++ b/frmDisplay.frm @@ -541,7 +541,7 @@ Private Sub Form_Load() On Error GoTo ErrorHandler - Me.SetColours + Me.SetColors formHeight = Me.ScaleHeight @@ -665,7 +665,7 @@ Public Sub refreshButtons() End Sub -Public Sub SetColours() +Public Sub SetColors() On Error Resume Next diff --git a/frmInfo.frm b/frmInfo.frm index 6475bd6..17aa7e3 100644 --- a/frmInfo.frm +++ b/frmInfo.frm @@ -1707,7 +1707,7 @@ Private Sub Form_Load() On Error GoTo ErrorHandler - Me.SetColours + Me.SetColors formHeight = Me.ScaleHeight @@ -1786,7 +1786,7 @@ End Sub Private Sub picLight_Click() - frmSoldatMapEditor.setLightColour + frmSoldatMapEditor.setLightColor End Sub @@ -2076,7 +2076,7 @@ Private Sub picPropMenu_MouseMove(Button As Integer, Shift As Integer, X As Sing End Sub -Public Sub SetColours() +Public Sub SetColors() On Error Resume Next diff --git a/frmMap.frm b/frmMap.frm index 01f25bb..ac500b3 100644 --- a/frmMap.frm +++ b/frmMap.frm @@ -130,7 +130,7 @@ Begin VB.Form frmMap ScaleMode = 3 'Pixel ScaleWidth = 31 TabIndex = 9 - ToolTipText = "Top Background Colour" + ToolTipText = "Top Background Color" Top = 3240 Width = 495 End @@ -146,7 +146,7 @@ Begin VB.Form frmMap ScaleMode = 3 'Pixel ScaleWidth = 31 TabIndex = 8 - ToolTipText = "Bottom Background Colour" + ToolTipText = "Bottom Background Color" Top = 3840 Width = 495 End @@ -511,7 +511,7 @@ Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit -Private Type TColour +Private Type TColor red As Byte green As Byte blue As Byte @@ -577,7 +577,7 @@ Public Sub Form_Load() On Error GoTo ErrorHandler - Me.SetColours + Me.SetColors loadTextures2 @@ -723,7 +723,7 @@ End Sub Private Sub picBackClr_Click(Index As Integer) - picBackClr(Index).BackColor = frmSoldatMapEditor.setBGColour(Index + 1) + picBackClr(Index).BackColor = frmSoldatMapEditor.setBGColor(Index + 1) End Sub @@ -807,7 +807,7 @@ Private Sub txtJet_KeyPress(KeyAscii As Integer) End Sub -Public Sub SetColours() +Public Sub SetColors() On Error Resume Next diff --git a/frmPalette.frm b/frmPalette.frm index c73aa6a..73129e0 100644 --- a/frmPalette.frm +++ b/frmPalette.frm @@ -165,7 +165,7 @@ Begin VB.Form frmPalette Top = 2160 Width = 960 End - Begin VB.PictureBox picColour + Begin VB.PictureBox picColor Appearance = 0 'Flat BackColor = &H00000000& ForeColor = &H80000008& @@ -176,7 +176,7 @@ Begin VB.Form frmPalette ScaleWidth = 63 TabIndex = 7 TabStop = 0 'False - ToolTipText = "Current Colour" + ToolTipText = "Current Color" Top = 360 Width = 975 End @@ -300,7 +300,7 @@ Begin VB.Form frmPalette End Begin VB.Label lblPal BackStyle = 0 'Transparent - Caption = "Vertex Colour:" + Caption = "Vertex Color:" BeginProperty Font Name = "Arial" Size = 9.75 @@ -524,8 +524,8 @@ Begin VB.Form frmPalette Caption = "Clear" End End - Begin VB.Menu mnuNewColour - Caption = "NewColour" + Begin VB.Menu mnuNewColor + Caption = "NewColor" Visible = 0 'False Begin VB.Menu mnuAddToPalette Caption = "Add to Palette" @@ -539,13 +539,13 @@ Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit -Private Type TColour +Private Type TColor red As Byte green As Byte blue As Byte End Type -Dim clrPalette(0 To 11, 0 To 5) As TColour +Dim clrPalette(0 To 11, 0 To 5) As TColor Dim formHeight As Integer Public collapsed As Boolean @@ -601,7 +601,7 @@ Public Sub refreshPalette(R As Integer, op As Single, blend As Integer, mode As End Sub -Private Function getRGB(DecValue As Long) As TColour +Private Function getRGB(DecValue As Long) As TColor Dim hexValue As String @@ -656,11 +656,11 @@ Private Sub Form_Load() On Error GoTo ErrorHandler - Me.SetColours + Me.SetColors frmPalette.loadPalette appPath & "\palettes\current.txt" - setValues frmColour.red, frmColour.green, frmColour.blue + setValues frmColor.red, frmColor.green, frmColor.blue shpSel1.left = picPalette.ScaleWidth + 2 shpSel1.Top = picPalette.ScaleHeight + 2 @@ -841,27 +841,27 @@ End Sub Private Sub picPalette_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - If Button = 1 Then 'select colour + If Button = 1 Then 'select color xVal = Int(X / 16) yVal = Int(Y / 16) - frmSoldatMapEditor.setPaletteColour clrPalette(xVal, yVal).red, clrPalette(xVal, yVal).green, clrPalette(xVal, yVal).blue + frmSoldatMapEditor.setPaletteColor clrPalette(xVal, yVal).red, clrPalette(xVal, yVal).green, clrPalette(xVal, yVal).blue txtRGB(0).Text = clrPalette(xVal, yVal).red txtRGB(1).Text = clrPalette(xVal, yVal).green txtRGB(2).Text = clrPalette(xVal, yVal).blue - picColour.BackColor = RGB(clrPalette(xVal, yVal).red, clrPalette(xVal, yVal).green, clrPalette(xVal, yVal).blue) + picColor.BackColor = RGB(clrPalette(xVal, yVal).red, clrPalette(xVal, yVal).green, clrPalette(xVal, yVal).blue) shpSel1.left = Int(X / 16) * 16 + 1 shpSel1.Top = Int(Y / 16) * 16 + 1 shpSel2.left = Int(X / 16) * 16 shpSel2.Top = Int(Y / 16) * 16 - ElseIf Button = 2 Then 'new colour + ElseIf Button = 2 Then 'new color xVal = Int(X / 16) yVal = Int(Y / 16) - Me.PopupMenu mnuNewColour + Me.PopupMenu mnuNewColor End If @@ -869,7 +869,7 @@ Private Sub picPalette_MouseDown(Button As Integer, Shift As Integer, X As Singl End Sub -Public Sub newPaletteColour() +Public Sub newPaletteColor() clrPalette(xVal, yVal).red = txtRGB(0).Text clrPalette(xVal, yVal).green = txtRGB(1).Text @@ -884,15 +884,15 @@ End Sub Private Sub mnuAddToPalette_Click() - newPaletteColour + newPaletteColor End Sub -Private Sub picColour_Click() +Private Sub picColor_Click() - frmColour.InitClr txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text + frmColor.InitClr txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text - frmColour.ChangeColour picColour, txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text, 0 + frmColor.ChangeColor picColor, txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text, 0 End Sub @@ -935,8 +935,8 @@ Private Sub txtRGB_Change(Index As Integer) ElseIf txtRGB(Index).Text = "" Then ElseIf txtRGB(Index).Text >= 0 And txtRGB(Index).Text <= 255 Then - picColour.BackColor = RGB(txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text) - frmSoldatMapEditor.setPolyColour Index, txtRGB(Index).Text + picColor.BackColor = RGB(txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text) + frmSoldatMapEditor.setPolyColor Index, txtRGB(Index).Text End If End Sub @@ -959,12 +959,12 @@ Private Sub txtRGB_LostFocus(Index As Integer) ElseIf txtRGB(Index).Text = "" Then txtRGB(Index).Text = tempVal ElseIf txtRGB(Index).Text >= 0 And txtRGB(Index).Text <= 255 Then - frmSoldatMapEditor.setPolyColour Index, txtRGB(Index).Text + frmSoldatMapEditor.setPolyColor Index, txtRGB(Index).Text Else txtRGB(Index).Text = tempVal End If - picColour.BackColor = RGB(txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text) + picColor.BackColor = RGB(txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text) End Sub @@ -975,7 +975,7 @@ Private Sub txtOpacity_Change() ElseIf txtOpacity.Text = "" Then ElseIf txtOpacity.Text >= 0 And txtOpacity.Text <= 100 Then - frmSoldatMapEditor.setPolyColour 3, txtOpacity.Text + frmSoldatMapEditor.setPolyColor 3, txtOpacity.Text End If End Sub @@ -1008,7 +1008,7 @@ Public Sub setValues(R As Byte, G As Byte, B As Byte) txtRGB(0).Text = R txtRGB(1).Text = G txtRGB(2).Text = B - picColour.BackColor = RGB(R, G, B) + picColor.BackColor = RGB(R, G, B) shpSel1.left = picPalette.ScaleWidth + 2 shpSel1.Top = picPalette.ScaleHeight + 2 shpSel2.left = picPalette.ScaleWidth + 2 @@ -1060,7 +1060,7 @@ Private Sub picClrMode_MouseUp(Index As Integer, Button As Integer, Shift As Int End If Next - frmSoldatMapEditor.setColourMode clrMode + frmSoldatMapEditor.setColorMode clrMode frmSoldatMapEditor.RegainFocus End Sub @@ -1128,7 +1128,7 @@ Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y End Sub -Public Sub SetColours() +Public Sub SetColors() On Error Resume Next diff --git a/frmPreferences.frm b/frmPreferences.frm index 8bd15ff..1c9c675 100644 --- a/frmPreferences.frm +++ b/frmPreferences.frm @@ -1329,7 +1329,7 @@ Begin VB.Form frmPreferences Alignment = 2 'Center BackColor = &H004A3C31& BackStyle = 0 'Transparent - Caption = "Colours" + Caption = "Colors" BeginProperty Font Name = "Arial" Size = 9.75 @@ -1735,7 +1735,7 @@ Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit -Private Type TColour +Private Type TColor red As Byte green As Byte blue As Byte @@ -1743,11 +1743,11 @@ End Type Dim blendModes(0 To 7) As Integer -Dim backClr As TColour -Dim pointClr As TColour -Dim selClr As TColour -Dim gridClr As TColour -Dim gridClr2 As TColour +Dim backClr As TColor +Dim pointClr As TColor +Dim selClr As TColor +Dim gridClr As TColor +Dim gridClr2 As TColor Dim spacing As Integer, divisions As Integer Dim formWidth As Integer, formHeight As Integer @@ -1890,20 +1890,20 @@ Private Function applyPreferences() As Boolean If cboSkin.List(cboSkin.ListIndex) <> gfxDir Then gfxDir = cboSkin.List(cboSkin.ListIndex) - frmSoldatMapEditor.loadColours - frmSoldatMapEditor.SetColours + frmSoldatMapEditor.loadColors + frmSoldatMapEditor.SetColors frmSoldatMapEditor.initGfx - frmColour.SetColours - frmDisplay.SetColours - frmInfo.SetColours - frmMap.SetColours - frmPalette.SetColours - frmPreferences.SetColours - frmScenery.SetColours - frmSoldatMapEditor.SetColours - frmTexture.SetColours - frmTools.SetColours - frmWaypoints.SetColours + frmColor.SetColors + frmDisplay.SetColors + frmInfo.SetColors + frmMap.SetColors + frmPalette.SetColors + frmPreferences.SetColors + frmScenery.SetColors + frmSoldatMapEditor.SetColors + frmTexture.SetColors + frmTools.SetColors + frmWaypoints.SetColors frmDisplay.refreshButtons End If @@ -1941,7 +1941,7 @@ Private Sub Form_Load() sceneryVerts = frmSoldatMapEditor.sceneryVerts topmost = frmSoldatMapEditor.topmost - Me.SetColours + Me.SetColors blendModes(0) = 1 blendModes(1) = 2 @@ -1999,7 +1999,7 @@ Private Sub Form_Load() file = Dir$(appPath & "\*.*", vbDirectory) Do While Len(file) - If FileExists(appPath & "\" & file & "\colours.ini") Then + If FileExists(appPath & "\" & file & "\colors.ini") Then cboSkin.AddItem file If file = gfxDir Then cboSkin.ListIndex = cboSkin.ListCount - 1 End If @@ -2031,56 +2031,56 @@ End Function Private Sub picPointClr_Click() - frmColour.InitClr pointClr.red, pointClr.green, pointClr.blue - frmColour.Show 1 - picPointClr.BackColor = RGB(frmColour.red, frmColour.green, frmColour.blue) - pointClr.red = frmColour.red - pointClr.green = frmColour.green - pointClr.blue = frmColour.blue + frmColor.InitClr pointClr.red, pointClr.green, pointClr.blue + frmColor.Show 1 + picPointClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + pointClr.red = frmColor.red + pointClr.green = frmColor.green + pointClr.blue = frmColor.blue End Sub Private Sub picSelectionClr_Click() - frmColour.InitClr selClr.red, selClr.green, selClr.blue - frmColour.Show 1 - picSelectionClr.BackColor = RGB(frmColour.red, frmColour.green, frmColour.blue) - selClr.red = frmColour.red - selClr.green = frmColour.green - selClr.blue = frmColour.blue + frmColor.InitClr selClr.red, selClr.green, selClr.blue + frmColor.Show 1 + picSelectionClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + selClr.red = frmColor.red + selClr.green = frmColor.green + selClr.blue = frmColor.blue End Sub Private Sub picBackClr_Click() - frmColour.InitClr backClr.red, backClr.green, backClr.blue - frmColour.Show 1 - picBackClr.BackColor = RGB(frmColour.red, frmColour.green, frmColour.blue) - backClr.red = frmColour.red - backClr.green = frmColour.green - backClr.blue = frmColour.blue + frmColor.InitClr backClr.red, backClr.green, backClr.blue + frmColor.Show 1 + picBackClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + backClr.red = frmColor.red + backClr.green = frmColor.green + backClr.blue = frmColor.blue End Sub Private Sub picGridClr_Click() - frmColour.InitClr gridClr.red, gridClr.green, gridClr.blue - frmColour.Show 1 - picGridClr.BackColor = RGB(frmColour.red, frmColour.green, frmColour.blue) - gridClr.red = frmColour.red - gridClr.green = frmColour.green - gridClr.blue = frmColour.blue + frmColor.InitClr gridClr.red, gridClr.green, gridClr.blue + frmColor.Show 1 + picGridClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + gridClr.red = frmColor.red + gridClr.green = frmColor.green + gridClr.blue = frmColor.blue End Sub Private Sub picGridClr2_Click() - frmColour.InitClr gridClr2.red, gridClr2.green, gridClr2.blue - frmColour.Show 1 - picGridClr2.BackColor = RGB(frmColour.red, frmColour.green, frmColour.blue) - gridClr2.red = frmColour.red - gridClr2.green = frmColour.green - gridClr2.blue = frmColour.blue + frmColor.InitClr gridClr2.red, gridClr2.green, gridClr2.blue + frmColor.Show 1 + picGridClr2.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + gridClr2.red = frmColor.red + gridClr2.green = frmColor.green + gridClr2.blue = frmColor.blue End Sub @@ -2360,7 +2360,7 @@ Private Sub txtHeight_LostFocus() End Sub -Private Function getRGB(DecValue As Long) As TColour +Private Function getRGB(DecValue As Long) As TColor Dim hexValue As String @@ -2516,7 +2516,7 @@ Private Sub picTopmost_MouseUp(Button As Integer, Shift As Integer, X As Single, End Sub -Public Sub SetColours() +Public Sub SetColors() On Error Resume Next diff --git a/frmScenery.frm b/frmScenery.frm index a9be8de..11d72c3 100644 --- a/frmScenery.frm +++ b/frmScenery.frm @@ -348,7 +348,7 @@ Private Sub Form_Load() On Error GoTo ErrorHandler - Me.SetColours + Me.SetColors formHeight = Me.ScaleHeight @@ -688,7 +688,7 @@ Private Sub picLevel_MouseUp(Index As Integer, Button As Integer, Shift As Integ End Sub -Public Sub SetColours() +Public Sub SetColors() On Error Resume Next diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 3b0c5fe..626033e 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -645,8 +645,8 @@ Begin VB.Form frmSoldatMapEditor Caption = "Deselect" Shortcut = ^D End - Begin VB.Menu mnuSelColour - Caption = "Select by Colour" + Begin VB.Menu mnuSelColor + Caption = "Select by Color" Shortcut = ^B End Begin VB.Menu mnuSep5 @@ -780,7 +780,7 @@ Begin VB.Form frmSoldatMapEditor Caption = "-" End Begin VB.Menu mnuAverage - Caption = "Average Vertex Colours" + Caption = "Average Vertex Colors" Shortcut = ^G End Begin VB.Menu mnuApplyLight @@ -1285,7 +1285,7 @@ Dim backBuffer As Direct3DSurface8 Dim scenerySprite As D3DXSprite -Const ColourKey As Long = &HFF00FF00 +Const ColorKey As Long = &HFF00FF00 Const FVF As Long = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE Const FVF2 As Long = D3DFVF_XYZ @@ -1300,7 +1300,7 @@ Private Type TImageInfo depth As Integer End Type -Private Type TColour +Private Type TColor red As Byte green As Byte blue As Byte @@ -1309,7 +1309,7 @@ End Type Private Type TVertexData vertex(1 To 3) As Byte polyType As Byte - colour(1 To 3) As TColour + color(1 To 3) As TColor End Type Private Type TTriangle @@ -1318,7 +1318,7 @@ End Type Private Type TLightSource selected As Byte - colour As TColour + color As TColor intensity As Single range As Integer X As Single @@ -1501,7 +1501,7 @@ Dim maxX As Single, maxY As Single, minX As Single, minY As Single Dim bgPolys(1 To 4) As TCustomVertex Dim bgPolyCoords(1 To 4) As D3DVECTOR2 -Dim bgColours(1 To 2) As TColour +Dim bgColors(1 To 2) As TColor Const MAX_POLYS As Integer = 4000 Const MAX_ZOOM As Single = 16 @@ -1511,8 +1511,8 @@ Const TOOL_MOVE As Byte = 0 Const TOOL_CREATE As Byte = 1 Const TOOL_VSELECT As Byte = 2 Const TOOL_PSELECT As Byte = 3 -Const TOOL_VCOLOUR As Byte = 4 -Const TOOL_PCOLOUR As Byte = 5 +Const TOOL_VCOLOR As Byte = 4 +Const TOOL_PCOLOR As Byte = 5 Const TOOL_TEXTURE As Byte = 6 Const TOOL_SCENERY As Byte = 7 Const TOOL_WAYPOINT As Byte = 8 @@ -1566,7 +1566,7 @@ Public sceneryVerts As Boolean, topmost As Boolean Public formHeight As Integer, formWidth As Integer, formLeft As Integer, formTop As Integer -Dim polyClr As TColour +Dim polyClr As TColor Dim opacity As Single Dim blendMode As Integer @@ -1607,7 +1607,7 @@ Dim showWaypoints As Boolean, showPath1 As Boolean, showPath2 As Boolean Dim showSketch As Boolean, showLights As Boolean Dim currentTool As Byte, currentFunction As Byte Dim particleSize As Single -Dim colourMode As Byte +Dim colorMode As Byte Dim eraseCircle As Boolean, eraseLines As Boolean Dim polyType As Byte @@ -1652,10 +1652,10 @@ Private Sub Form_Load() loadINI loadWorkspace - loadColours + loadColors - err = "Error setting colours" - Me.SetColours + err = "Error setting colors" + Me.SetColors Me.Show err = "Error setting directories" @@ -1711,10 +1711,10 @@ Private Sub Form_Load() Colliders(0).radius = clrRadius - err = "Error initializing colour picker" + err = "Error initializing color picker" - frmColour.picClr.Cls - frmColour.InitClr polyClr.red, polyClr.green, polyClr.blue + frmColor.picClr.Cls + frmColor.InitClr polyClr.red, polyClr.green, polyClr.blue err = "Error setting current tool icon (" & currentTool & ")" @@ -1750,7 +1750,7 @@ Private Sub Form_Load() frmInfo.Visible = mnuInfo.Checked frmTexture.Visible = mnuTexture.Checked - frmPalette.refreshPalette clrRadius, opacity, blendMode, colourMode + frmPalette.refreshPalette clrRadius, opacity, blendMode, colorMode frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue frmDisplay.setLayer 0, showBG frmDisplay.setLayer 1, showPolys @@ -1831,8 +1831,8 @@ Public Sub loadCursors() ImageList.ListImages.Add TOOL_CREATE + 1, "create", LoadPicture(appPath & "\" & gfxDir & "\cursors\create.cur") ImageList.ListImages.Add TOOL_VSELECT + 1, "vselect", LoadPicture(appPath & "\" & gfxDir & "\cursors\vselect.cur") ImageList.ListImages.Add TOOL_PSELECT + 1, "pselect", LoadPicture(appPath & "\" & gfxDir & "\cursors\pselect.cur") - ImageList.ListImages.Add TOOL_VCOLOUR + 1, "vcolour", LoadPicture(appPath & "\" & gfxDir & "\cursors\vcolour.cur") - ImageList.ListImages.Add TOOL_PCOLOUR + 1, "pcolour", LoadPicture(appPath & "\" & gfxDir & "\cursors\pcolour.cur") + ImageList.ListImages.Add TOOL_VCOLOR + 1, "vcolor", LoadPicture(appPath & "\" & gfxDir & "\cursors\vcolor.cur") + ImageList.ListImages.Add TOOL_PCOLOR + 1, "pcolor", LoadPicture(appPath & "\" & gfxDir & "\cursors\pcolor.cur") ImageList.ListImages.Add TOOL_TEXTURE + 1, "texture", LoadPicture(appPath & "\" & gfxDir & "\cursors\texture.cur") ImageList.ListImages.Add TOOL_SCENERY + 1, "scenery", LoadPicture(appPath & "\" & gfxDir & "\cursors\scenery.cur") ImageList.ListImages.Add TOOL_WAYPOINT + 1, "waypoint", LoadPicture(appPath & "\" & gfxDir & "\cursors\waypoint.cur") @@ -1860,13 +1860,13 @@ Public Sub loadCursors() ImageList.ListImages.Item(TOOL_CREATE + 1).Tag = "Create Polygons" ImageList.ListImages.Item(TOOL_VSELECT + 1).Tag = "Select Vertices" ImageList.ListImages.Item(TOOL_PSELECT + 1).Tag = "Select Polygons" - ImageList.ListImages.Item(TOOL_VCOLOUR + 1).Tag = "Colour Vertices" - ImageList.ListImages.Item(TOOL_PCOLOUR + 1).Tag = "Colour Polygons" + ImageList.ListImages.Item(TOOL_VCOLOR + 1).Tag = "Color Vertices" + ImageList.ListImages.Item(TOOL_PCOLOR + 1).Tag = "Color Polygons" ImageList.ListImages.Item(TOOL_TEXTURE + 1).Tag = "Transform Texture" ImageList.ListImages.Item(TOOL_SCENERY + 1).Tag = "Create Scenery" ImageList.ListImages.Item(TOOL_WAYPOINT + 1).Tag = "Create Waypoints" ImageList.ListImages.Item(TOOL_OBJECTS + 1).Tag = "Place Spawn Points or Colliders" - ImageList.ListImages.Item(TOOL_CLRPICKER + 1).Tag = "Pick a Vertex Colour" + ImageList.ListImages.Item(TOOL_CLRPICKER + 1).Tag = "Pick a Vertex Color" ImageList.ListImages.Item(TOOL_SKETCH + 1).Tag = "Sketch" ImageList.ListImages.Item(TOOL_LIGHTS + 1).Tag = "Create Lights" ImageList.ListImages.Item(TOOL_DEPTHMAP + 1).Tag = "Edit Depth Map" @@ -1880,8 +1880,8 @@ Public Sub loadCursors() ImageList.ListImages.Item(TOOL_ROTATE + 1).Tag = "Rotate Selection" ImageList.ListImages.Item(TOOL_CONNECT + 1).Tag = "Connect Waypoints" ImageList.ListImages.Item(TOOL_QUAD + 1).Tag = "Create Quad" - ImageList.ListImages.Item(TOOL_PIXPICKER + 1).Tag = "Pick a pixel colour" - ImageList.ListImages.Item(TOOL_LITPICKER + 1).Tag = "Pick a Lit Vertex Colour" + ImageList.ListImages.Item(TOOL_PIXPICKER + 1).Tag = "Pick a pixel color" + ImageList.ListImages.Item(TOOL_LITPICKER + 1).Tag = "Pick a Lit Vertex Color" ImageList.ListImages.Item(TOOL_ERASER + 1).Tag = "Erase Lines" ImageList.ListImages.Item(TOOL_SMUDGE + 1).Tag = "Move Lines" @@ -1997,7 +1997,7 @@ Public Sub Init() '---- Set objectsTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\objects.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, _ - D3DX_FILTER_POINT, ColourKey, ByVal 0, ByVal 0) + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) objectsTexture.GetLevelDesc 0, textureDesc @@ -2010,7 +2010,7 @@ Public Sub Init() Set SceneryTextures(0).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, ByVal 0, ByVal 0) + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) SceneryTextures(0).Texture.GetLevelDesc 0, textureDesc @@ -2029,25 +2029,25 @@ Public Sub Init() Set lineTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\lines.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, ByVal 0, ByVal 0) + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) debugVal = "Error creating path texture" Set pathTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\path.png", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, ByVal 0, ByVal 0) + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) debugVal = "Error creating rotation center texture" Set rCenterTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\rcenter.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, ByVal 0, ByVal 0) + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) debugVal = "Error creating sketch texture" Set sketchTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\sketch.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, ByVal 0, ByVal 0) + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) debugVal = "Error creating scenery sprite" @@ -2057,7 +2057,7 @@ Public Sub Init() Set particleTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\vertex8x8.bmp", 8, 8, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, ByVal 0, ByVal 0) + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) initialized = True @@ -2271,18 +2271,18 @@ Public Sub newMap() sketchLines = 0 ReDim Preserve sketch(0) - bgColours(1) = makeColour(224, 224, 224) - bgColours(2) = makeColour(32, 32, 32) + bgColors(1) = makeColor(224, 224, 224) + bgColors(2) = makeColor(32, 32, 32) maxX = 0 maxY = 0 minX = 0 minY = 0 - bgPolys(1) = CreateCustomVertex(-640, -640, 1, 1, RGB(bgColours(1).blue, bgColours(1).green, bgColours(1).red), 0, 0) - bgPolys(2) = CreateCustomVertex(-640, 640, 1, 1, RGB(bgColours(2).blue, bgColours(2).green, bgColours(2).red), 0, 0) - bgPolys(3) = CreateCustomVertex(640, -640, 1, 1, RGB(bgColours(1).blue, bgColours(1).green, bgColours(1).red), 0, 0) - bgPolys(4) = CreateCustomVertex(640, 640, 1, 1, RGB(bgColours(2).blue, bgColours(2).green, bgColours(2).red), 0, 0) + bgPolys(1) = CreateCustomVertex(-640, -640, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 0, 0) + bgPolys(2) = CreateCustomVertex(-640, 640, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 0, 0) + bgPolys(3) = CreateCustomVertex(640, -640, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 0, 0) + bgPolys(4) = CreateCustomVertex(640, 640, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 0, 0) For i = 1 To 4 bgPolyCoords(i).X = bgPolys(i).X @@ -2401,7 +2401,7 @@ Public Sub LoadFile(FileName As String) For j = 1 To 3 PolyCoords(i).vertex(j).X = Polys(i).vertex(j).X PolyCoords(i).vertex(j).Y = Polys(i).vertex(j).Y - vertexList(i).colour(j) = getRGB(Polys(i).vertex(j).Color) + vertexList(i).color(j) = getRGB(Polys(i).vertex(j).Color) If PolyCoords(i).vertex(j).X > maxX Then maxX = PolyCoords(i).vertex(j).X If PolyCoords(i).vertex(j).X < minX Then minX = PolyCoords(i).vertex(j).X If PolyCoords(i).vertex(j).Y > maxY Then maxY = PolyCoords(i).vertex(j).Y @@ -2505,7 +2505,7 @@ Public Sub LoadFile(FileName As String) If tempString = "" Then Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) frmScenery.lstScenery.AddItem tempString tvwScenery.Nodes.Add "In Use", tvwChild, tempString, tempString ElseIf checkLoaded(tempString) > -1 Then @@ -2519,11 +2519,11 @@ Public Sub LoadFile(FileName As String) If toTGARes = -1 Then Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) Else Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) End If frmScenery.lstScenery.AddItem tempString @@ -2539,18 +2539,18 @@ Public Sub LoadFile(FileName As String) If toTGARes = -1 Then Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) Else Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) End If frmScenery.lstScenery.AddItem tempString tvwScenery.Nodes.Add "In Use", tvwChild, tempString, tempString Else Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) frmScenery.lstScenery.AddItem tempString tvwScenery.Nodes.Add "In Use", tvwChild, tempString, tempString End If @@ -2699,15 +2699,15 @@ Public Sub LoadFile(FileName As String) mapTitle = mapTitle + Chr$(Options.mapName(i)) Next - 'get background colours - bgColours(1) = getRGB(Options.BackgroundColor) - bgColours(2) = getRGB(Options.BackgroundColor2) + 'get background colors + bgColors(1) = getRGB(Options.BackgroundColor) + bgColors(2) = getRGB(Options.BackgroundColor2) - 'set background poly colours - bgPolys(1) = CreateCustomVertex(-maxX - 640, -maxX - 640, 1, 1, RGB(bgColours(1).blue, bgColours(1).green, bgColours(1).red), 0, 0) - bgPolys(2) = CreateCustomVertex(-maxX, maxX, 1, 1, RGB(bgColours(2).blue, bgColours(2).green, bgColours(2).red), 0, 1) - bgPolys(3) = CreateCustomVertex(maxX, -maxX, 1, 1, RGB(bgColours(1).blue, bgColours(1).green, bgColours(1).red), 1, 0) - bgPolys(4) = CreateCustomVertex(maxX, maxX, 1, 1, RGB(bgColours(2).blue, bgColours(2).green, bgColours(2).red), 1, 1) + 'set background poly colors + bgPolys(1) = CreateCustomVertex(-maxX - 640, -maxX - 640, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 0, 0) + bgPolys(2) = CreateCustomVertex(-maxX, maxX, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 0, 1) + bgPolys(3) = CreateCustomVertex(maxX, -maxX, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 1, 0) + bgPolys(4) = CreateCustomVertex(maxX, maxX, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 1, 1) If (maxX - minX) > (maxY - minY) Then bgPolys(1).X = minX - 640 @@ -2877,11 +2877,11 @@ Public Sub setCurrentTexture(sceneryName As String) If toTGARes = -1 Then Set SceneryTextures(0).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) Else Set SceneryTextures(0).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) End If SceneryTextures(0).Texture.GetLevelDesc 0, textureDesc @@ -2933,11 +2933,11 @@ Public Sub CreateSceneryTexture(sceneryName As String) If toTGARes = -1 Then Set SceneryTextures(sceneryElements).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) Else Set SceneryTextures(sceneryElements).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) End If frmScenery.lstScenery.AddItem sceneryName @@ -2986,11 +2986,11 @@ Public Sub RefreshSceneryTextures(Index As Integer) If toTGARes = -1 Then Set SceneryTextures(Index).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) Else Set SceneryTextures(Index).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) End If SceneryTextures(Index).Texture.GetLevelDesc 0, textureDesc @@ -3032,7 +3032,7 @@ Private Sub SaveFile(FileName As String) Dim sceneryName As String Dim Prop As TProp Dim spawn As TSaveSpawnPoint - Dim tempClr As TColour + Dim tempClr As TColor Dim connectedNum As Integer Dim fileOpen As Boolean @@ -3045,8 +3045,8 @@ Private Sub SaveFile(FileName As String) mapWidth = maxX - minX mapHeight = maxY - minY - Options.BackgroundColor = ARGB(255, RGB(bgColours(1).blue, bgColours(1).green, bgColours(1).red)) - Options.BackgroundColor2 = ARGB(255, RGB(bgColours(2).blue, bgColours(2).green, bgColours(2).red)) + Options.BackgroundColor = ARGB(255, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red)) + Options.BackgroundColor2 = ARGB(255, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red)) 'set texture name Options.textureName(0) = Len(textureFile) For i = 1 To Len(textureFile) @@ -3085,7 +3085,7 @@ Private Sub SaveFile(FileName As String) Polygon.Poly.vertex(j).X = PolyCoords(i).vertex(j).X Polygon.Poly.vertex(j).Y = PolyCoords(i).vertex(j).Y - Polygon.Poly.vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).colour(j).blue, vertexList(i).colour(j).green, vertexList(i).colour(j).red)) + Polygon.Poly.vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) VertNum = j + 1 If VertNum > 3 Then VertNum = 1 @@ -3260,7 +3260,7 @@ Public Sub SaveAndCompile(FileName As String) Dim newWaypoint As TNewWaypoint Dim sceneryName As String Dim Prop As TProp - Dim tempClr As TColour + Dim tempClr As TColor Dim connectedNum As Integer Dim newSpawnPoint As TSaveSpawnPoint @@ -3293,8 +3293,8 @@ Public Sub SaveAndCompile(FileName As String) mapWidth = maxX - xOffset mapHeight = maxY - yOffset - Options.BackgroundColor = ARGB(255, RGB(bgColours(1).blue, bgColours(1).green, bgColours(1).red)) - Options.BackgroundColor2 = ARGB(255, RGB(bgColours(2).blue, bgColours(2).green, bgColours(2).red)) + Options.BackgroundColor = ARGB(255, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red)) + Options.BackgroundColor2 = ARGB(255, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red)) 'set texture name Options.textureName(0) = Len(textureFile) If Options.textureName(0) > 24 Then Options.textureName(0) = 24 @@ -4411,7 +4411,7 @@ Public Sub Render() End If 'draw selected polys - If numSelectedPolys > 0 And showPolys And Not (currentTool = TOOL_TEXTURE Or currentTool = TOOL_VCOLOUR Or currentTool = TOOL_PCOLOUR) Then + If numSelectedPolys > 0 And showPolys And Not (currentTool = TOOL_TEXTURE Or currentTool = TOOL_VCOLOR Or currentTool = TOOL_PCOLOR) Then D3DDevice.setTexture 0, patternTexture D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE @@ -4592,7 +4592,7 @@ Public Sub Render() srcRect.right = srcRect.left + (objTexSize.X / 8) srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) For i = 1 To lightCount - objClr = ARGB(255, RGB(Lights(i).colour.blue, Lights(i).colour.green, Lights(i).colour.red)) + objClr = ARGB(255, RGB(Lights(i).color.blue, Lights(i).color.green, Lights(i).color.red)) sc.X = 32 / (objTexSize.X / 8) sc.Y = 32 / (objTexSize.Y / 4) tr.X = Int((Lights(i).X - scrollCoords(2).X) * zoomFactor - 16 * sc.X + 0.5) @@ -5107,7 +5107,7 @@ ErrorHandler: End Sub -Private Function getRGB(DecValue As Long) As TColour +Private Function getRGB(DecValue As Long) As TColor Dim hexValue As String @@ -5125,11 +5125,11 @@ Private Function getRGB(DecValue As Long) As TColour End Function -Private Function getAlpha(tehColour As Long) As Byte +Private Function getAlpha(tehColor As Long) As Byte Dim hexValue As String - hexValue = Hex$(Val(tehColour)) + hexValue = Hex$(Val(tehColor)) If Len(hexValue) <= 6 Then getAlpha = 0 @@ -5161,11 +5161,11 @@ Private Function ARGB(ByVal alphaVal As Byte, clrVal As Long) As Long End Function -Private Function makeColour(red As Byte, green As Byte, blue As Byte) As TColour +Private Function makeColor(red As Byte, green As Byte, blue As Byte) As TColor - makeColour.red = red - makeColour.green = green - makeColour.blue = blue + makeColor.red = red + makeColor.green = green + makeColor.blue = blue End Function @@ -5265,9 +5265,9 @@ Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) currentFunction = TOOL_VSELSUB Case Is = TOOL_PSELECT 'subtract polys currentFunction = TOOL_PSELSUB - Case Is = TOOL_VCOLOUR 'colour picker + Case Is = TOOL_VCOLOR 'color picker currentFunction = TOOL_CLRPICKER - Case Is = TOOL_PCOLOUR 'colour picker + Case Is = TOOL_PCOLOR 'color picker currentFunction = TOOL_CLRPICKER Case Is = TOOL_DEPTHMAP currentFunction = TOOL_CLRPICKER @@ -5280,7 +5280,7 @@ Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) currentFunction = TOOL_VSELECT End Select If currentFunction = TOOL_TEXTURE Then toolAction = False - If currentFunction = TOOL_VCOLOUR Or currentFunction = TOOL_DEPTHMAP Then circleOn = True + If currentFunction = TOOL_VCOLOR Or currentFunction = TOOL_DEPTHMAP Then circleOn = True Render SetCursor currentFunction + 1 lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag @@ -5332,7 +5332,7 @@ Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) Spawns(0).Y = mouseCoords.Y ElseIf currentTool = TOOL_DEPTHMAP Then circleOn = True - ElseIf currentTool = TOOL_VCOLOUR Then + ElseIf currentTool = TOOL_VCOLOR Then circleOn = True ElseIf currentTool = TOOL_SKETCH Then circleOn = False @@ -5353,7 +5353,7 @@ Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) Spawns(0).Y = mouseCoords.Y ElseIf currentTool = TOOL_DEPTHMAP Then circleOn = True - ElseIf currentTool = TOOL_VCOLOUR Then + ElseIf currentTool = TOOL_VCOLOR Then circleOn = True ElseIf currentTool = TOOL_SKETCH Then circleOn = False @@ -5405,7 +5405,7 @@ Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) ElseIf DIState.Key(MapVirtualKey(73, 0)) = 128 Then 'ctrl+i mnuInvertSel_Click ElseIf DIState.Key(MapVirtualKey(66, 0)) = 128 Then 'ctrl+b - mnuSelColour_Click + mnuSelColor_Click ElseIf DIState.Key(MapVirtualKey(74, 0)) = 128 Then 'ctrl+j mnuJoinVertices_Click ElseIf DIState.Key(MapVirtualKey(85, 0)) = 128 Then 'ctrl+u @@ -5852,7 +5852,7 @@ Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y A polySelection X, Y - ElseIf currentFunction = TOOL_VCOLOUR Then 'vertex colour + ElseIf currentFunction = TOOL_VCOLOR Then 'vertex color If selectionChanged Then SaveUndo @@ -5860,20 +5860,20 @@ Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y A End If toolAction = True - If colourMode > 0 Then - VertexColouring X, Y + If colorMode > 0 Then + VertexColoring X, Y Else - PrecisionColouring X, Y + PrecisionColoring X, Y End If - ElseIf currentFunction = TOOL_PCOLOUR Then 'poly colour + ElseIf currentFunction = TOOL_PCOLOR Then 'poly color If selectionChanged Then SaveUndo selectionChanged = False End If - ColourFill X, Y + ColorFill X, Y ElseIf currentFunction = TOOL_TEXTURE Then 'texture @@ -5906,21 +5906,21 @@ Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y A End If toolAction = True - ElseIf currentFunction = TOOL_CLRPICKER Then 'colour picker + ElseIf currentFunction = TOOL_CLRPICKER Then 'color picker If currentTool = TOOL_DEPTHMAP Then depthPicker X, Y ElseIf currentTool = TOOL_SCENERY Then Else - ColourPicker X, Y + ColorPicker X, Y End If ElseIf currentFunction = TOOL_PIXPICKER Then - Dim tempClr As TColour + Dim tempClr As TColor tempClr = getRGB(GetPixel(Me.hDC, X, Y)) If frmPalette.Enabled = False Then - frmColour.InitClr tempClr.blue, tempClr.green, tempClr.red + frmColor.InitClr tempClr.blue, tempClr.green, tempClr.red Else polyClr.red = tempClr.blue polyClr.green = tempClr.green @@ -6095,7 +6095,7 @@ Private Sub CreateLight(X As Single, Y As Single) Lights(lightCount).X = X / zoomFactor + scrollCoords(2).X Lights(lightCount).Y = Y / zoomFactor + scrollCoords(2).Y Lights(lightCount).z = 255 - Lights(lightCount).colour = polyClr + Lights(lightCount).color = polyClr Lights(lightCount).intensity = opacity Lights(lightCount).range = 0 @@ -6121,7 +6121,7 @@ Private Sub applyLights(Optional toSel As Boolean = False) Dim diffuseFactor As Single Dim totalDiffuse As Single - Dim clr As TColour + Dim clr As TColor Dim rVal As Integer, gVal As Integer, bVal As Integer @@ -6186,10 +6186,10 @@ Private Sub applyLights(Optional toSel As Boolean = False) End If End If - 'calculate final colour components - rVal = rVal + (Lights(k).colour.red * diffuseFactor) * mag - gVal = gVal + (Lights(k).colour.green * diffuseFactor) * mag - bVal = bVal + (Lights(k).colour.blue * diffuseFactor) * mag + 'calculate final color components + rVal = rVal + (Lights(k).color.red * diffuseFactor) * mag + gVal = gVal + (Lights(k).color.green * diffuseFactor) * mag + bVal = bVal + (Lights(k).color.blue * diffuseFactor) * mag totalDiffuse = totalDiffuse + diffuseFactor @@ -6197,7 +6197,7 @@ Private Sub applyLights(Optional toSel As Boolean = False) totalDiffuse = totalDiffuse / lightCount - clr = vertexList(i).colour(j) + clr = vertexList(i).color(j) rVal = rVal + clr.red gVal = gVal + clr.green bVal = bVal + clr.blue @@ -6236,7 +6236,7 @@ Private Sub applyLightsToVert(pIndex As Integer, vIndex As Integer) Dim mag As Single Dim diffuseFactor As Single Dim totalDiffuse As Single - Dim clr As TColour + Dim clr As TColor Dim rVal As Integer, gVal As Integer, bVal As Integer 'get poly vectors @@ -6278,10 +6278,10 @@ Private Sub applyLightsToVert(pIndex As Integer, vIndex As Integer) diffuseFactor = (polyNormal.X * lightDir.X) + (polyNormal.Y * lightDir.Y) + (polyNormal.z * lightDir.z) If diffuseFactor < 0 Then diffuseFactor = 0 - 'calculate final colour components - rVal = rVal + (Lights(k).colour.red * diffuseFactor) - gVal = gVal + (Lights(k).colour.green * diffuseFactor) - bVal = bVal + (Lights(k).colour.blue * diffuseFactor) + 'calculate final color components + rVal = rVal + (Lights(k).color.red * diffuseFactor) + gVal = gVal + (Lights(k).color.green * diffuseFactor) + bVal = bVal + (Lights(k).color.blue * diffuseFactor) totalDiffuse = totalDiffuse + diffuseFactor @@ -6289,7 +6289,7 @@ Private Sub applyLightsToVert(pIndex As Integer, vIndex As Integer) totalDiffuse = totalDiffuse / lightCount - clr = vertexList(pIndex).colour(vIndex) + clr = vertexList(pIndex).color(vIndex) rVal = rVal + clr.red gVal = gVal + clr.green bVal = bVal + clr.blue @@ -6380,7 +6380,7 @@ Private Sub AverageVerts() Dim i As Integer, j As Integer Dim finalR As Integer, finalG As Integer, finalB As Integer - Dim tehClr As TColour + Dim tehClr As TColor For i = 1 To numSelectedPolys For j = 1 To 3 @@ -6412,7 +6412,7 @@ Private Sub AverageVertices() Dim i As Integer, j As Integer Dim P As Integer, V As Integer Dim finalR As Integer, finalG As Integer, finalB As Integer - Dim tehClr As TColour, vertexClr As TColour + Dim tehClr As TColor, vertexClr As TColor Dim numVertices As Integer Dim xVal As Single, yVal As Single Dim connectedPolys() As Integer @@ -6441,9 +6441,9 @@ Private Sub AverageVertices() For V = 1 To 3 If nearCoord(xVal, PolyCoords(P).vertex(V).X, 2) And nearCoord(yVal, PolyCoords(P).vertex(V).Y, 2) Then vertexList(P).vertex(V) = 1 - tehClr.red = vertexList(P).colour(V).red - tehClr.green = vertexList(P).colour(V).green - tehClr.blue = vertexList(P).colour(V).blue + tehClr.red = vertexList(P).color(V).red + tehClr.green = vertexList(P).color(V).green + tehClr.blue = vertexList(P).color(V).blue finalR = finalR + tehClr.red finalG = finalG + tehClr.green finalB = finalB + tehClr.blue @@ -6461,9 +6461,9 @@ Private Sub AverageVertices() For V = 1 To 3 If vertexList(connectedPolys(P)).vertex(V) = 1 Then vertexList(connectedPolys(P)).vertex(V) = 2 - vertexList(connectedPolys(P)).colour(V).red = finalR - vertexList(connectedPolys(P)).colour(V).green = finalG - vertexList(connectedPolys(P)).colour(V).blue = finalB + vertexList(connectedPolys(P)).color(V).red = finalR + vertexList(connectedPolys(P)).color(V).green = finalG + vertexList(connectedPolys(P)).color(V).blue = finalB Polys(connectedPolys(P)).vertex(V).Color = ARGB(getAlpha(Polys(connectedPolys(P)).vertex(V).Color), RGB(finalB, finalG, finalR)) End If Next @@ -6497,9 +6497,9 @@ Private Sub AverageVertices() If nearCoord(xVal, PolyCoords(P).vertex(V).X, 2) And nearCoord(yVal, PolyCoords(P).vertex(V).Y, 2) Then If vertexList(P).vertex(V) = 1 Then vertexList(P).vertex(V) = 2 - tehClr.red = vertexList(P).colour(V).red - tehClr.green = vertexList(P).colour(V).green - tehClr.blue = vertexList(P).colour(V).blue + tehClr.red = vertexList(P).color(V).red + tehClr.green = vertexList(P).color(V).green + tehClr.blue = vertexList(P).color(V).blue finalR = finalR + tehClr.red finalG = finalG + tehClr.green finalB = finalB + tehClr.blue @@ -6517,9 +6517,9 @@ Private Sub AverageVertices() For V = 1 To 3 If vertexList(connectedPolys(P)).vertex(V) = 2 Then vertexList(connectedPolys(P)).vertex(V) = 3 - vertexList(connectedPolys(P)).colour(V).red = finalR - vertexList(connectedPolys(P)).colour(V).green = finalG - vertexList(connectedPolys(P)).colour(V).blue = finalB + vertexList(connectedPolys(P)).color(V).red = finalR + vertexList(connectedPolys(P)).color(V).green = finalG + vertexList(connectedPolys(P)).color(V).blue = finalB Polys(connectedPolys(P)).vertex(V).Color = ARGB(getAlpha(Polys(connectedPolys(P)).vertex(V).Color), RGB(finalB, finalG, finalR)) End If Next @@ -6555,7 +6555,7 @@ Private Sub AverageVertices() ErrorHandler: - MsgBox "Error averaging colours" & vbNewLine & Error$ + MsgBox "Error averaging colors" & vbNewLine & Error$ End Sub @@ -6867,13 +6867,13 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A ElseIf currentFunction = TOOL_PSELECT And toolAction Then 'poly selection - ElseIf currentFunction = TOOL_VCOLOUR And toolAction Then ' vertex colouring + ElseIf currentFunction = TOOL_VCOLOR And toolAction Then ' vertex coloring - If colourMode > 0 Then - VertexColouring X, Y + If colorMode > 0 Then + VertexColoring X, Y End If - ElseIf currentFunction = TOOL_PCOLOUR Then 'poly colouring + ElseIf currentFunction = TOOL_PCOLOR Then 'poly coloring ElseIf currentFunction = TOOL_TEXTURE And toolAction Then 'texture @@ -6890,22 +6890,22 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A ElseIf currentFunction = TOOL_SCENERY Then 'scenery - ElseIf currentFunction = TOOL_CLRPICKER Then 'colour picker + ElseIf currentFunction = TOOL_CLRPICKER Then 'color picker If currentTool = TOOL_DEPTHMAP Then depthPicker X, Y ElseIf currentTool = TOOL_SCENERY Then Else - ColourPicker X, Y + ColorPicker X, Y End If ElseIf currentFunction = TOOL_PIXPICKER Then 'pixel picker - Dim tempClr As TColour + Dim tempClr As TColor tempClr = getRGB(GetPixel(Me.hDC, X, Y)) If frmPalette.Enabled = False Then - frmColour.InitClr tempClr.blue, tempClr.green, tempClr.red + frmColor.InitClr tempClr.blue, tempClr.green, tempClr.red Else polyClr.red = tempClr.blue polyClr.green = tempClr.green @@ -7288,7 +7288,7 @@ Private Sub ApplyTransform(Rotating As Boolean) Dim xVal As Single, yVal As Single Dim angle As Single, theta As Single Dim R As Single - Dim tempClr As TColour + Dim tempClr As TColor If selectionChanged Then SaveUndo @@ -7317,9 +7317,9 @@ Private Sub ApplyTransform(Rotating As Boolean) vertexList(pNum).vertex(3) = vertexList(pNum).vertex(2) vertexList(pNum).vertex(2) = vertSel - tempClr = vertexList(pNum).colour(3) - vertexList(pNum).colour(3) = vertexList(pNum).colour(2) - vertexList(pNum).colour(2) = tempClr + tempClr = vertexList(pNum).color(3) + vertexList(pNum).color(3) = vertexList(pNum).color(2) + vertexList(pNum).color(2) = tempClr End If End If Next @@ -7800,13 +7800,13 @@ Private Sub Rotating(X As Single, Y As Single, constrained As Boolean) End Sub -Private Sub PrecisionColouring(X As Single, Y As Single) +Private Sub PrecisionColoring(X As Single, Y As Single) Dim i As Integer, j As Integer Dim closestPoly As Single, closestVert As Single Dim currentDist As Long, shortestDist As Long Dim PolyNum As Integer - Dim destClr As TColour + Dim destClr As TColor Dim R As Integer R = clrRadius * zoomFactor @@ -7834,9 +7834,9 @@ Private Sub PrecisionColouring(X As Single, Y As Single) destClr = getRGB(Polys(closestPoly).vertex(closestVert).Color) destClr = applyBlend(destClr) Polys(closestPoly).vertex(closestVert).Color = ARGB(getAlpha(Polys(closestPoly).vertex(closestVert).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(closestPoly).colour(closestVert).red = destClr.red - vertexList(closestPoly).colour(closestVert).green = destClr.green - vertexList(closestPoly).colour(closestVert).blue = destClr.blue + vertexList(closestPoly).color(closestVert).red = destClr.red + vertexList(closestPoly).color(closestVert).green = destClr.green + vertexList(closestPoly).color(closestVert).blue = destClr.blue End If Else @@ -7860,9 +7860,9 @@ Private Sub PrecisionColouring(X As Single, Y As Single) destClr = getRGB(Polys(closestPoly).vertex(closestVert).Color) destClr = applyBlend(destClr) Polys(closestPoly).vertex(closestVert).Color = ARGB(getAlpha(Polys(closestPoly).vertex(closestVert).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(closestPoly).colour(closestVert).red = destClr.red - vertexList(closestPoly).colour(closestVert).green = destClr.green - vertexList(closestPoly).colour(closestVert).blue = destClr.blue + vertexList(closestPoly).color(closestVert).red = destClr.red + vertexList(closestPoly).color(closestVert).green = destClr.green + vertexList(closestPoly).color(closestVert).blue = destClr.blue End If End If @@ -7873,13 +7873,13 @@ Private Sub PrecisionColouring(X As Single, Y As Single) End Sub -Private Sub VertexColouring(X As Single, Y As Single) +Private Sub VertexColoring(X As Single, Y As Single) Dim i As Integer, j As Integer Dim pNum As Integer - Dim destClr As TColour + Dim destClr As TColor Dim R As Integer - Dim coloured As Boolean + Dim colored As Boolean R = clrRadius * zoomFactor @@ -7894,12 +7894,12 @@ Private Sub VertexColouring(X As Single, Y As Single) destClr = getRGB(Polys(pNum).vertex(j).Color) destClr = applyBlend(destClr) Polys(pNum).vertex(j).Color = ARGB(getAlpha(Polys(pNum).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(pNum).colour(j).red = destClr.red - vertexList(pNum).colour(j).green = destClr.green - vertexList(pNum).colour(j).blue = destClr.blue + vertexList(pNum).color(j).red = destClr.red + vertexList(pNum).color(j).green = destClr.green + vertexList(pNum).color(j).blue = destClr.blue If lightCount > 0 Then applyLightsToVert pNum, j - If colourMode = 1 Then vertexList(pNum).vertex(j) = 3 - coloured = True + If colorMode = 1 Then vertexList(pNum).vertex(j) = 3 + colored = True End If End If End If @@ -7916,12 +7916,12 @@ Private Sub VertexColouring(X As Single, Y As Single) destClr = getRGB(Polys(i).vertex(j).Color) destClr = applyBlend(destClr) Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(i).colour(j).red = destClr.red - vertexList(i).colour(j).green = destClr.green - vertexList(i).colour(j).blue = destClr.blue + vertexList(i).color(j).red = destClr.red + vertexList(i).color(j).green = destClr.green + vertexList(i).color(j).blue = destClr.blue If lightCount > 0 Then applyLightsToVert i, j - If colourMode = 1 Then vertexList(i).vertex(j) = 2 - coloured = True + If colorMode = 1 Then vertexList(i).vertex(j) = 2 + colored = True End If End If End If @@ -7939,8 +7939,8 @@ Private Sub VertexColouring(X As Single, Y As Single) destClr = getRGB(Scenery(i).Color) destClr = applyBlend(destClr) Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) - If colourMode = 1 Then Scenery(i).selected = 3 - coloured = True + If colorMode = 1 Then Scenery(i).selected = 3 + colored = True End If End If End If @@ -7955,8 +7955,8 @@ Private Sub VertexColouring(X As Single, Y As Single) destClr = getRGB(Scenery(i).Color) destClr = applyBlend(destClr) Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) - If colourMode = 1 Then Scenery(i).selected = 2 - coloured = True + If colorMode = 1 Then Scenery(i).selected = 2 + colored = True End If End If End If @@ -7964,7 +7964,7 @@ Private Sub VertexColouring(X As Single, Y As Single) End If - If coloured Then + If colored Then prompt = True Render End If @@ -7975,7 +7975,7 @@ Private Sub EditDepthMap(X As Single, Y As Single) Dim i As Integer, j As Integer Dim pNum As Integer - Dim destClr As TColour + Dim destClr As TColor Dim R As Integer Dim edited As Boolean @@ -7990,7 +7990,7 @@ Private Sub EditDepthMap(X As Single, Y As Single) If nearCoord(X, Polys(pNum).vertex(j).X, R) And nearCoord(Y, Polys(pNum).vertex(j).Y, R) Then If (Polys(pNum).vertex(j).X - X) ^ 2 + (Polys(pNum).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then Polys(pNum).vertex(j).z = Polys(pNum).vertex(j).z * (1 - opacity) + polyClr.red * opacity - If colourMode = 1 Then vertexList(pNum).vertex(j) = 3 + If colorMode = 1 Then vertexList(pNum).vertex(j) = 3 edited = True End If End If @@ -8006,7 +8006,7 @@ Private Sub EditDepthMap(X As Single, Y As Single) If nearCoord(X, Polys(i).vertex(j).X, R) And nearCoord(Y, Polys(i).vertex(j).Y, R) Then If (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then Polys(i).vertex(j).z = Polys(i).vertex(j).z * (1 - opacity) + polyClr.red * opacity - If colourMode = 1 Then vertexList(i).vertex(j) = 2 + If colorMode = 1 Then vertexList(i).vertex(j) = 2 edited = True End If End If @@ -8023,12 +8023,12 @@ Private Sub EditDepthMap(X As Single, Y As Single) End Sub -Private Sub ColourPicker(X As Single, Y As Single) +Private Sub ColorPicker(X As Single, Y As Single) Dim i As Integer, j As Integer Dim shortestDist As Integer, currentDist As Integer Dim pNum As Integer, vNum As Integer - Dim tempClr As TColour + Dim tempClr As TColor If showPolys Or showWireframe Or showPoints Then @@ -8050,12 +8050,12 @@ Private Sub ColourPicker(X As Single, Y As Single) End If - If vNum > 0 Then 'poly colour absorbed - tempClr = vertexList(pNum).colour(vNum) + If vNum > 0 Then 'poly color absorbed + tempClr = vertexList(pNum).color(vNum) If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then ElseIf frmPalette.Enabled = False Then 'non modal - frmColour.InitClr tempClr.red, tempClr.green, tempClr.blue + frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue Else polyClr = tempClr Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) @@ -8073,7 +8073,7 @@ Private Sub ColourPicker(X As Single, Y As Single) If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then ElseIf frmPalette.Enabled = False Then 'non modal - frmColour.InitClr tempClr.red, tempClr.green, tempClr.blue + frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue Else polyClr = tempClr Scenery(0).Color = ARGB(Scenery(0).alpha, Scenery(vNum).Color) @@ -8111,7 +8111,7 @@ Private Sub depthPicker(X As Single, Y As Single) End If - If vNum > 0 Then 'poly colour absorbed + If vNum > 0 Then 'poly color absorbed If Polys(pNum).vertex(vNum).z >= 0 And Polys(pNum).vertex(vNum).z <= 255 Then polyClr.red = Polys(pNum).vertex(vNum).z ElseIf Polys(pNum).vertex(vNum).z < 0 Then @@ -8133,7 +8133,7 @@ Private Sub lightPicker(X As Single, Y As Single) Dim i As Integer, j As Integer Dim shortestDist As Integer, currentDist As Integer Dim pNum As Integer, vNum As Integer - Dim tempClr As TColour + Dim tempClr As TColor If showPolys Or showWireframe Or showPoints Then @@ -8155,13 +8155,13 @@ Private Sub lightPicker(X As Single, Y As Single) End If - If vNum > 0 Then 'poly colour absorbed + If vNum > 0 Then 'poly color absorbed tempClr = getRGB(Polys(pNum).vertex(vNum).Color) If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then ElseIf frmPalette.Enabled = False Then 'non modal - frmColour.InitClr tempClr.red, tempClr.green, tempClr.blue + frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue Else polyClr = tempClr Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) @@ -8294,10 +8294,10 @@ Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As ElseIf currentFunction = TOOL_PSELECT And toolAction Then 'poly selection - ElseIf currentFunction = TOOL_VCOLOUR And toolAction Then 'vertex colouring + ElseIf currentFunction = TOOL_VCOLOR And toolAction Then 'vertex coloring toolAction = False - If colourMode = 1 Then + If colorMode = 1 Then For i = 1 To polyCount For j = 1 To 3 If vertexList(i).vertex(j) > 1 Then @@ -8313,7 +8313,7 @@ Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As End If SaveUndo - ElseIf currentFunction = TOOL_PCOLOUR And toolAction Then 'poly colour + ElseIf currentFunction = TOOL_PCOLOR And toolAction Then 'poly color ElseIf currentFunction = TOOL_TEXTURE And toolAction Then 'texture @@ -8357,7 +8357,7 @@ Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As ElseIf currentFunction = TOOL_DEPTHMAP Then toolAction = False - If colourMode = 1 Then + If colorMode = 1 Then For i = 1 To polyCount For j = 1 To 3 If vertexList(i).vertex(j) > 1 Then @@ -8494,9 +8494,9 @@ Private Sub CreatePolys(X As Single, Y As Single) Polys(polyCount + 1).vertex(numVerts) = CreateCustomVertex(xVal, yVal, _ 0, 1, ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)), _ (xVal / zoomFactor + scrollCoords(2).X) / xTexture, (yVal / zoomFactor + scrollCoords(2).Y) / yTexture) - vertexList(polyCount + 1).colour(numVerts).red = polyClr.red - vertexList(polyCount + 1).colour(numVerts).green = polyClr.green - vertexList(polyCount + 1).colour(numVerts).blue = polyClr.blue + vertexList(polyCount + 1).color(numVerts).red = polyClr.red + vertexList(polyCount + 1).color(numVerts).green = polyClr.green + vertexList(polyCount + 1).color(numVerts).blue = polyClr.blue If mnuQuad.Checked And mnuCustomX.Checked Then If creatingQuad Then @@ -8563,8 +8563,8 @@ Private Sub CreatePolys(X As Single, Y As Single) Polys(polyCount + 1).vertex(2) = Polys(polyCount).vertex(3) PolyCoords(polyCount + 1).vertex(1) = PolyCoords(polyCount).vertex(1) PolyCoords(polyCount + 1).vertex(2) = PolyCoords(polyCount).vertex(3) - vertexList(polyCount + 1).colour(1) = vertexList(polyCount).colour(1) - vertexList(polyCount + 1).colour(2) = vertexList(polyCount).colour(3) + vertexList(polyCount + 1).color(1) = vertexList(polyCount).color(1) + vertexList(polyCount + 1).color(2) = vertexList(polyCount).color(3) numVerts = 2 Polys(polyCount + 1).vertex(3) = Polys(polyCount).vertex(3) PolyCoords(polyCount + 1).vertex(3) = PolyCoords(polyCount).vertex(3) @@ -10030,12 +10030,12 @@ ErrorHandler: End Function -Private Sub ColourFill(X As Single, Y As Single) +Private Sub ColorFill(X As Single, Y As Single) Dim i As Integer, j As Integer Dim PolyNum As Integer - Dim destClr As TColour - Dim polyColoured As Boolean + Dim destClr As TColor + Dim polyColored As Boolean If numSelectedPolys > 0 Or numSelectedScenery > 0 Then @@ -10051,11 +10051,11 @@ Private Sub ColourFill(X As Single, Y As Single) destClr = getRGB(Polys(PolyNum).vertex(j).Color) destClr = applyBlend(destClr) Polys(PolyNum).vertex(j).Color = ARGB(getAlpha(Polys(PolyNum).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(PolyNum).colour(j).red = destClr.red - vertexList(PolyNum).colour(j).green = destClr.green - vertexList(PolyNum).colour(j).blue = destClr.blue + vertexList(PolyNum).color(j).red = destClr.red + vertexList(PolyNum).color(j).green = destClr.green + vertexList(PolyNum).color(j).blue = destClr.blue applyLightsToVert PolyNum, j - polyColoured = True + polyColored = True End If Next Next @@ -10071,12 +10071,12 @@ Private Sub ColourFill(X As Single, Y As Single) destClr = getRGB(Scenery(i).Color) destClr = applyBlend(destClr) Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) - polyColoured = True + polyColored = True End If Next End If - If polyColoured Then + If polyColored Then SaveUndo End If @@ -10093,17 +10093,17 @@ Private Sub ColourFill(X As Single, Y As Single) destClr = getRGB(Polys(i).vertex(j).Color) 'get clr of poly destClr = applyBlend(destClr) Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(i).colour(j).red = destClr.red - vertexList(i).colour(j).green = destClr.green - vertexList(i).colour(j).blue = destClr.blue + vertexList(i).color(j).red = destClr.red + vertexList(i).color(j).green = destClr.green + vertexList(i).color(j).blue = destClr.blue applyLightsToVert i, j - polyColoured = True + polyColored = True Next End If Next End If - If Not polyColoured And showScenery Then + If Not polyColored And showScenery Then For i = 1 To sceneryCount If PointInProp(X, Y, i) Then If selectionChanged Then @@ -10113,12 +10113,12 @@ Private Sub ColourFill(X As Single, Y As Single) destClr = getRGB(Scenery(i).Color) destClr = applyBlend(destClr) Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) - polyColoured = True + polyColored = True End If Next End If - If polyColoured Then + If polyColored Then SaveUndo End If @@ -10130,7 +10130,7 @@ Private Sub ColourFill(X As Single, Y As Single) End Sub -Private Function applyBlend(dClr As TColour) As TColour +Private Function applyBlend(dClr As TColor) As TColor If blendMode = 0 Then 'normal applyBlend.red = polyClr.red * opacity + dClr.red * (1 - opacity) @@ -10319,7 +10319,7 @@ Private Sub deletePolys() ElseIf lightCount = 0 Then For i = 1 To polyCount For j = 1 To 3 - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).colour(j).blue, vertexList(i).colour(j).green, vertexList(i).colour(j).red)) + Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) Next Next End If @@ -10442,7 +10442,7 @@ Private Sub mnuFlip_Click(Index As Integer) Dim vertSel As Byte Dim temp As D3DVECTOR2 Dim tempVertex As TCustomVertex - Dim tempClr As TColour + Dim tempClr As TColor If selectionChanged Then SaveUndo @@ -10484,9 +10484,9 @@ Private Sub mnuFlip_Click(Index As Integer) vertexList(PolyNum).vertex(3) = vertexList(PolyNum).vertex(2) vertexList(PolyNum).vertex(2) = vertSel - tempClr = vertexList(PolyNum).colour(3) - vertexList(PolyNum).colour(3) = vertexList(PolyNum).colour(2) - vertexList(PolyNum).colour(2) = tempClr + tempClr = vertexList(PolyNum).color(3) + vertexList(PolyNum).color(3) = vertexList(PolyNum).color(2) + vertexList(PolyNum).color(2) = tempClr End If Next End If @@ -11514,7 +11514,7 @@ Private Sub setLightsMode(lightsOn As Boolean) If Not lightsOn Then For i = 1 To polyCount For j = 1 To 3 - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).colour(j).blue, vertexList(i).colour(j).green, vertexList(i).colour(j).red)) + Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) Next Next Else @@ -11523,9 +11523,9 @@ Private Sub setLightsMode(lightsOn As Boolean) End Sub -Public Sub setColourMode(ByVal clrVal As Byte) +Public Sub setColorMode(ByVal clrVal As Byte) - colourMode = clrVal + colorMode = clrVal End Sub @@ -11567,7 +11567,7 @@ Public Sub setCurrentTool(ByVal Index As Integer) End If ElseIf currentTool = TOOL_TEXTURE Then frmInfo.mnuProp_Click 3 - ElseIf currentTool = TOOL_VCOLOUR Then + ElseIf currentTool = TOOL_VCOLOR Then circleOn = True ElseIf currentTool = TOOL_DEPTHMAP Then circleOn = True @@ -11603,7 +11603,7 @@ Public Sub setMapTexture(texturePath As String) Set mapTexture = D3DX.CreateTextureFromFileEx(D3DDevice, frmSoldatMapEditor.soldatDir & "textures\" & texturePath, D3DX_DEFAULT, D3DX_DEFAULT, _ D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_TRIANGLE, _ - D3DX_FILTER_TRIANGLE, ColourKey, imageInfo, ByVal 0) + D3DX_FILTER_TRIANGLE, ColorKey, imageInfo, ByVal 0) textureFile = texturePath @@ -11623,7 +11623,7 @@ ErrorHandler: End Sub 'set polyclr when rgb modified -Public Sub setPolyColour(Index As Integer, value As Byte) +Public Sub setPolyColor(Index As Integer, value As Byte) If Index = 0 Then polyClr.red = value @@ -11643,7 +11643,7 @@ Public Sub setPolyColour(Index As Integer, value As Byte) End Sub 'set polyclr when palette clicked -Public Sub setPaletteColour(red As Byte, green As Byte, blue As Byte) +Public Sub setPaletteColor(red As Byte, green As Byte, blue As Byte) polyClr.red = red polyClr.green = green @@ -11662,9 +11662,9 @@ Public Sub setBlendMode(Index As Integer) End Sub -Public Function getColour() As Long +Public Function getColor() As Long - getColour = RGB(polyClr.red, polyClr.green, polyClr.blue) + getColor = RGB(polyClr.red, polyClr.green, polyClr.blue) End Function @@ -11678,8 +11678,8 @@ Public Sub getOptions() frmMap.cboMedikits.ListIndex = Options.Medikits frmMap.cboSteps.ListIndex = Options.Steps frmMap.cboWeather.ListIndex = Options.Weather - frmMap.picBackClr(0).BackColor = RGB(bgColours(1).red, bgColours(1).green, bgColours(1).blue) - frmMap.picBackClr(1).BackColor = RGB(bgColours(2).red, bgColours(2).green, bgColours(2).blue) + frmMap.picBackClr(0).BackColor = RGB(bgColors(1).red, bgColors(1).green, bgColors(1).blue) + frmMap.picBackClr(1).BackColor = RGB(bgColors(2).red, bgColors(2).green, bgColors(2).blue) For i = 0 To frmMap.cboTexture.ListCount - 1 If frmMap.cboTexture.List(i) = textureFile Then @@ -11696,8 +11696,8 @@ Public Sub setOptions() Options.StartJet = frmMap.txtJet.Text Options.Steps = frmMap.cboSteps.ListIndex Options.Weather = frmMap.cboWeather.ListIndex - Options.BackgroundColor = ARGB(255, RGB(bgColours(1).blue, bgColours(1).green, bgColours(1).red)) - Options.BackgroundColor = ARGB(255, RGB(bgColours(2).blue, bgColours(2).green, bgColours(2).red)) + Options.BackgroundColor = ARGB(255, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red)) + Options.BackgroundColor = ARGB(255, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red)) mapTitle = frmMap.txtDesc.Text @@ -11827,26 +11827,26 @@ Public Sub setPreferences() End Sub -Public Function setBGColour(Index As Integer) As Long +Public Function setBGColor(Index As Integer) As Long - frmColour.InitClr bgColours(Index).red, bgColours(Index).green, bgColours(Index).blue - frmColour.Show 1 - bgColours(Index).red = frmColour.red - bgColours(Index).green = frmColour.green - bgColours(Index).blue = frmColour.blue + frmColor.InitClr bgColors(Index).red, bgColors(Index).green, bgColors(Index).blue + frmColor.Show 1 + bgColors(Index).red = frmColor.red + bgColors(Index).green = frmColor.green + bgColors(Index).blue = frmColor.blue - bgPolys(1).Color = RGB(bgColours(1).blue, bgColours(1).green, bgColours(1).red) - bgPolys(2).Color = RGB(bgColours(2).blue, bgColours(2).green, bgColours(2).red) - bgPolys(3).Color = RGB(bgColours(1).blue, bgColours(1).green, bgColours(1).red) - bgPolys(4).Color = RGB(bgColours(2).blue, bgColours(2).green, bgColours(2).red) + bgPolys(1).Color = RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red) + bgPolys(2).Color = RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red) + bgPolys(3).Color = RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red) + bgPolys(4).Color = RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red) - setBGColour = RGB(bgColours(Index).red, bgColours(Index).green, bgColours(Index).blue) + setBGColor = RGB(bgColors(Index).red, bgColors(Index).green, bgColors(Index).blue) Render End Function -Public Sub setLightColour() +Public Sub setLightColor() Dim i As Integer Dim Index As Integer @@ -11858,18 +11858,18 @@ Public Sub setLightColour() End If Next - frmColour.InitClr Lights(Index).colour.red, Lights(Index).colour.green, Lights(Index).colour.blue - frmColour.Show 1 + frmColor.InitClr Lights(Index).color.red, Lights(Index).color.green, Lights(Index).color.blue + frmColor.Show 1 For i = 1 To lightCount If Lights(i).selected = 1 Then - Lights(i).colour.red = frmColour.red - Lights(i).colour.green = frmColour.green - Lights(i).colour.blue = frmColour.blue + Lights(i).color.red = frmColor.red + Lights(i).color.green = frmColor.green + Lights(i).color.blue = frmColor.blue End If Next - frmInfo.picLight.BackColor = RGB(frmColour.red, frmColour.green, frmColour.blue) + frmInfo.picLight.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) applyLights @@ -12032,7 +12032,7 @@ Private Sub saveSettings() Dim i As Integer, KeyCode As Byte Dim iniString As String - Dim currentColour As Long + Dim currentColor As Long Dim sNull As String sNull = Chr$(0) @@ -12058,11 +12058,11 @@ Private Sub saveSettings() saveSection "Display", iniString 'tool settings - currentColour = RGB(polyClr.blue, polyClr.green, polyClr.red) + currentColor = RGB(polyClr.blue, polyClr.green, polyClr.red) iniString = "CurrentTool=" & currentTool & sNull & "SnapVertices=" & ohSnap & sNull _ & "SnapToGrid=" & snapToGrid & sNull & "FixedTexture=" & fixedTexture & sNull _ - & "Opacity=" & (opacity * 100) & sNull & "ColourRadius=" & clrRadius & sNull _ - & "CurrentColour=" & RGBtoHex(currentColour) & sNull & "ColourMode=" & colourMode & sNull _ + & "Opacity=" & (opacity * 100) & sNull & "ColorRadius=" & clrRadius & sNull _ + & "CurrentColor=" & RGBtoHex(currentColor) & sNull & "ColorMode=" & colorMode & sNull _ & "BlendMode=" & blendMode & sNull & "SnapRadius=" & snapRadius & sNull _ & "RotateScenery=" & frmScenery.rotateScenery & sNull & "ScaleScenery=" & frmScenery.scaleScenery & sNull _ & "TextureWidth=" & xTexture & sNull & "TextureHeight=" & yTexture & sNull _ @@ -12074,10 +12074,10 @@ Private Sub saveSettings() 'hotkeys iniString = "Move=" & frmTools.getHotKey(0) & sNull & "Create=" & frmTools.getHotKey(1) & sNull _ & "VertexSelection=" & frmTools.getHotKey(2) & sNull & "PolySelection=" & frmTools.getHotKey(3) & sNull _ - & "VertexColour=" & frmTools.getHotKey(4) & sNull & "PolyColour=" & frmTools.getHotKey(5) & sNull _ + & "VertexColor=" & frmTools.getHotKey(4) & sNull & "PolyColor=" & frmTools.getHotKey(5) & sNull _ & "Texture=" & frmTools.getHotKey(6) & sNull & "Scenery=" & frmTools.getHotKey(7) & sNull _ & "Waypoints=" & frmTools.getHotKey(8) & sNull & "Objects=" & frmTools.getHotKey(9) & sNull _ - & "ColourPicker=" & frmTools.getHotKey(10) & sNull & "Sketch=" & frmTools.getHotKey(11) & sNull _ + & "ColorPicker=" & frmTools.getHotKey(10) & sNull & "Sketch=" & frmTools.getHotKey(11) & sNull _ & "Lights=" & frmTools.getHotKey(12) & sNull & "Depthmap=" & frmTools.getHotKey(13) & sNull & sNull saveSection "HotKeys", iniString @@ -12205,9 +12205,9 @@ Private Sub loadINI() snapToGrid = loadString("ToolSettings", "SnapToGrid") fixedTexture = loadString("ToolSettings", "FixedTexture") opacity = loadInt("ToolSettings", "Opacity") / 100 - clrRadius = loadInt("ToolSettings", "ColourRadius") - polyClr = getRGB(HexToLong(loadString("ToolSettings", "CurrentColour"))) - colourMode = loadInt("ToolSettings", "ColourMode") + clrRadius = loadInt("ToolSettings", "ColorRadius") + polyClr = getRGB(HexToLong(loadString("ToolSettings", "CurrentColor"))) + colorMode = loadInt("ToolSettings", "ColorMode") blendMode = loadInt("ToolSettings", "BlendMode") snapRadius = loadInt("ToolSettings", "SnapRadius") frmScenery.rotateScenery = loadString("ToolSettings", "RotateScenery") @@ -12224,13 +12224,13 @@ Private Sub loadINI() frmTools.setHotKey 1, loadInt("HotKeys", "Create") frmTools.setHotKey 2, loadInt("HotKeys", "VertexSelection") frmTools.setHotKey 3, loadInt("HotKeys", "PolySelection") - frmTools.setHotKey 4, loadInt("HotKeys", "VertexColour") - frmTools.setHotKey 5, loadInt("HotKeys", "PolyColour") + frmTools.setHotKey 4, loadInt("HotKeys", "VertexColor") + frmTools.setHotKey 5, loadInt("HotKeys", "PolyColor") frmTools.setHotKey 6, loadInt("HotKeys", "Texture") frmTools.setHotKey 7, loadInt("HotKeys", "Scenery") frmTools.setHotKey 8, loadInt("HotKeys", "Waypoints") frmTools.setHotKey 9, loadInt("HotKeys", "Objects") - frmTools.setHotKey 10, loadInt("HotKeys", "ColourPicker") + frmTools.setHotKey 10, loadInt("HotKeys", "ColorPicker") frmTools.setHotKey 11, loadInt("HotKeys", "Sketch") frmTools.setHotKey 12, loadInt("HotKeys", "Lights") frmTools.setHotKey 13, loadInt("HotKeys", "DepthMap") @@ -12269,31 +12269,31 @@ Private Sub loadINI() errVal = "8" - PolyTypeClrs(1) = CLng("&H" + (loadString("PolyTypeColours", "OnlyBullets"))) - PolyTypeClrs(2) = CLng("&H" + (loadString("PolyTypeColours", "OnlyPlayer"))) - PolyTypeClrs(3) = CLng("&H" + (loadString("PolyTypeColours", "DoesntCollide"))) - PolyTypeClrs(4) = CLng("&H" + (loadString("PolyTypeColours", "Ice"))) - PolyTypeClrs(5) = CLng("&H" + (loadString("PolyTypeColours", "Deadly"))) - PolyTypeClrs(6) = CLng("&H" + (loadString("PolyTypeColours", "BloodyDeadly"))) - PolyTypeClrs(7) = CLng("&H" + (loadString("PolyTypeColours", "Hurts"))) - PolyTypeClrs(8) = CLng("&H" + (loadString("PolyTypeColours", "Regenerates"))) - PolyTypeClrs(9) = CLng("&H" + (loadString("PolyTypeColours", "Lava"))) - PolyTypeClrs(10) = CLng("&H" + (loadString("PolyTypeColours", "TeamBullets"))) - PolyTypeClrs(11) = CLng("&H" + (loadString("PolyTypeColours", "TeamPlayers"))) + PolyTypeClrs(1) = CLng("&H" + (loadString("PolyTypeColors", "OnlyBullets"))) + PolyTypeClrs(2) = CLng("&H" + (loadString("PolyTypeColors", "OnlyPlayer"))) + PolyTypeClrs(3) = CLng("&H" + (loadString("PolyTypeColors", "DoesntCollide"))) + PolyTypeClrs(4) = CLng("&H" + (loadString("PolyTypeColors", "Ice"))) + PolyTypeClrs(5) = CLng("&H" + (loadString("PolyTypeColors", "Deadly"))) + PolyTypeClrs(6) = CLng("&H" + (loadString("PolyTypeColors", "BloodyDeadly"))) + PolyTypeClrs(7) = CLng("&H" + (loadString("PolyTypeColors", "Hurts"))) + PolyTypeClrs(8) = CLng("&H" + (loadString("PolyTypeColors", "Regenerates"))) + PolyTypeClrs(9) = CLng("&H" + (loadString("PolyTypeColors", "Lava"))) + PolyTypeClrs(10) = CLng("&H" + (loadString("PolyTypeColors", "TeamBullets"))) + PolyTypeClrs(11) = CLng("&H" + (loadString("PolyTypeColors", "TeamPlayers"))) PolyTypeClrs(12) = PolyTypeClrs(10) PolyTypeClrs(13) = PolyTypeClrs(11) PolyTypeClrs(14) = PolyTypeClrs(10) PolyTypeClrs(15) = PolyTypeClrs(11) PolyTypeClrs(16) = PolyTypeClrs(10) PolyTypeClrs(17) = PolyTypeClrs(11) - PolyTypeClrs(18) = CLng("&H" + (loadString("PolyTypeColours", "Bouncy"))) - PolyTypeClrs(19) = CLng("&H" + (loadString("PolyTypeColours", "Explosive"))) - PolyTypeClrs(20) = CLng("&H" + (loadString("PolyTypeColours", "HurtFlaggers"))) - PolyTypeClrs(21) = CLng("&H" + (loadString("PolyTypeColours", "OnlyFlagger"))) - PolyTypeClrs(22) = CLng("&H" + (loadString("PolyTypeColours", "NonFlagger"))) - PolyTypeClrs(23) = CLng("&H" + (loadString("PolyTypeColours", "FlagCollides"))) - PolyTypeClrs(24) = CLng("&H" + (loadString("PolyTypeColours", "Back"))) - PolyTypeClrs(25) = CLng("&H" + (loadString("PolyTypeColours", "BackTransition"))) + PolyTypeClrs(18) = CLng("&H" + (loadString("PolyTypeColors", "Bouncy"))) + PolyTypeClrs(19) = CLng("&H" + (loadString("PolyTypeColors", "Explosive"))) + PolyTypeClrs(20) = CLng("&H" + (loadString("PolyTypeColors", "HurtFlaggers"))) + PolyTypeClrs(21) = CLng("&H" + (loadString("PolyTypeColors", "OnlyFlagger"))) + PolyTypeClrs(22) = CLng("&H" + (loadString("PolyTypeColors", "NonFlagger"))) + PolyTypeClrs(23) = CLng("&H" + (loadString("PolyTypeColors", "FlagCollides"))) + PolyTypeClrs(24) = CLng("&H" + (loadString("PolyTypeColors", "Back"))) + PolyTypeClrs(25) = CLng("&H" + (loadString("PolyTypeColors", "BackTransition"))) errVal = "9" @@ -12395,18 +12395,18 @@ ErrorHandler: End Sub -Public Sub loadColours() +Public Sub loadColors() On Error GoTo ErrorHandler - bgClr = CLng("&H" + loadString("GUIColours", "Background", appPath & "\" & gfxDir & "\colours.ini")) - lblBackClr = CLng("&H" + loadString("GUIColours", "LabelBack", appPath & "\" & gfxDir & "\colours.ini")) - lblTextClr = CLng("&H" + loadString("GUIColours", "LabelText", appPath & "\" & gfxDir & "\colours.ini")) - txtBackClr = CLng("&H" + loadString("GUIColours", "TextBoxBack", appPath & "\" & gfxDir & "\colours.ini")) - txtTextClr = CLng("&H" + loadString("GUIColours", "TextBoxText", appPath & "\" & gfxDir & "\colours.ini")) - frameClr = CLng("&H" + loadString("GUIColours", "Frame", appPath & "\" & gfxDir & "\colours.ini")) - font1 = loadString("GUIColours", "font1", appPath & "\" & gfxDir & "\colours.ini", 40) - font2 = loadString("GUIColours", "font2", appPath & "\" & gfxDir & "\colours.ini", 40) + bgClr = CLng("&H" + loadString("GUIColors", "Background", appPath & "\" & gfxDir & "\colors.ini")) + lblBackClr = CLng("&H" + loadString("GUIColors", "LabelBack", appPath & "\" & gfxDir & "\colors.ini")) + lblTextClr = CLng("&H" + loadString("GUIColors", "LabelText", appPath & "\" & gfxDir & "\colors.ini")) + txtBackClr = CLng("&H" + loadString("GUIColors", "TextBoxBack", appPath & "\" & gfxDir & "\colors.ini")) + txtTextClr = CLng("&H" + loadString("GUIColors", "TextBoxText", appPath & "\" & gfxDir & "\colors.ini")) + frameClr = CLng("&H" + loadString("GUIColors", "Frame", appPath & "\" & gfxDir & "\colors.ini")) + font1 = loadString("GUIColors", "font1", appPath & "\" & gfxDir & "\colors.ini", 40) + font2 = loadString("GUIColors", "font2", appPath & "\" & gfxDir & "\colors.ini", 40) If font1 = "" Then font1 = "Arial" If font2 = "" Then font2 = "Arial" @@ -12415,7 +12415,7 @@ Public Sub loadColours() ErrorHandler: - MsgBox "Error loading colours" & vbNewLine & Error$ + MsgBox "Error loading colors" & vbNewLine & Error$ End Sub @@ -12821,7 +12821,7 @@ Private Sub savePrefab(FileName As String) Polygon.vertex(j).Y = PolyCoords(selectedPolys(i)).vertex(j).Y vertexList(selectedPolys(i)).vertex(j) = 1 alpha = getAlpha(Polys(selectedPolys(i)).vertex(j).Color) - Polygon.vertex(j).Color = ARGB(alpha, RGB(vertexList(selectedPolys(i)).colour(j).blue, vertexList(selectedPolys(i)).colour(j).green, vertexList(selectedPolys(i)).colour(j).red)) + Polygon.vertex(j).Color = ARGB(alpha, RGB(vertexList(selectedPolys(i)).color(j).blue, vertexList(selectedPolys(i)).color(j).green, vertexList(selectedPolys(i)).color(j).red)) Next Put #1, , Polygon Put #1, , vertexList(selectedPolys(i)).vertex(1) @@ -12908,7 +12908,7 @@ Private Sub loadPrefab(FileName As String) Dim newColliders As Integer, newSpawnPoints As Integer, newWaypoints As Integer, newConnections As Integer Dim i As Integer, j As Integer Dim tehValue As Integer - Dim tempClr As TColour + Dim tempClr As TColor mnuDeselect_Click @@ -12935,9 +12935,9 @@ Private Sub loadPrefab(FileName As String) Polys(tehValue).vertex(j).X = (PolyCoords(tehValue).vertex(j).X - scrollCoords(2).X) * zoomFactor Polys(tehValue).vertex(j).Y = (PolyCoords(tehValue).vertex(j).Y - scrollCoords(2).Y) * zoomFactor tempClr = getRGB(Polys(tehValue).vertex(j).Color) - vertexList(tehValue).colour(j).red = tempClr.red - vertexList(tehValue).colour(j).green = tempClr.green - vertexList(tehValue).colour(j).blue = tempClr.blue + vertexList(tehValue).color(j).red = tempClr.red + vertexList(tehValue).color(j).green = tempClr.green + vertexList(tehValue).color(j).blue = tempClr.blue Next selectedPolys(i) = tehValue Next @@ -13100,9 +13100,9 @@ Private Sub mnuDuplicate_Click() Polys(polyCount - numSelectedPolys + i).vertex(2).X = (PolyCoords(polyCount - numSelectedPolys + i).vertex(2).X - scrollCoords(2).X) * zoomFactor Polys(polyCount - numSelectedPolys + i).vertex(3).X = (PolyCoords(polyCount - numSelectedPolys + i).vertex(3).X - scrollCoords(2).X) * zoomFactor vertexList(polyCount - numSelectedPolys + i).polyType = vertexList(selectedPolys(i)).polyType - vertexList(polyCount - numSelectedPolys + i).colour(1) = vertexList(selectedPolys(i)).colour(1) - vertexList(polyCount - numSelectedPolys + i).colour(2) = vertexList(selectedPolys(i)).colour(2) - vertexList(polyCount - numSelectedPolys + i).colour(3) = vertexList(selectedPolys(i)).colour(3) + vertexList(polyCount - numSelectedPolys + i).color(1) = vertexList(selectedPolys(i)).color(1) + vertexList(polyCount - numSelectedPolys + i).color(2) = vertexList(selectedPolys(i)).color(2) + vertexList(polyCount - numSelectedPolys + i).color(3) = vertexList(selectedPolys(i)).color(3) For j = 1 To 3 vertexList(selectedPolys(i)).vertex(j) = 0 vertexList(polyCount - numSelectedPolys + i).vertex(j) = 1 @@ -13310,11 +13310,11 @@ Private Sub mnuDeselect_Click() End Sub -Private Sub mnuSelColour_Click() +Private Sub mnuSelColor_Click() Dim i As Integer, j As Integer Dim addPoly As Byte - Dim clrVal As TColour + Dim clrVal As TColor numSelectedPolys = 0 ReDim selectedPolys(0) @@ -13683,7 +13683,7 @@ End Sub Private Sub mnuApplyLight_Click() Dim i As Integer, j As Integer - Dim tehClr As TColour + Dim tehClr As TColor If lightCount = 0 Then Exit Sub @@ -13691,11 +13691,11 @@ Private Sub mnuApplyLight_Click() For i = 1 To numSelectedPolys For j = 1 To 3 - 'apply poly colour to base colour + 'apply poly color to base color tehClr = getRGB(Polys(selectedPolys(i)).vertex(j).Color) - vertexList(selectedPolys(i)).colour(j).red = tehClr.red - vertexList(selectedPolys(i)).colour(j).green = tehClr.green - vertexList(selectedPolys(i)).colour(j).blue = tehClr.blue + vertexList(selectedPolys(i)).color(j).red = tehClr.red + vertexList(selectedPolys(i)).color(j).green = tehClr.green + vertexList(selectedPolys(i)).color(j).blue = tehClr.blue Next Next @@ -13703,11 +13703,11 @@ Private Sub mnuApplyLight_Click() For i = 1 To polyCount For j = 1 To 3 - 'apply poly colour to base colour + 'apply poly color to base color tehClr = getRGB(Polys(i).vertex(j).Color) - vertexList(i).colour(j).red = tehClr.red - vertexList(i).colour(j).green = tehClr.green - vertexList(i).colour(j).blue = tehClr.blue + vertexList(i).color(j).red = tehClr.red + vertexList(i).color(j).green = tehClr.green + vertexList(i).color(j).blue = tehClr.blue Next Next @@ -13726,8 +13726,8 @@ Private Sub mnuSplit_Click() Dim i As Integer, j As Integer Dim left As Byte, right As Byte - Dim clr1 As TColour - Dim clr2 As TColour + Dim clr1 As TColor + Dim clr2 As TColor Dim alpha1 As Byte Dim alpha2 As Byte Dim newPolys As Integer @@ -13784,17 +13784,17 @@ Private Sub mnuSplit_Click() Polys(polyCount).vertex(right).tu = Midpoint(Polys(selectedPolys(i)).vertex(right).tu, Polys(polyCount).vertex(left).tu) Polys(polyCount).vertex(right).tv = Midpoint(Polys(selectedPolys(i)).vertex(right).tv, Polys(polyCount).vertex(left).tv) - vertexList(polyCount).colour(j) = vertexList(selectedPolys(i)).colour(j) - vertexList(polyCount).colour(left) = vertexList(selectedPolys(i)).colour(left) + vertexList(polyCount).color(j) = vertexList(selectedPolys(i)).color(j) + vertexList(polyCount).color(left) = vertexList(selectedPolys(i)).color(left) - 'colours - clr1 = vertexList(selectedPolys(i)).colour(right) - clr2 = vertexList(polyCount).colour(left) - vertexList(polyCount).colour(right).red = clr1.red * 0.5 + clr2.red * 0.5 - vertexList(polyCount).colour(right).green = clr1.green * 0.5 + clr2.green * 0.5 - vertexList(polyCount).colour(right).blue = clr1.blue * 0.5 + clr2.blue * 0.5 + 'colors + clr1 = vertexList(selectedPolys(i)).color(right) + clr2 = vertexList(polyCount).color(left) + vertexList(polyCount).color(right).red = clr1.red * 0.5 + clr2.red * 0.5 + vertexList(polyCount).color(right).green = clr1.green * 0.5 + clr2.green * 0.5 + vertexList(polyCount).color(right).blue = clr1.blue * 0.5 + clr2.blue * 0.5 - vertexList(selectedPolys(i)).colour(left) = vertexList(polyCount).colour(right) + vertexList(selectedPolys(i)).color(left) = vertexList(polyCount).color(right) clr1 = getRGB(Polys(selectedPolys(i)).vertex(right).Color) clr2 = getRGB(Polys(polyCount).vertex(left).Color) @@ -13864,7 +13864,7 @@ Private Sub mnuCreate_Click() Dim numSelVerts As Integer Dim temp As D3DVECTOR2 Dim tempVertex As TCustomVertex - Dim tempClr As TColour + Dim tempClr As TColor If selectionChanged Then SaveUndo @@ -13881,7 +13881,7 @@ Private Sub mnuCreate_Click() numSelVerts = numSelVerts + 1 Polys(polyCount + 1).vertex(numSelVerts) = Polys(selectedPolys(i)).vertex(j) PolyCoords(polyCount + 1).vertex(numSelVerts) = PolyCoords(selectedPolys(i)).vertex(j) - vertexList(polyCount + 1).colour(numSelVerts) = vertexList(selectedPolys(i)).colour(j) + vertexList(polyCount + 1).color(numSelVerts) = vertexList(selectedPolys(i)).color(j) vertexList(polyCount + 1).polyType = vertexList(selectedPolys(i)).polyType End If If numSelVerts = 3 Then Exit For @@ -13902,9 +13902,9 @@ Private Sub mnuCreate_Click() Polys(polyCount).vertex(3) = Polys(polyCount).vertex(2) Polys(polyCount).vertex(2) = tempVertex - tempClr = vertexList(polyCount).colour(3) - vertexList(polyCount).colour(3) = vertexList(polyCount).colour(2) - vertexList(polyCount).colour(2) = tempClr + tempClr = vertexList(polyCount).color(3) + vertexList(polyCount).color(3) = vertexList(polyCount).color(2) + vertexList(polyCount).color(2) = tempClr End If Polys(polyCount).Perp.vertex(1).z = 2 @@ -14464,7 +14464,7 @@ Public Sub getInfo() If Lights(i).selected = 1 Then frmInfo.txtLightProp(0).Text = Lights(i).z frmInfo.txtLightProp(1).Text = Lights(i).range - frmInfo.picLight.BackColor = RGB(Lights(i).colour.red, Lights(i).colour.green, Lights(i).colour.blue) + frmInfo.picLight.BackColor = RGB(Lights(i).color.red, Lights(i).color.green, Lights(i).color.blue) Exit For End If Next @@ -14672,7 +14672,7 @@ End Sub Public Sub applySceneryProp(ByVal tehValue As Single, Index As Integer) Dim i As Integer - Dim tempClr As TColour + Dim tempClr As TColor If selectionChanged Then SaveUndo @@ -14762,7 +14762,7 @@ Private Sub picHelp_MouseUp(Button As Integer, Shift As Integer, X As Single, Y End Sub -Public Sub SetColours() +Public Sub SetColors() On Error Resume Next diff --git a/frmTexture.frm b/frmTexture.frm index 1e5bf43..2d93eac 100644 --- a/frmTexture.frm +++ b/frmTexture.frm @@ -84,7 +84,7 @@ Private Sub Form_Load() On Error GoTo ErrorHandler - Me.SetColours + Me.SetColors formHeight = Me.ScaleHeight @@ -309,7 +309,7 @@ Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y End Sub -Public Sub SetColours() +Public Sub SetColors() On Error Resume Next diff --git a/frmTools.frm b/frmTools.frm index 58cf949..0a17cb8 100644 --- a/frmTools.frm +++ b/frmTools.frm @@ -83,8 +83,8 @@ Begin VB.Form frmTools ScaleMode = 3 'Pixel ScaleWidth = 32 TabIndex = 12 - Tag = "Colour Picker" - ToolTipText = "Colour Picker (,)" + Tag = "Color Picker" + ToolTipText = "Color Picker (,)" Top = 2640 Width = 480 End @@ -227,8 +227,8 @@ Begin VB.Form frmTools ScaleMode = 3 'Pixel ScaleWidth = 32 TabIndex = 4 - Tag = "Vertex Colour" - ToolTipText = "Vertex Colour (E)" + Tag = "Vertex Color" + ToolTipText = "Vertex Color (E)" Top = 1200 Width = 480 End @@ -245,8 +245,8 @@ Begin VB.Form frmTools ScaleMode = 3 'Pixel ScaleWidth = 32 TabIndex = 3 - Tag = "Poly Colour" - ToolTipText = "Poly Colour (R)" + Tag = "Poly Color" + ToolTipText = "Poly Color (R)" Top = 1200 Width = 480 End @@ -345,7 +345,7 @@ Private Sub Form_Load() On Error GoTo ErrorHandler - SetColours + SetColors setForm @@ -439,7 +439,7 @@ Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y End Sub -Public Sub SetColours() +Public Sub SetColors() On Error Resume Next diff --git a/frmWaypoints.frm b/frmWaypoints.frm index 4379578..f5283e5 100644 --- a/frmWaypoints.frm +++ b/frmWaypoints.frm @@ -530,7 +530,7 @@ Private Sub Form_Load() On Error GoTo ErrorHandler - Me.SetColours + Me.SetColors formHeight = Me.ScaleHeight @@ -758,7 +758,7 @@ Public Sub picShow_MouseUp(Index As Integer, Button As Integer, Shift As Integer End Sub -Public Sub SetColours() +Public Sub SetColors() On Error Resume Next diff --git a/modSME.bas b/modSME.bas index 312efd3..b47eb4c 100644 --- a/modSME.bas +++ b/modSME.bas @@ -780,12 +780,12 @@ Public Sub SetGameMode(fileName As String) End Sub -Public Sub SetColours() +Public Sub SetColors() frmSoldatMapEditor.picMenuBar.BackColor = bgClr frmSoldatMapEditor.picStatus.BackColor = bgClr frmPreferences.BackColor = bgClr - frmColour.BackColor = bgClr + frmColor.BackColor = bgClr frmDisplay.BackColor = bgClr frmInfo.BackColor = bgClr frmMap.BackColor = bgClr diff --git a/prjSoldatMapEditor.vbp b/prjSoldatMapEditor.vbp index 1678a1c..e76063e 100644 --- a/prjSoldatMapEditor.vbp +++ b/prjSoldatMapEditor.vbp @@ -12,7 +12,7 @@ Form=frmPalette.frm Form=frmDisplay.frm Module=modSME; modSME.bas Form=frmMap.frm -Form=frmColour.frm +Form=frmColor.frm Form=frmTaskBar.frm Form=frmScenery.frm Form=frmInfo.frm diff --git a/pwinstall/BMPtoCUR/ReadMe.txt b/pwinstall/BMPtoCUR/ReadMe.txt index fd4cf0a..5143bbc 100644 --- a/pwinstall/BMPtoCUR/ReadMe.txt +++ b/pwinstall/BMPtoCUR/ReadMe.txt @@ -1,8 +1,8 @@ Converts a 32x32 bitmap into a monochrome cursor. -Colours consist of black and white, transparency, and invert. +Colors consist of black and white, transparency, and invert. 1. Load a bitmap (or other image file) 2. Set the hot spot (15,15 for default PolyWorks cursors) 3. Click "Make CUR" (a .cur file with the same name as the source file is created in the same directory.) -Has not been tested extensively and doesn't have much error handling, use at your own risk :P \ No newline at end of file +Has not been tested extensively and doesn't have much error handling, use at your own risk :P diff --git a/pwinstall/PolyWorks Help.html b/pwinstall/PolyWorks Help.html index 75bafc6..280e4b4 100644 --- a/pwinstall/PolyWorks Help.html +++ b/pwinstall/PolyWorks Help.html @@ -36,7 +36,7 @@

CREATE
-Click to create polys using the current colour. Right click to select the type of the poly to be created and to turn quad mode on or off. +Click to create polys using the current color. Right click to select the type of the poly to be created and to turn quad mode on or off. Hold shift to constrain the angle to 15° increments relative to the last vertex placed. Hold alt for vertex selection. Hold ctrl to move the current selection.

@@ -53,15 +53,15 @@ Hold ctrl to move the current selection.

-

VERTEX COLOUR
-Click and drag to colour vertices. If there are vertices selected only those will be affected. -Hold alt to get a colour from a vertex or scenery. +

VERTEX COLOR
+Click and drag to color vertices. If there are vertices selected only those will be affected. +Hold alt to get a color from a vertex or scenery. Hold ctrl to move the current selection.

-

POLY COLOUR
-Click in a poly or scenery to colour it. If there are vertices selected all of them will be affected. -Hold alt to get a colour from a vertex or scenery. +

POLY COLOR
+Click in a poly or scenery to color it. If there are vertices selected all of them will be affected. +Hold alt to get a color from a vertex or scenery. Hold ctrl to move the current selection.

@@ -89,10 +89,10 @@ Hold ctrl to move the current selection.

-

COLOUR PICKER
-Click to get a colour from a vertex or scenery. -Hold shift to get a colour directly from the screen. -Hold alt to get a lit vertex colour. +

COLOR PICKER
+Click to get a color from a vertex or scenery. +Hold shift to get a color directly from the screen. +Hold alt to get a lit vertex color. Hold ctrl to move the current selection.

@@ -110,7 +110,7 @@

DEPTH MAP
Click and drag to edit the depth map (z-coordinates). If there are vertices selected only those will be affected. -Hold alt to get a depth colour from a vertex. +Hold alt to get a depth color from a vertex. Hold ctrl to move the current selection.

@@ -164,7 +164,7 @@

   DESELECT [escape]
Deselects current selection.

-

   SELECT BY COLOUR [ctrl+b]
Selects all vertices of the current colour.

+

   SELECT BY COLOR [ctrl+b]
Selects all vertices of the current color.

   ARRANGE
BRING TO FRONT [home] - Brings selected polys and scenery in front of the rest.
@@ -208,9 +208,9 @@ FLIP HORIZONTAL - Flips the selected vertices' texture horizontally, along the vertical axis.
FLIP VERTICAL - Flips the selected vertices' texture vertically, along the horizontal axis.

-

   AVERAGE VERTEX COLOURS [ctrl+g]
Averages the colours of vertices that have the same position.

+

   AVERAGE VERTEX COLORS [ctrl+g]
Averages the colors of vertices that have the same position.

-

   APPLY LIGHT TO VERTICES
Applies lights to vertex colours and hides the light sources.

+

   APPLY LIGHT TO VERTICES
Applies lights to vertex colors and hides the light sources.

   FIXED TEXTURE
Turns fixed texture on and off. When fixed texture is on vertices do not keep their texture coordinates when moved.

@@ -253,31 +253,31 @@

PALETTE WINDOW

-

   CURRENT COLOUR
Click the colour box to show the Colour Picker window, or input the RGB components.

+

   CURRENT COLOR
Click the color box to show the Color Picker window, or input the RGB components.

-

   VERTEX COLOUR MODE
-PRECISION - Only colour once vertex at a time.
-NORMAL - Click and drag to colour vertices.
+

   VERTEX COLOR MODE
+PRECISION - Only color once vertex at a time.
+NORMAL - Click and drag to color vertices.
DYNAMIC - The effect is applied as the mouse moves.

-

   RADIUS
Controls the radius of the vertex colour tool and collider size.

+

   RADIUS
Controls the radius of the vertex color tool and collider size.

-

   OPACITY
Controls the opacity of the vertex colour tool and scenery alpha.

+

   OPACITY
Controls the opacity of the vertex color tool and scenery alpha.

   BLEND MODE
-NORMAL - The current colour is applied.
-MULTIPLY - Multiplies the vertex colour with the current colour. The darker the colour is, the more effect it has. Blending with white produces no change.
-SCREEN - The opposite of Multiply. The lighter the colour is, the more effect is has. Blending with black produces no change.
-DARKEN - Affects vertices that are lighter than the current colour, and darkens them.
-LIGHTEN - Affects vertices that are darker than the current colour, and lightens them.
-DIFFERENCE - Takes the difference between the vertex colour and the current colour. Blending with white inverts the base color values, blending with black produces no change.

+NORMAL - The current color is applied.
+MULTIPLY - Multiplies the vertex color with the current color. The darker the color is, the more effect it has. Blending with white produces no change.
+SCREEN - The opposite of Multiply. The lighter the color is, the more effect is has. Blending with black produces no change.
+DARKEN - Affects vertices that are lighter than the current color, and darkens them.
+LIGHTEN - Affects vertices that are darker than the current color, and lightens them.
+DIFFERENCE - Takes the difference between the vertex color and the current color. Blending with white inverts the base color values, blending with black produces no change.

-

   PALETTE
Contains 72 colours. Right click to add a colour to the palette.

+

   PALETTE
Contains 72 colors. Right click to add a color to the palette.

   PALETTE MENU
-LOAD PALETTE - Loads palette colours from a file.
-SAVE PALETTE - Saves the current palette colours in a file.
-CLEAR - Sets all palette colours to black.

+LOAD PALETTE - Loads palette colors from a file.
+SAVE PALETTE - Saves the current palette colors in a file.
+CLEAR - Sets all palette colors to black.

@@ -308,7 +308,7 @@

   TEXTURE SETTINGS
Sets texture dimensions used when fixed texture is applied. Define the horizontal and vertical coordinates used by the quad function.

-

   LIGHT PROPERTIES
Sets the colour and z-coordinate of all selected lights.

+

   LIGHT PROPERTIES
Sets the color and z-coordinate of all selected lights.

   MAP INFO
Shows the current number of polys, scenery, spawn points, colliders, waypoints, and waypoint connections.

@@ -331,4 +331,4 @@ - \ No newline at end of file + diff --git a/pwinstall/ReadMe.txt b/pwinstall/ReadMe.txt index e31541c..0a25956 100644 --- a/pwinstall/ReadMe.txt +++ b/pwinstall/ReadMe.txt @@ -54,7 +54,7 @@ Try changing the Dir entry in the Preferences section in polyworks.ini to your S In PolyWorks the "bouncy poly" bug has been eliminated (where polys would randomly turn bouncy along the edge after compiling). Poly bugs associated with vertices still occur, but they are easy to prevent with correct poly placement. Read the Map Maker Manual for more info. 12. I get a Direct3D initialization error when I start PolyWorks. -Make sure your colour setting is either 16-bit or 32-bit (control panel -> display -> settings tab). +Make sure your color setting is either 16-bit or 32-bit (control panel -> display -> settings tab). 13. There is no scenery in my scenery window! Right click with the scenery tool to bring up the main scenery list. @@ -177,7 +177,7 @@ changes in v1.4.0.6 - added vertex alpha control in properties window changes in v1.4.0.5 -- fixed red/blue components of poly colours switched on export +- fixed red/blue components of poly colors switched on export - fixed scenery filter bug changes in v1.4.0.4 @@ -200,7 +200,7 @@ changes in v1.4 - lights tool - depthmap tool - big scenery list on right click with scenery tool -- average vertex colours function +- average vertex colors function - some changes to the ini file - select skin from preferences window - snap radius in ini file @@ -216,7 +216,7 @@ changes in v1.3 - fixed scenery timestamp - fixed scenery file name (case sensitive) - horizontal flip on waypoints changes left<->right -- colours picked from map are selected in the palette +- colors picked from map are selected in the palette - save/load workspace - other bug fixes @@ -227,7 +227,7 @@ changes in v1.2 - keyboard input with directinput - loads png and jpg scenery and textures - load compiled map from Soldat Maps folder -- select vertices by colour function +- select vertices by color function - waypoint support - fixed some maps causing errors when loading - choose uncompiled maps dir and prefabs dir @@ -240,7 +240,7 @@ changes in v1.2 - properties window shows element name of scenery when single scenery is selected - disabled recent files when empty - creating something sets that layer to visible if it is not -- can only colour polys/scenery when visible +- can only color polys/scenery when visible - experimental textured quad function - pressing F1 or the ? button opens the help file - turned off vsync @@ -252,8 +252,8 @@ changes in v1.0 - custom hotkeys - gfx.bmp split up into two files - automatic directory detection -- colour picker tool -- show vertex colour radius +- color picker tool +- show vertex color radius - compile progress bar - type in zoom level - map options @@ -272,7 +272,7 @@ changes in v1.0 - properties window - recent files - ini files -- hex code in colour picker window +- hex code in color picker window - arrow keys move texture coords with texture tool - undo/redo - run soldat with last compiled map diff --git a/pwinstall/gfx/colour_picker.bmp b/pwinstall/gfx/color_picker.bmp similarity index 100% rename from pwinstall/gfx/colour_picker.bmp rename to pwinstall/gfx/color_picker.bmp diff --git a/pwinstall/gfx/colours.ini b/pwinstall/gfx/colors.ini similarity index 85% rename from pwinstall/gfx/colours.ini rename to pwinstall/gfx/colors.ini index 685d1eb..29563a0 100644 --- a/pwinstall/gfx/colours.ini +++ b/pwinstall/gfx/colors.ini @@ -1,9 +1,9 @@ -[GUIColours] -Background=4A3C31 -LabelBack=614B3D -LabelText=FFFFFF -TextBoxBack=FFFFFF -TextBoxText=000000 -Frame=0B3C0D -Font1=Arial -Font2=Arial +[GUIColors] +Background=4A3C31 +LabelBack=614B3D +LabelText=FFFFFF +TextBoxBack=FFFFFF +TextBoxText=000000 +Frame=0B3C0D +Font1=Arial +Font2=Arial diff --git a/pwinstall/gfx/cursors/colour_picker.cur b/pwinstall/gfx/cursors/color_picker.cur similarity index 100% rename from pwinstall/gfx/cursors/colour_picker.cur rename to pwinstall/gfx/cursors/color_picker.cur diff --git a/pwinstall/gfx/cursors/pcolour.cur b/pwinstall/gfx/cursors/pcolor.cur similarity index 100% rename from pwinstall/gfx/cursors/pcolour.cur rename to pwinstall/gfx/cursors/pcolor.cur diff --git a/pwinstall/gfx/cursors/vcolour.cur b/pwinstall/gfx/cursors/vcolor.cur similarity index 100% rename from pwinstall/gfx/cursors/vcolour.cur rename to pwinstall/gfx/cursors/vcolor.cur diff --git a/pwinstall/gfx/titlebar_colourpicker.bmp b/pwinstall/gfx/titlebar_colorpicker.bmp similarity index 91% rename from pwinstall/gfx/titlebar_colourpicker.bmp rename to pwinstall/gfx/titlebar_colorpicker.bmp index 1d51ce315068fc9658a354b2bba59ac961362ad9..0ca6d9949b6d751e087dbaff9c8324dcc06c5463 100644 GIT binary patch delta 282 zcmX@GhjHH?MrJ2pyN%3RJe%!#Cb3LR5So0D^~q*`@qU&`LPC@8Nk7NR=Cf6qd_Ylj z@_a>=$qGt5lg}DSPc~3zoBURhb2GQnW3b+LYRQw!jD#lt)zO+9pu{%$f)3l})#|6g za{mltC-W)sPhM-wvq|?KR48Zi0d@Y#3bsO%ADFXE&H`!$Y1wTA(eh4B9jFCl4JS|y q&*bxpY(VS5Mr;be+h?@^ delta 251 zcmdnDhw;E3MrJ2phmFiyJd-c53T@WqnZz>rAnUiyw&MLPlkZ7C2a95I_-s`sKQI?U z#+wf)%CJs;r55L4Q|H+{Q~fl{ Date: Mon, 6 Jul 2020 15:54:00 +0200 Subject: [PATCH 30/57] Fix position of texture window close button not all the way to the right --- frmTexture.frm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/frmTexture.frm b/frmTexture.frm index 2d93eac..0ea69c1 100644 --- a/frmTexture.frm +++ b/frmTexture.frm @@ -56,7 +56,7 @@ Begin VB.Form frmTexture BorderStyle = 0 'None ForeColor = &H80000008& Height = 240 - Left = 720 + Left = 960 ScaleHeight = 16 ScaleMode = 3 'Pixel ScaleWidth = 16 From 26af703bff5fd0fba5f69541dae51b7dcfd7b47a Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sun, 6 Sep 2020 07:02:45 +0200 Subject: [PATCH 31/57] Add support for collapsing Tools Window --- frmTools.frm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/frmTools.frm b/frmTools.frm index 0a17cb8..057615e 100644 --- a/frmTools.frm +++ b/frmTools.frm @@ -312,6 +312,7 @@ Option Explicit Dim curTool As Byte Dim curButton As Byte Public xPos As Integer, yPos As Integer +Dim formHeight As Integer Public collapsed As Boolean Dim hotKeys(0 To 13) As Byte @@ -346,6 +347,8 @@ Private Sub Form_Load() On Error GoTo ErrorHandler SetColors + + formHeight = Me.ScaleHeight setForm @@ -361,6 +364,22 @@ Public Sub setForm() Me.left = xPos * Screen.TwipsPerPixelX Me.Top = yPos * Screen.TwipsPerPixelY + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub picTitle_DblClick() + + collapsed = Not collapsed + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If End Sub From f309896cf2ec7052bd4c9b23d1cd1392967478d7 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sun, 6 Sep 2020 07:03:47 +0200 Subject: [PATCH 32/57] Modify execute form snapping for palette in like for other windows --- frmPalette.frm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/frmPalette.frm b/frmPalette.frm index 73129e0..7e8335b 100644 --- a/frmPalette.frm +++ b/frmPalette.frm @@ -1081,9 +1081,10 @@ Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, ReleaseCapture SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - snapForm Me, frmDisplay - snapForm Me, frmWaypoints snapForm Me, frmTools + ' snapForm Me, frmPalette + snapForm Me, frmWaypoints + snapForm Me, frmDisplay snapForm Me, frmScenery snapForm Me, frmInfo snapForm Me, frmTexture From 3fec1a391b2f4b897d6df6c24a3c9a0c65552417 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 21 Jan 2021 20:40:51 +0100 Subject: [PATCH 33/57] Modify update checklist instructions --- READ THIS/checklists.md | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/READ THIS/checklists.md b/READ THIS/checklists.md index 3ef1713..c0ea479 100644 --- a/READ THIS/checklists.md +++ b/READ THIS/checklists.md @@ -4,9 +4,10 @@ Checklists Commit ------ -* Save vb6 project -* Build and move any needed files to the installer directory -* Compile installer and test it +* Save vb6 project (Menu->File->Save Project) +* Build project (Menu->File->Make Soldat PolyWorks.exe) +* Move any needed files to the installer directory (/Soldat PolyWorks.exe into /pwinstall) +* Compile installer and test it (open /pwinstall/pw.nsi with makensisw.exe) * Test everything new/changed/fixed * Commit files and changelog * Done! From 2254b19b5b689441bbdb88bcca5a688aed47df16 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 21 Jan 2021 23:38:05 +0100 Subject: [PATCH 34/57] Fix wrong line endings cause loading errors in vb6 --- .gitattributes | 24 + frmDisplay.frm | 1386 +- frmInfo.frm | 4284 +++--- frmMap.frm | 1718 +-- frmPalette.frm | 2350 +-- frmPreferences.frm | 5220 +++---- frmScenery.frm | 1470 +- frmSoldatMapEditor.frm | 30104 +++++++++++++++++++-------------------- frmTaskBar.frm | 144 +- frmTexture.frm | 642 +- frmTools.frm | 958 +- frmWaypoints.frm | 1636 +-- modSME.bas | 1752 +-- prjSoldatMapEditor.vbp | 112 +- 14 files changed, 25912 insertions(+), 25888 deletions(-) create mode 100644 .gitattributes diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..3706e4e --- /dev/null +++ b/.gitattributes @@ -0,0 +1,24 @@ +# visual basic 6 expects crfl +*.bas text eol=crlf +*.cls text eol=crlf +*.dsr text eol=crlf +*.frm text eol=crlf +*.vbp text eol=crlf +*.vbw text eol=crlf + +*.RES binary +*.aps binary +*.bin binary +*.dll binary +*.exe binary +*.exe.compat binary +*.frx binary +*.gif binary +*.ico binary +*.ism binary +*.ncb binary +*.ocx binary +*.ocx.bin binary +*.ocx.compat binary +*.res binary +*.tlb binary diff --git a/frmDisplay.frm b/frmDisplay.frm index 9cd13db..06b1c0c 100644 --- a/frmDisplay.frm +++ b/frmDisplay.frm @@ -1,693 +1,693 @@ -VERSION 5.00 -Begin VB.Form frmDisplay - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 1 'Fixed Single - ClientHeight = 2400 - ClientLeft = 15 - ClientTop = 15 - ClientWidth = 3120 - ControlBox = 0 'False - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 160 - ScaleMode = 3 'Pixel - ScaleWidth = 208 - ShowInTaskbar = 0 'False - StartUpPosition = 3 'Windows Default - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 10 - Left = 1800 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 22 - Tag = "4" - Top = 840 - Width = 240 - End - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 9 - Left = 1800 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 20 - Tag = "4" - Top = 600 - Width = 240 - End - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 8 - Left = 1800 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 17 - Tag = "4" - Top = 360 - Width = 240 - End - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 5 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 15 - Tag = "4" - Top = 840 - Width = 240 - End - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 0 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 11 - Tag = "4" - Top = 2040 - Width = 240 - End - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 1 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 10 - Tag = "4" - Top = 1800 - Width = 240 - End - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 2 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 9 - Tag = "4" - Top = 1560 - Width = 240 - End - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 3 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 8 - Tag = "4" - Top = 1320 - Width = 240 - End - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 4 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 7 - Tag = "4" - Top = 1080 - Width = 240 - End - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 255 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 208 - TabIndex = 0 - TabStop = 0 'False - Top = 0 - Width = 3120 - Begin VB.PictureBox picHide - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 2880 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 1 - TabStop = 0 'False - Tag = "3" - Top = 0 - Width = 240 - End - End - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 6 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 16 - Tag = "4" - Top = 600 - Width = 240 - End - Begin VB.PictureBox picLayer - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 7 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 18 - Tag = "4" - Top = 360 - Width = 240 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Sketch" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 10 - Left = 2040 - TabIndex = 23 - Tag = "font2" - Top = 840 - Width = 855 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Lights" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 9 - Left = 2040 - TabIndex = 21 - Tag = "font2" - Top = 600 - Width = 855 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Waypoints" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 7 - Left = 360 - TabIndex = 19 - Tag = "font2" - Top = 360 - Width = 1455 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Scenery" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 5 - Left = 360 - TabIndex = 14 - Tag = "font2" - Top = 840 - Width = 1455 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Objects" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 6 - Left = 360 - TabIndex = 13 - Tag = "font2" - Top = 600 - Width = 1455 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Grid" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 8 - Left = 2040 - TabIndex = 12 - Tag = "font2" - Top = 360 - Width = 735 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Background" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 360 - TabIndex = 6 - Tag = "font2" - Top = 2040 - Width = 1455 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Polygons" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 360 - TabIndex = 5 - Tag = "font2" - Top = 1800 - Width = 1455 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Texture" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 360 - TabIndex = 4 - Tag = "font2" - Top = 1560 - Width = 1455 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Wireframe" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 3 - Left = 360 - TabIndex = 3 - Tag = "font2" - Top = 1320 - Width = 1455 - End - Begin VB.Label lblLayer - Appearance = 0 'Flat - BackColor = &H80000005& - BackStyle = 0 'Transparent - Caption = " Points" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 4 - Left = 360 - TabIndex = 2 - Tag = "font2" - Top = 1080 - Width = 1455 - End -End -Attribute VB_Name = "frmDisplay" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Const LAYER_BG As Byte = 0 -Const LAYER_POLYS As Byte = 1 -Const LAYER_TEXTURE As Byte = 2 -Const LAYER_WIREFRAME As Byte = 3 -Const LAYER_POINTS As Byte = 4 -Const LAYER_SCENERY As Byte = 5 -Const LAYER_OBJECTS As Byte = 6 -Const LAYER_WAYPOINTS As Byte = 7 -Const LAYER_GRID As Byte = 8 - -Dim layers(0 To 10) As Boolean -Dim layerKeys(0 To 7) As Byte - -Dim formHeight As Integer -Public collapsed As Boolean - -Public xPos As Integer, yPos As Integer - -Public Function getLayerKey(ByVal Index As Byte) As Byte - - getLayerKey = layerKeys(Index) - -End Function - -Public Sub setLayerKey(Index As Integer, ByVal value As Byte) - - If value > 0 Then - layerKeys(Index) = value - End If - -End Sub - -Private Sub Form_GotFocus() - - Beep - -End Sub - -Private Sub Form_Load() - - Dim i As Integer - - On Error GoTo ErrorHandler - - Me.SetColors - - formHeight = Me.ScaleHeight - - setForm - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading Display form" - -End Sub - -Public Sub setForm() - - Me.left = xPos * Screen.TwipsPerPixelX - Me.Top = yPos * Screen.TwipsPerPixelY - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Public Sub setLayer(Index As Integer, value As Boolean) - - layers(Index) = value - mouseEvent2 picLayer(Index), 0, 0, BUTTON_SMALL, layers(Index), BUTTON_UP - -End Sub - -Private Sub lblLayer_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - picLayer_MouseMove Index, Button, 0, 0, 0 - -End Sub - -Public Sub picLayer_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picLayer(Index), X, Y, BUTTON_SMALL, layers(Index), BUTTON_DOWN - -End Sub - -Private Sub picLayer_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picLayer(Index), X, Y, BUTTON_SMALL, layers(Index), BUTTON_MOVE, lblLayer(Index).Width + 16 - -End Sub - -Public Sub picLayer_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - layers(Index) = Not layers(Index) - frmSoldatMapEditor.setDispOptions Index, layers(Index) - mouseEvent2 frmDisplay.picLayer(Index), 0, 0, BUTTON_SMALL, layers(Index), BUTTON_UP - -End Sub - - -Private Sub picTitle_DblClick() - - collapsed = Not collapsed - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - - snapForm Me, frmPalette - snapForm Me, frmWaypoints - snapForm Me, frmTools - snapForm Me, frmScenery - snapForm Me, frmInfo - snapForm Me, frmTexture - Me.Tag = snapForm(Me, frmSoldatMapEditor) - - xPos = Me.left / Screen.TwipsPerPixelX - yPos = Me.Top / Screen.TwipsPerPixelY - -End Sub - -Private Sub picHide_Click() - - Me.Hide - frmSoldatMapEditor.mnuDisplay.Checked = False - -End Sub - -Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Public Sub refreshButtons() - - Dim i As Integer - - For i = 0 To 10 - mouseEvent2 picLayer(i), 0, 0, BUTTON_SMALL, layers(i), BUTTON_UP - Next - -End Sub - -Public Sub SetColors() - - On Error Resume Next - - Dim i As Integer - Dim c As Control - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_display.bmp") - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - - Me.BackColor = bgClr - - For i = 0 To 10 - lblLayer(i).BackColor = lblBackClr - lblLayer(i).ForeColor = lblTextClr - Next - - For Each c In Me.Controls - If c.Tag = "font1" Then - c.Font.Name = font1 - ElseIf c.Tag = "font2" Then - c.Font.Name = font2 - End If - Next - -End Sub +VERSION 5.00 +Begin VB.Form frmDisplay + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 1 'Fixed Single + ClientHeight = 2400 + ClientLeft = 15 + ClientTop = 15 + ClientWidth = 3120 + ControlBox = 0 'False + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 160 + ScaleMode = 3 'Pixel + ScaleWidth = 208 + ShowInTaskbar = 0 'False + StartUpPosition = 3 'Windows Default + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 10 + Left = 1800 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 22 + Tag = "4" + Top = 840 + Width = 240 + End + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 9 + Left = 1800 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 20 + Tag = "4" + Top = 600 + Width = 240 + End + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 8 + Left = 1800 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 17 + Tag = "4" + Top = 360 + Width = 240 + End + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 5 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 15 + Tag = "4" + Top = 840 + Width = 240 + End + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 0 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 11 + Tag = "4" + Top = 2040 + Width = 240 + End + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 1 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 10 + Tag = "4" + Top = 1800 + Width = 240 + End + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 2 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 9 + Tag = "4" + Top = 1560 + Width = 240 + End + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 3 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 8 + Tag = "4" + Top = 1320 + Width = 240 + End + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 4 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 7 + Tag = "4" + Top = 1080 + Width = 240 + End + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 255 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 208 + TabIndex = 0 + TabStop = 0 'False + Top = 0 + Width = 3120 + Begin VB.PictureBox picHide + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 2880 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 1 + TabStop = 0 'False + Tag = "3" + Top = 0 + Width = 240 + End + End + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 6 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 16 + Tag = "4" + Top = 600 + Width = 240 + End + Begin VB.PictureBox picLayer + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 7 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 18 + Tag = "4" + Top = 360 + Width = 240 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Sketch" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 10 + Left = 2040 + TabIndex = 23 + Tag = "font2" + Top = 840 + Width = 855 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Lights" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 9 + Left = 2040 + TabIndex = 21 + Tag = "font2" + Top = 600 + Width = 855 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Waypoints" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 7 + Left = 360 + TabIndex = 19 + Tag = "font2" + Top = 360 + Width = 1455 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Scenery" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 5 + Left = 360 + TabIndex = 14 + Tag = "font2" + Top = 840 + Width = 1455 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Objects" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 6 + Left = 360 + TabIndex = 13 + Tag = "font2" + Top = 600 + Width = 1455 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Grid" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 8 + Left = 2040 + TabIndex = 12 + Tag = "font2" + Top = 360 + Width = 735 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Background" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 360 + TabIndex = 6 + Tag = "font2" + Top = 2040 + Width = 1455 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Polygons" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 360 + TabIndex = 5 + Tag = "font2" + Top = 1800 + Width = 1455 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Texture" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 360 + TabIndex = 4 + Tag = "font2" + Top = 1560 + Width = 1455 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Wireframe" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 3 + Left = 360 + TabIndex = 3 + Tag = "font2" + Top = 1320 + Width = 1455 + End + Begin VB.Label lblLayer + Appearance = 0 'Flat + BackColor = &H80000005& + BackStyle = 0 'Transparent + Caption = " Points" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 4 + Left = 360 + TabIndex = 2 + Tag = "font2" + Top = 1080 + Width = 1455 + End +End +Attribute VB_Name = "frmDisplay" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Const LAYER_BG As Byte = 0 +Const LAYER_POLYS As Byte = 1 +Const LAYER_TEXTURE As Byte = 2 +Const LAYER_WIREFRAME As Byte = 3 +Const LAYER_POINTS As Byte = 4 +Const LAYER_SCENERY As Byte = 5 +Const LAYER_OBJECTS As Byte = 6 +Const LAYER_WAYPOINTS As Byte = 7 +Const LAYER_GRID As Byte = 8 + +Dim layers(0 To 10) As Boolean +Dim layerKeys(0 To 7) As Byte + +Dim formHeight As Integer +Public collapsed As Boolean + +Public xPos As Integer, yPos As Integer + +Public Function getLayerKey(ByVal Index As Byte) As Byte + + getLayerKey = layerKeys(Index) + +End Function + +Public Sub setLayerKey(Index As Integer, ByVal value As Byte) + + If value > 0 Then + layerKeys(Index) = value + End If + +End Sub + +Private Sub Form_GotFocus() + + Beep + +End Sub + +Private Sub Form_Load() + + Dim i As Integer + + On Error GoTo ErrorHandler + + Me.SetColors + + formHeight = Me.ScaleHeight + + setForm + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading Display form" + +End Sub + +Public Sub setForm() + + Me.left = xPos * Screen.TwipsPerPixelX + Me.Top = yPos * Screen.TwipsPerPixelY + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Public Sub setLayer(Index As Integer, value As Boolean) + + layers(Index) = value + mouseEvent2 picLayer(Index), 0, 0, BUTTON_SMALL, layers(Index), BUTTON_UP + +End Sub + +Private Sub lblLayer_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + picLayer_MouseMove Index, Button, 0, 0, 0 + +End Sub + +Public Sub picLayer_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picLayer(Index), X, Y, BUTTON_SMALL, layers(Index), BUTTON_DOWN + +End Sub + +Private Sub picLayer_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picLayer(Index), X, Y, BUTTON_SMALL, layers(Index), BUTTON_MOVE, lblLayer(Index).Width + 16 + +End Sub + +Public Sub picLayer_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + layers(Index) = Not layers(Index) + frmSoldatMapEditor.setDispOptions Index, layers(Index) + mouseEvent2 frmDisplay.picLayer(Index), 0, 0, BUTTON_SMALL, layers(Index), BUTTON_UP + +End Sub + + +Private Sub picTitle_DblClick() + + collapsed = Not collapsed + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + + snapForm Me, frmPalette + snapForm Me, frmWaypoints + snapForm Me, frmTools + snapForm Me, frmScenery + snapForm Me, frmInfo + snapForm Me, frmTexture + Me.Tag = snapForm(Me, frmSoldatMapEditor) + + xPos = Me.left / Screen.TwipsPerPixelX + yPos = Me.Top / Screen.TwipsPerPixelY + +End Sub + +Private Sub picHide_Click() + + Me.Hide + frmSoldatMapEditor.mnuDisplay.Checked = False + +End Sub + +Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Public Sub refreshButtons() + + Dim i As Integer + + For i = 0 To 10 + mouseEvent2 picLayer(i), 0, 0, BUTTON_SMALL, layers(i), BUTTON_UP + Next + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + Dim i As Integer + Dim c As Control + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_display.bmp") + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + + Me.BackColor = bgClr + + For i = 0 To 10 + lblLayer(i).BackColor = lblBackClr + lblLayer(i).ForeColor = lblTextClr + Next + + For Each c In Me.Controls + If c.Tag = "font1" Then + c.Font.Name = font1 + ElseIf c.Tag = "font2" Then + c.Font.Name = font2 + End If + Next + +End Sub diff --git a/frmInfo.frm b/frmInfo.frm index 17aa7e3..48503ff 100644 --- a/frmInfo.frm +++ b/frmInfo.frm @@ -1,2142 +1,2142 @@ -VERSION 5.00 -Begin VB.Form frmInfo - BackColor = &H004A3C31& - BorderStyle = 1 'Fixed Single - ClientHeight = 3120 - ClientLeft = 120 - ClientTop = 120 - ClientWidth = 3120 - ControlBox = 0 'False - KeyPreview = -1 'True - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 208 - ScaleMode = 3 'Pixel - ScaleWidth = 208 - ShowInTaskbar = 0 'False - StartUpPosition = 3 'Windows Default - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 255 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 208 - TabIndex = 16 - TabStop = 0 'False - Top = 0 - Width = 3120 - Begin VB.PictureBox picPropMenu - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 2640 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 38 - TabStop = 0 'False - Tag = "8" - Top = 0 - Width = 240 - End - Begin VB.PictureBox picHide - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 2880 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 17 - TabStop = 0 'False - Tag = "3" - Top = 0 - Width = 240 - End - End - Begin VB.CommandButton cmdDefault - Default = -1 'True - Height = 495 - Left = 240 - TabIndex = 39 - TabStop = 0 'False - Top = 3240 - Width = 495 - End - Begin VB.PictureBox picProp - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 1935 - Index = 4 - Left = 120 - ScaleHeight = 129 - ScaleMode = 3 'Pixel - ScaleWidth = 193 - TabIndex = 66 - TabStop = 0 'False - Top = 360 - Visible = 0 'False - Width = 2895 - Begin VB.TextBox txtLightProp - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 1 - Left = 1320 - TabIndex = 74 - Tag = "font1" - Top = 480 - Width = 615 - End - Begin VB.TextBox txtLightProp - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 0 - Left = 1320 - TabIndex = 72 - Tag = "font1" - Top = 120 - Width = 615 - End - Begin VB.TextBox txtLightProp - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 2 - Left = 1320 - TabIndex = 68 - Tag = "font1" - Top = 840 - Visible = 0 'False - Width = 615 - End - Begin VB.PictureBox picLight - Appearance = 0 'Flat - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 495 - Left = 2280 - ScaleHeight = 465 - ScaleWidth = 465 - TabIndex = 67 - Top = 120 - Width = 495 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Range:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 31 - Left = 120 - TabIndex = 73 - Tag = "font2" - Top = 480 - Width = 1095 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Z-coord:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 30 - Left = 120 - TabIndex = 71 - Tag = "font2" - Top = 120 - Width = 1095 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Intensity:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 29 - Left = 120 - TabIndex = 70 - Tag = "font2" - Top = 840 - Visible = 0 'False - Width = 1095 - End - Begin VB.Label lblInfo - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 28 - Left = 1920 - TabIndex = 69 - Tag = "font2" - Top = 840 - Visible = 0 'False - Width = 255 - End - End - Begin VB.PictureBox picProp - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 1935 - Index = 5 - Left = 120 - ScaleHeight = 129 - ScaleMode = 3 'Pixel - ScaleWidth = 193 - TabIndex = 49 - TabStop = 0 'False - Top = 360 - Width = 2895 - Begin VB.Label lblCount - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "0x0" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 6 - Left = 1680 - TabIndex = 65 - Tag = "font1" - Top = 1560 - Width = 1095 - End - Begin VB.Label lblInfo - BackStyle = 0 'Transparent - Caption = "Dimensions:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 27 - Left = 120 - TabIndex = 64 - Tag = "font2" - Top = 1560 - Width = 1335 - End - Begin VB.Label lblCount - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "500" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 5 - Left = 1680 - TabIndex = 61 - Tag = "font1" - Top = 1320 - Width = 1095 - End - Begin VB.Label lblCount - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "500/500" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 4 - Left = 1680 - TabIndex = 60 - Tag = "font1" - Top = 1080 - Width = 1095 - End - Begin VB.Label lblCount - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "128/128" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 3 - Left = 1680 - TabIndex = 59 - Tag = "font1" - Top = 840 - Width = 1095 - End - Begin VB.Label lblCount - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "128/128" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 1680 - TabIndex = 58 - Tag = "font1" - Top = 600 - Width = 1095 - End - Begin VB.Label lblCount - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "500/500 (500)" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 1380 - TabIndex = 57 - Tag = "font1" - Top = 360 - Width = 1395 - End - Begin VB.Label lblCount - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "5000" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 1680 - TabIndex = 56 - Tag = "font1" - Top = 120 - Width = 1095 - End - Begin VB.Label lblInfo - BackStyle = 0 'Transparent - Caption = "Connections:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 9 - Left = 120 - TabIndex = 55 - Tag = "font2" - Top = 1320 - Width = 1335 - End - Begin VB.Label lblInfo - BackStyle = 0 'Transparent - Caption = "Waypoints:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 8 - Left = 120 - TabIndex = 54 - Tag = "font2" - Top = 1080 - Width = 1335 - End - Begin VB.Label lblInfo - BackStyle = 0 'Transparent - Caption = "Spawns:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 25 - Left = 120 - TabIndex = 53 - Tag = "font2" - Top = 600 - Width = 1335 - End - Begin VB.Label lblInfo - BackStyle = 0 'Transparent - Caption = "Colliders:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 26 - Left = 120 - TabIndex = 52 - Tag = "font2" - Top = 840 - Width = 1335 - End - Begin VB.Label lblInfo - BackStyle = 0 'Transparent - Caption = "Polygons:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 23 - Left = 120 - TabIndex = 51 - Tag = "font2" - Top = 120 - Width = 1335 - End - Begin VB.Label lblInfo - BackStyle = 0 'Transparent - Caption = "Scenery:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 24 - Left = 120 - TabIndex = 50 - Tag = "font2" - Top = 360 - Width = 1335 - End - End - Begin VB.PictureBox picProp - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 1935 - Index = 1 - Left = 120 - ScaleHeight = 129 - ScaleMode = 3 'Pixel - ScaleWidth = 193 - TabIndex = 23 - TabStop = 0 'False - Top = 360 - Visible = 0 'False - Width = 2895 - Begin VB.TextBox txtScenProp - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 0 - Left = 1680 - TabIndex = 4 - Tag = "font1" - Top = 120 - Width = 735 - End - Begin VB.TextBox txtScenProp - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 1 - Left = 1680 - TabIndex = 5 - Tag = "font1" - Top = 480 - Width = 735 - End - Begin VB.TextBox txtScenProp - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 2 - Left = 1320 - TabIndex = 7 - Tag = "font1" - Top = 1200 - Width = 615 - End - Begin VB.TextBox txtScenProp - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 3 - Left = 1320 - TabIndex = 8 - Tag = "font1" - Top = 1560 - Width = 615 - End - Begin VB.ComboBox cboLevel - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - ItemData = "frmInfo.frx":0000 - Left = 1320 - List = "frmInfo.frx":000D - Style = 2 'Dropdown List - TabIndex = 6 - Tag = "font1" - Top = 840 - Width = 1095 - End - Begin VB.Label lblInfo - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 20 - Left = 2400 - TabIndex = 46 - Tag = "font2" - Top = 480 - Width = 255 - End - Begin VB.Label lblInfo - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 19 - Left = 2400 - TabIndex = 45 - Tag = "font2" - Top = 120 - Width = 255 - End - Begin VB.Label lblInfo - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 21 - Left = 1920 - TabIndex = 31 - Tag = "font2" - Top = 1200 - Width = 255 - End - Begin VB.Label lblInfo - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "°" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 22 - Left = 1920 - TabIndex = 30 - Tag = "font2" - Top = 1560 - Width = 255 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Scaling:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 4 - Left = 120 - TabIndex = 29 - Tag = "font2" - Top = 120 - Width = 1095 - End - Begin VB.Label lblInfo - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "X:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00E0E0E0& - Height = 255 - Index = 17 - Left = 1320 - TabIndex = 28 - Tag = "font2" - Top = 120 - Width = 255 - End - Begin VB.Label lblInfo - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "Y:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00E0E0E0& - Height = 255 - Index = 18 - Left = 1320 - TabIndex = 27 - Tag = "font2" - Top = 480 - Width = 255 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Opacity:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 6 - Left = 120 - TabIndex = 26 - Tag = "font2" - Top = 1200 - Width = 1095 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Rotation:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 7 - Left = 120 - TabIndex = 25 - Tag = "font2" - Top = 1560 - Width = 1095 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Level:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 5 - Left = 120 - TabIndex = 24 - Tag = "font2" - Top = 840 - Width = 1095 - End - End - Begin VB.PictureBox picProp - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 1935 - Index = 3 - Left = 120 - ScaleHeight = 129 - ScaleMode = 3 'Pixel - ScaleWidth = 193 - TabIndex = 22 - TabStop = 0 'False - Top = 360 - Visible = 0 'False - Width = 2895 - Begin VB.TextBox txtQuadX - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 2160 - TabIndex = 11 - Tag = "font1" - Text = "128" - Top = 1200 - Width = 615 - End - Begin VB.TextBox txtQuadY - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 2160 - TabIndex = 12 - Tag = "font1" - Text = "0" - Top = 1440 - Width = 615 - End - Begin VB.TextBox txtQuadY - Alignment = 1 'Right Justify - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 120 - TabIndex = 10 - Tag = "font1" - Text = "0" - Top = 840 - Width = 615 - End - Begin VB.TextBox txtQuadX - Alignment = 1 'Right Justify - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 120 - TabIndex = 9 - Tag = "font1" - Text = "0" - Top = 600 - Width = 615 - End - Begin VB.Label lblHeight - BackStyle = 0 'Transparent - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 2400 - TabIndex = 63 - Top = 120 - Width = 495 - End - Begin VB.Label lblDimensions - BackStyle = 0 'Transparent - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 120 - TabIndex = 62 - Tag = "font2" - Top = 0 - Width = 2655 - End - Begin VB.Line diagonal - BorderColor = &H00FFFFFF& - X1 = 64 - X2 = 128 - Y1 = 40 - Y2 = 104 - End - Begin VB.Shape square - BorderColor = &H00FFFFFF& - Height = 975 - Left = 960 - Top = 600 - Width = 975 - End - End - Begin VB.PictureBox picProp - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 1935 - Index = 2 - Left = 120 - ScaleHeight = 129 - ScaleMode = 3 'Pixel - ScaleWidth = 193 - TabIndex = 34 - TabStop = 0 'False - Top = 360 - Visible = 0 'False - Width = 2895 - Begin VB.TextBox txtRotate - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Left = 1320 - TabIndex = 15 - Tag = "font1" - Top = 840 - Width = 735 - End - Begin VB.TextBox txtScale - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 1 - Left = 1680 - TabIndex = 14 - Tag = "font1" - Top = 480 - Width = 735 - End - Begin VB.TextBox txtScale - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 0 - Left = 1680 - TabIndex = 13 - Tag = "font1" - Top = 120 - Width = 735 - End - Begin VB.Label lblInfo - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 12 - Left = 2400 - TabIndex = 48 - Tag = "font2" - Top = 120 - Width = 255 - End - Begin VB.Label lblInfo - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 13 - Left = 2400 - TabIndex = 47 - Tag = "font2" - Top = 480 - Width = 255 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Rotation:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 120 - TabIndex = 44 - Tag = "font2" - Top = 840 - Width = 1095 - End - Begin VB.Label lblInfo - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "Y:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00E0E0E0& - Height = 255 - Index = 11 - Left = 1320 - TabIndex = 43 - Tag = "font2" - Top = 480 - Width = 255 - End - Begin VB.Label lblInfo - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "X:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00E0E0E0& - Height = 255 - Index = 10 - Left = 1320 - TabIndex = 42 - Tag = "font2" - Top = 120 - Width = 255 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Scaling:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 120 - TabIndex = 41 - Tag = "font2" - Top = 120 - Width = 1095 - End - Begin VB.Label lblInfo - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "°" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 14 - Left = 2040 - TabIndex = 40 - Tag = "font2" - Top = 840 - Width = 255 - End - End - Begin VB.PictureBox picProp - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 1935 - Index = 0 - Left = 120 - ScaleHeight = 129 - ScaleMode = 3 'Pixel - ScaleWidth = 193 - TabIndex = 32 - TabStop = 0 'False - Top = 360 - Visible = 0 'False - Width = 2895 - Begin VB.TextBox txtBounciness - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Left = 1560 - TabIndex = 78 - Tag = "font1" - Top = 1680 - Width = 615 - End - Begin VB.TextBox txtVertexAlpha - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Left = 1560 - TabIndex = 3 - Tag = "font1" - Top = 1320 - Width = 615 - End - Begin VB.TextBox txtTexture - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 1 - Left = 1560 - TabIndex = 2 - Tag = "font1" - Top = 960 - Width = 975 - End - Begin VB.TextBox txtTexture - Appearance = 0 'Flat - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 255 - Index = 0 - Left = 1560 - TabIndex = 1 - Tag = "font1" - Top = 600 - Width = 975 - End - Begin VB.ComboBox cboPolyType - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - ItemData = "frmInfo.frx":0026 - Left = 840 - List = "frmInfo.frx":0078 - Style = 2 'Dropdown List - TabIndex = 0 - Tag = "font1" - Top = 120 - Width = 1935 - End - Begin VB.Label lblInfo - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 35 - Left = 2160 - TabIndex = 79 - Tag = "font2" - Top = 1680 - Width = 255 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Bounciness:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 34 - Left = 120 - TabIndex = 77 - Tag = "font2" - Top = 1680 - Width = 1335 - End - Begin VB.Label lblInfo - Alignment = 2 'Center - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 33 - Left = 2160 - TabIndex = 76 - Tag = "font2" - Top = 1320 - Width = 255 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Opacity:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 32 - Left = 120 - TabIndex = 75 - Tag = "font2" - Top = 1320 - Width = 975 - End - Begin VB.Label lblInfo - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "Y:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00E0E0E0& - Height = 255 - Index = 16 - Left = 1200 - TabIndex = 37 - Tag = "font2" - Top = 960 - Width = 255 - End - Begin VB.Label lblInfo - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - Caption = "X:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00E0E0E0& - Height = 255 - Index = 15 - Left = 1200 - TabIndex = 36 - Tag = "font2" - Top = 600 - Width = 255 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Texture:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 3 - Left = 120 - TabIndex = 35 - Tag = "font2" - Top = 600 - Width = 975 - End - Begin VB.Label lblInfo - BackColor = &H00614B3D& - Caption = "Type:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 120 - TabIndex = 33 - Tag = "font2" - Top = 120 - Width = 615 - End - End - Begin VB.Label lblIndex - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 2280 - TabIndex = 21 - Tag = "font1" - Top = 2400 - Width = 735 - End - Begin VB.Label lblSelScenery - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 120 - TabIndex = 20 - Tag = "font1" - Top = 2760 - Width = 2895 - End - Begin VB.Label lblSelPolys - BackStyle = 0 'Transparent - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 120 - TabIndex = 19 - Top = 2760 - Width = 1335 - End - Begin VB.Label lblCoords - BackStyle = 0 'Transparent - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 120 - TabIndex = 18 - Tag = "font1" - Top = 2400 - Width = 2055 - End - Begin VB.Menu mnuProperties - Caption = "Properties" - Visible = 0 'False - Begin VB.Menu mnuProp - Caption = "Polygon Properties" - Index = 0 - End - Begin VB.Menu mnuProp - Caption = "Scenery Properties" - Index = 1 - End - Begin VB.Menu mnuProp - Caption = "Transform" - Index = 2 - End - Begin VB.Menu mnuProp - Caption = "Texture Settings" - Index = 3 - End - Begin VB.Menu mnuProp - Caption = "Light Properties" - Index = 4 - End - Begin VB.Menu mnuProp - Caption = "Map Info" - Checked = -1 'True - Index = 5 - End - End -End -Attribute VB_Name = "frmInfo" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Dim formHeight As Integer -Public collapsed As Boolean - -Dim tempVal As Single - -Public xPos As Integer, yPos As Integer -Public noChange As Boolean -Private applyChange As Boolean - -Private Sub Form_Load() - - On Error GoTo ErrorHandler - - Me.SetColors - - formHeight = Me.ScaleHeight - - setForm - - - cboPolyType.ListIndex = 0 - lblDimensions.Caption = "Dimensions: " & frmSoldatMapEditor.xTexture & " x " & frmSoldatMapEditor.yTexture - txtQuadX(0).Text = 0 - txtQuadY(0).Text = 0 - txtQuadX(1).Text = frmSoldatMapEditor.xTexture - txtQuadY(1).Text = frmSoldatMapEditor.yTexture - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading Properties form" - -End Sub - -Public Sub setForm() - - Me.left = xPos * Screen.TwipsPerPixelX - Me.Top = yPos * Screen.TwipsPerPixelY - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub cboPolyType_Click() - - If Not noChange Then - frmSoldatMapEditor.applyPolyType cboPolyType.ListIndex - End If - - If cboPolyType.ListIndex = 18 Then - txtBounciness.Enabled = True - Else - txtBounciness.Enabled = False - End If - -End Sub - -Private Sub txtLightProp_GotFocus(Index As Integer) - - If IsNumeric(txtLightProp(Index).Text) Then - tempVal = txtLightProp(Index).Text - End If - SelectAllText txtLightProp(Index) - -End Sub - -Private Sub txtLightProp_LostFocus(Index As Integer) - - If IsNumeric(txtLightProp(Index).Text) And applyChange Then - If Index = 0 Then - frmSoldatMapEditor.applyLightProp txtLightProp(Index).Text, Index - ElseIf Index = 1 And txtLightProp(Index).Text >= 0 Then - frmSoldatMapEditor.applyLightProp txtLightProp(Index).Text, Index - ElseIf Index = 1 And txtLightProp(Index).Text >= 0 And txtLightProp(Index).Text <= 100 Then - Else - txtLightProp(Index).Text = tempVal - End If - Else - txtLightProp(Index).Text = tempVal - End If - tempVal = 0 - - applyChange = False - -End Sub - -Private Sub picLight_Click() - - frmSoldatMapEditor.setLightColor - -End Sub - -Private Sub txtQuadX_GotFocus(Index As Integer) - - If IsNumeric(txtQuadX(Index).Text) Then - tempVal = txtQuadX(Index).Text - End If - SelectAllText txtQuadX(Index) - -End Sub - -Private Sub txtQuadX_LostFocus(Index As Integer) - - If Not IsNumeric(txtQuadX(Index).Text) Then - txtQuadX(Index).Text = tempVal - ElseIf txtQuadX(Index).Text < 0 Or txtQuadX(Index).Text > frmSoldatMapEditor.xTexture Then - txtQuadX(Index).Text = tempVal - Else - frmTexture.setTexCoords txtQuadX(Index).Text, Index - End If - tempVal = 0 - -End Sub - -Private Sub txtQuadY_GotFocus(Index As Integer) - - If IsNumeric(txtQuadY(Index).Text) Then - tempVal = txtQuadY(Index).Text - End If - SelectAllText txtQuadY(Index) - -End Sub - -Private Sub txtQuadY_LostFocus(Index As Integer) - - If Not IsNumeric(txtQuadY(Index).Text) Then - txtQuadY(Index).Text = tempVal - ElseIf txtQuadY(Index).Text < 0 Or txtQuadY(Index).Text > frmSoldatMapEditor.yTexture Then - txtQuadY(Index).Text = tempVal - Else - frmTexture.setTexCoords txtQuadY(Index).Text, Index + 2 - End If - tempVal = 0 - -End Sub - -Private Sub txtRotate_GotFocus() - - If IsNumeric(txtRotate.Text) Then - tempVal = txtRotate.Text - End If - -End Sub - -Private Sub txtRotate_LostFocus() - - If IsNumeric(txtRotate.Text) And applyChange Then - frmSoldatMapEditor.applyRotate (txtRotate.Text / 180 * pi) - Else - txtRotate.Text = tempVal - End If - tempVal = 0 - -End Sub - -Private Sub txtScale_GotFocus(Index As Integer) - - If IsNumeric(txtScale(Index).Text) Then - tempVal = txtScale(Index).Text - End If - -End Sub - -Private Sub txtScale_LostFocus(Index As Integer) - - If IsNumeric(txtScale(Index).Text) And applyChange Then - If Index = 0 Then - frmSoldatMapEditor.applyScale (txtScale(Index).Text / 100), 1 - ElseIf Index = 1 Then - frmSoldatMapEditor.applyScale 1, (txtScale(Index).Text / 100) - End If - Else - txtScale(Index).Text = tempVal - End If - tempVal = 0 - - applyChange = False - -End Sub - -Private Sub cboLevel_Click() - - If Not noChange Then - frmSoldatMapEditor.applySceneryProp cboLevel.ListIndex, 4 - End If - -End Sub - -Private Sub txtScenProp_GotFocus(Index As Integer) - - If IsNumeric(txtScenProp(Index).Text) Then - tempVal = txtScenProp(Index).Text - End If - SelectAllText txtScenProp(Index) - -End Sub - -Private Sub txtScenProp_LostFocus(Index As Integer) - - If IsNumeric(txtScenProp(Index).Text) And applyChange Then - If Index = 0 Or Index = 1 Then - frmSoldatMapEditor.applySceneryProp txtScenProp(Index).Text / 100, Index - ElseIf Index = 2 And txtScenProp(Index).Text >= 0 And txtScenProp(Index).Text <= 100 Then - frmSoldatMapEditor.applySceneryProp (txtScenProp(Index).Text / 100) * 255, Index - ElseIf Index = 3 And txtScenProp(Index).Text >= -360 And txtScenProp(Index).Text <= 360 Then - frmSoldatMapEditor.applySceneryProp txtScenProp(Index).Text / 180 * pi, Index - Else - txtScenProp(Index).Text = tempVal - End If - Else - txtScenProp(Index).Text = tempVal - End If - tempVal = 0 - - applyChange = False - -End Sub - -Private Sub txtTexture_GotFocus(Index As Integer) - - If IsNumeric(txtTexture(Index).Text) Then - tempVal = txtTexture(Index).Text - End If - -End Sub - -Private Sub txtTexture_LostFocus(Index As Integer) - - If IsNumeric(txtTexture(Index).Text) And applyChange Then - frmSoldatMapEditor.applyTextureCoords txtTexture(Index).Text, Index - Else - txtTexture(Index).Text = tempVal - End If - tempVal = 0 - - applyChange = False - -End Sub - -Private Sub txtVertexAlpha_GotFocus() - - If IsNumeric(txtVertexAlpha.Text) Then - tempVal = txtVertexAlpha.Text - End If - -End Sub - -Private Sub txtVertexAlpha_LostFocus() - - If Not IsNumeric(txtVertexAlpha.Text) Then - txtVertexAlpha.Text = tempVal - ElseIf txtVertexAlpha.Text < 0 Or txtVertexAlpha.Text > 100 Then - txtVertexAlpha.Text = tempVal - ElseIf applyChange Then - frmSoldatMapEditor.applyVertexAlpha txtVertexAlpha.Text / 100 - End If - tempVal = 0 - - applyChange = False - -End Sub - -Private Sub txtBounciness_GotFocus() - - If IsNumeric(txtBounciness.Text) Then - tempVal = txtBounciness.Text - End If - -End Sub - -Private Sub txtBounciness_LostFocus() - - If Not IsNumeric(txtBounciness.Text) Then - txtBounciness.Text = tempVal - ElseIf txtBounciness.Text < 0 Then - txtBounciness.Text = tempVal - ElseIf applyChange Then - frmSoldatMapEditor.applyBounciness 1 + (txtBounciness.Text / 100) - End If - tempVal = 0 - - applyChange = False - -End Sub - -Private Sub cmdDefault_Click() - - applyChange = True - cmdDefault.SetFocus - frmSoldatMapEditor.RegainFocus - -End Sub - -Public Sub mnuProp_Click(Index As Integer) - - Dim i As Integer - - For i = 0 To 5 - mnuProp(i).Checked = False - picProp(i).Visible = False - Next - - mnuProp(Index).Checked = True - - picProp(Index).Visible = True - -End Sub - -Private Sub picTitle_DblClick() - - collapsed = Not collapsed - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - - snapForm Me, frmPalette - snapForm Me, frmWaypoints - snapForm Me, frmTools - snapForm Me, frmScenery - snapForm Me, frmDisplay - snapForm Me, frmTexture - Me.Tag = snapForm(Me, frmSoldatMapEditor) - - xPos = Me.left / Screen.TwipsPerPixelX - yPos = Me.Top / Screen.TwipsPerPixelY - -End Sub - -Private Sub picHide_Click() - - Me.Hide - frmSoldatMapEditor.mnuInfo.Checked = False - -End Sub - -Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub picPropMenu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picPropMenu, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - - PopupMenu mnuProperties, , picPropMenu.left + 32, picPropMenu.Top + 16 - - mouseEvent2 picPropMenu, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub picPropMenu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picPropMenu, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Public Sub SetColors() - - On Error Resume Next - - Dim i As Integer - Dim c As Control - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_properties.bmp") - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picPropMenu, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - - Me.BackColor = bgClr - For i = 0 To 35 - lblInfo(i).BackColor = lblBackClr - lblInfo(i).ForeColor = lblTextClr - Next - For i = 0 To 5 - picProp(i).BackColor = bgClr - Next - - For i = 0 To 1 - txtScenProp(i).BackColor = txtBackClr - txtScenProp(i).ForeColor = txtTextClr - txtQuadX(i).BackColor = bgClr - txtQuadX(i).ForeColor = lblTextClr - txtQuadY(i).BackColor = bgClr - txtQuadY(i).ForeColor = lblTextClr - Next - For i = 0 To 1 - txtScale(i).BackColor = txtBackClr - txtScale(i).ForeColor = txtTextClr - txtTexture(i).BackColor = txtBackClr - txtTexture(i).ForeColor = txtTextClr - Next - For i = 0 To 6 - lblCount(i).BackColor = lblBackClr - lblCount(i).ForeColor = lblTextClr - Next - - lblDimensions.BackColor = lblBackClr - lblDimensions.ForeColor = lblTextClr - - txtRotate.BackColor = txtBackClr - txtRotate.ForeColor = txtTextClr - cboLevel.BackColor = txtBackClr - cboLevel.ForeColor = txtTextClr - cboPolyType.BackColor = txtBackClr - cboPolyType.ForeColor = txtTextClr - - txtLightProp(0).BackColor = txtBackClr - txtLightProp(0).ForeColor = txtTextClr - - square.BorderColor = lblTextClr - diagonal.BorderColor = lblTextClr - - For Each c In Me.Controls - If c.Tag = "font1" Then - c.Font.Name = font1 - ElseIf c.Tag = "font2" Then - c.Font.Name = font2 - End If - Next - -End Sub +VERSION 5.00 +Begin VB.Form frmInfo + BackColor = &H004A3C31& + BorderStyle = 1 'Fixed Single + ClientHeight = 3120 + ClientLeft = 120 + ClientTop = 120 + ClientWidth = 3120 + ControlBox = 0 'False + KeyPreview = -1 'True + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 208 + ScaleMode = 3 'Pixel + ScaleWidth = 208 + ShowInTaskbar = 0 'False + StartUpPosition = 3 'Windows Default + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 255 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 208 + TabIndex = 16 + TabStop = 0 'False + Top = 0 + Width = 3120 + Begin VB.PictureBox picPropMenu + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 2640 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 38 + TabStop = 0 'False + Tag = "8" + Top = 0 + Width = 240 + End + Begin VB.PictureBox picHide + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 2880 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 17 + TabStop = 0 'False + Tag = "3" + Top = 0 + Width = 240 + End + End + Begin VB.CommandButton cmdDefault + Default = -1 'True + Height = 495 + Left = 240 + TabIndex = 39 + TabStop = 0 'False + Top = 3240 + Width = 495 + End + Begin VB.PictureBox picProp + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 1935 + Index = 4 + Left = 120 + ScaleHeight = 129 + ScaleMode = 3 'Pixel + ScaleWidth = 193 + TabIndex = 66 + TabStop = 0 'False + Top = 360 + Visible = 0 'False + Width = 2895 + Begin VB.TextBox txtLightProp + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 1 + Left = 1320 + TabIndex = 74 + Tag = "font1" + Top = 480 + Width = 615 + End + Begin VB.TextBox txtLightProp + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 0 + Left = 1320 + TabIndex = 72 + Tag = "font1" + Top = 120 + Width = 615 + End + Begin VB.TextBox txtLightProp + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 2 + Left = 1320 + TabIndex = 68 + Tag = "font1" + Top = 840 + Visible = 0 'False + Width = 615 + End + Begin VB.PictureBox picLight + Appearance = 0 'Flat + BackColor = &H00000000& + ForeColor = &H80000008& + Height = 495 + Left = 2280 + ScaleHeight = 465 + ScaleWidth = 465 + TabIndex = 67 + Top = 120 + Width = 495 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Range:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 31 + Left = 120 + TabIndex = 73 + Tag = "font2" + Top = 480 + Width = 1095 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Z-coord:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 30 + Left = 120 + TabIndex = 71 + Tag = "font2" + Top = 120 + Width = 1095 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Intensity:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 29 + Left = 120 + TabIndex = 70 + Tag = "font2" + Top = 840 + Visible = 0 'False + Width = 1095 + End + Begin VB.Label lblInfo + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 28 + Left = 1920 + TabIndex = 69 + Tag = "font2" + Top = 840 + Visible = 0 'False + Width = 255 + End + End + Begin VB.PictureBox picProp + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 1935 + Index = 5 + Left = 120 + ScaleHeight = 129 + ScaleMode = 3 'Pixel + ScaleWidth = 193 + TabIndex = 49 + TabStop = 0 'False + Top = 360 + Width = 2895 + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "0x0" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 6 + Left = 1680 + TabIndex = 65 + Tag = "font1" + Top = 1560 + Width = 1095 + End + Begin VB.Label lblInfo + BackStyle = 0 'Transparent + Caption = "Dimensions:" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 27 + Left = 120 + TabIndex = 64 + Tag = "font2" + Top = 1560 + Width = 1335 + End + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "500" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 5 + Left = 1680 + TabIndex = 61 + Tag = "font1" + Top = 1320 + Width = 1095 + End + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "500/500" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 4 + Left = 1680 + TabIndex = 60 + Tag = "font1" + Top = 1080 + Width = 1095 + End + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "128/128" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 3 + Left = 1680 + TabIndex = 59 + Tag = "font1" + Top = 840 + Width = 1095 + End + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "128/128" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 1680 + TabIndex = 58 + Tag = "font1" + Top = 600 + Width = 1095 + End + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "500/500 (500)" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 1380 + TabIndex = 57 + Tag = "font1" + Top = 360 + Width = 1395 + End + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "5000" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 1680 + TabIndex = 56 + Tag = "font1" + Top = 120 + Width = 1095 + End + Begin VB.Label lblInfo + BackStyle = 0 'Transparent + Caption = "Connections:" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 9 + Left = 120 + TabIndex = 55 + Tag = "font2" + Top = 1320 + Width = 1335 + End + Begin VB.Label lblInfo + BackStyle = 0 'Transparent + Caption = "Waypoints:" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 8 + Left = 120 + TabIndex = 54 + Tag = "font2" + Top = 1080 + Width = 1335 + End + Begin VB.Label lblInfo + BackStyle = 0 'Transparent + Caption = "Spawns:" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 25 + Left = 120 + TabIndex = 53 + Tag = "font2" + Top = 600 + Width = 1335 + End + Begin VB.Label lblInfo + BackStyle = 0 'Transparent + Caption = "Colliders:" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 26 + Left = 120 + TabIndex = 52 + Tag = "font2" + Top = 840 + Width = 1335 + End + Begin VB.Label lblInfo + BackStyle = 0 'Transparent + Caption = "Polygons:" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 23 + Left = 120 + TabIndex = 51 + Tag = "font2" + Top = 120 + Width = 1335 + End + Begin VB.Label lblInfo + BackStyle = 0 'Transparent + Caption = "Scenery:" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 24 + Left = 120 + TabIndex = 50 + Tag = "font2" + Top = 360 + Width = 1335 + End + End + Begin VB.PictureBox picProp + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 1935 + Index = 1 + Left = 120 + ScaleHeight = 129 + ScaleMode = 3 'Pixel + ScaleWidth = 193 + TabIndex = 23 + TabStop = 0 'False + Top = 360 + Visible = 0 'False + Width = 2895 + Begin VB.TextBox txtScenProp + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 0 + Left = 1680 + TabIndex = 4 + Tag = "font1" + Top = 120 + Width = 735 + End + Begin VB.TextBox txtScenProp + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 1 + Left = 1680 + TabIndex = 5 + Tag = "font1" + Top = 480 + Width = 735 + End + Begin VB.TextBox txtScenProp + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 2 + Left = 1320 + TabIndex = 7 + Tag = "font1" + Top = 1200 + Width = 615 + End + Begin VB.TextBox txtScenProp + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 3 + Left = 1320 + TabIndex = 8 + Tag = "font1" + Top = 1560 + Width = 615 + End + Begin VB.ComboBox cboLevel + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + ItemData = "frmInfo.frx":0000 + Left = 1320 + List = "frmInfo.frx":000D + Style = 2 'Dropdown List + TabIndex = 6 + Tag = "font1" + Top = 840 + Width = 1095 + End + Begin VB.Label lblInfo + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 20 + Left = 2400 + TabIndex = 46 + Tag = "font2" + Top = 480 + Width = 255 + End + Begin VB.Label lblInfo + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 19 + Left = 2400 + TabIndex = 45 + Tag = "font2" + Top = 120 + Width = 255 + End + Begin VB.Label lblInfo + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 21 + Left = 1920 + TabIndex = 31 + Tag = "font2" + Top = 1200 + Width = 255 + End + Begin VB.Label lblInfo + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "°" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 22 + Left = 1920 + TabIndex = 30 + Tag = "font2" + Top = 1560 + Width = 255 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Scaling:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 4 + Left = 120 + TabIndex = 29 + Tag = "font2" + Top = 120 + Width = 1095 + End + Begin VB.Label lblInfo + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "X:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00E0E0E0& + Height = 255 + Index = 17 + Left = 1320 + TabIndex = 28 + Tag = "font2" + Top = 120 + Width = 255 + End + Begin VB.Label lblInfo + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "Y:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00E0E0E0& + Height = 255 + Index = 18 + Left = 1320 + TabIndex = 27 + Tag = "font2" + Top = 480 + Width = 255 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Opacity:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 6 + Left = 120 + TabIndex = 26 + Tag = "font2" + Top = 1200 + Width = 1095 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Rotation:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 7 + Left = 120 + TabIndex = 25 + Tag = "font2" + Top = 1560 + Width = 1095 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Level:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 5 + Left = 120 + TabIndex = 24 + Tag = "font2" + Top = 840 + Width = 1095 + End + End + Begin VB.PictureBox picProp + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 1935 + Index = 3 + Left = 120 + ScaleHeight = 129 + ScaleMode = 3 'Pixel + ScaleWidth = 193 + TabIndex = 22 + TabStop = 0 'False + Top = 360 + Visible = 0 'False + Width = 2895 + Begin VB.TextBox txtQuadX + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 2160 + TabIndex = 11 + Tag = "font1" + Text = "128" + Top = 1200 + Width = 615 + End + Begin VB.TextBox txtQuadY + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 2160 + TabIndex = 12 + Tag = "font1" + Text = "0" + Top = 1440 + Width = 615 + End + Begin VB.TextBox txtQuadY + Alignment = 1 'Right Justify + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 120 + TabIndex = 10 + Tag = "font1" + Text = "0" + Top = 840 + Width = 615 + End + Begin VB.TextBox txtQuadX + Alignment = 1 'Right Justify + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 120 + TabIndex = 9 + Tag = "font1" + Text = "0" + Top = 600 + Width = 615 + End + Begin VB.Label lblHeight + BackStyle = 0 'Transparent + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 2400 + TabIndex = 63 + Top = 120 + Width = 495 + End + Begin VB.Label lblDimensions + BackStyle = 0 'Transparent + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 120 + TabIndex = 62 + Tag = "font2" + Top = 0 + Width = 2655 + End + Begin VB.Line diagonal + BorderColor = &H00FFFFFF& + X1 = 64 + X2 = 128 + Y1 = 40 + Y2 = 104 + End + Begin VB.Shape square + BorderColor = &H00FFFFFF& + Height = 975 + Left = 960 + Top = 600 + Width = 975 + End + End + Begin VB.PictureBox picProp + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 1935 + Index = 2 + Left = 120 + ScaleHeight = 129 + ScaleMode = 3 'Pixel + ScaleWidth = 193 + TabIndex = 34 + TabStop = 0 'False + Top = 360 + Visible = 0 'False + Width = 2895 + Begin VB.TextBox txtRotate + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Left = 1320 + TabIndex = 15 + Tag = "font1" + Top = 840 + Width = 735 + End + Begin VB.TextBox txtScale + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 1 + Left = 1680 + TabIndex = 14 + Tag = "font1" + Top = 480 + Width = 735 + End + Begin VB.TextBox txtScale + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 0 + Left = 1680 + TabIndex = 13 + Tag = "font1" + Top = 120 + Width = 735 + End + Begin VB.Label lblInfo + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 12 + Left = 2400 + TabIndex = 48 + Tag = "font2" + Top = 120 + Width = 255 + End + Begin VB.Label lblInfo + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 13 + Left = 2400 + TabIndex = 47 + Tag = "font2" + Top = 480 + Width = 255 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Rotation:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 120 + TabIndex = 44 + Tag = "font2" + Top = 840 + Width = 1095 + End + Begin VB.Label lblInfo + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "Y:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00E0E0E0& + Height = 255 + Index = 11 + Left = 1320 + TabIndex = 43 + Tag = "font2" + Top = 480 + Width = 255 + End + Begin VB.Label lblInfo + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "X:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00E0E0E0& + Height = 255 + Index = 10 + Left = 1320 + TabIndex = 42 + Tag = "font2" + Top = 120 + Width = 255 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Scaling:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 120 + TabIndex = 41 + Tag = "font2" + Top = 120 + Width = 1095 + End + Begin VB.Label lblInfo + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "°" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 14 + Left = 2040 + TabIndex = 40 + Tag = "font2" + Top = 840 + Width = 255 + End + End + Begin VB.PictureBox picProp + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 1935 + Index = 0 + Left = 120 + ScaleHeight = 129 + ScaleMode = 3 'Pixel + ScaleWidth = 193 + TabIndex = 32 + TabStop = 0 'False + Top = 360 + Visible = 0 'False + Width = 2895 + Begin VB.TextBox txtBounciness + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Left = 1560 + TabIndex = 78 + Tag = "font1" + Top = 1680 + Width = 615 + End + Begin VB.TextBox txtVertexAlpha + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Left = 1560 + TabIndex = 3 + Tag = "font1" + Top = 1320 + Width = 615 + End + Begin VB.TextBox txtTexture + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 1 + Left = 1560 + TabIndex = 2 + Tag = "font1" + Top = 960 + Width = 975 + End + Begin VB.TextBox txtTexture + Appearance = 0 'Flat + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 0 + Left = 1560 + TabIndex = 1 + Tag = "font1" + Top = 600 + Width = 975 + End + Begin VB.ComboBox cboPolyType + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + ItemData = "frmInfo.frx":0026 + Left = 840 + List = "frmInfo.frx":0078 + Style = 2 'Dropdown List + TabIndex = 0 + Tag = "font1" + Top = 120 + Width = 1935 + End + Begin VB.Label lblInfo + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 35 + Left = 2160 + TabIndex = 79 + Tag = "font2" + Top = 1680 + Width = 255 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Bounciness:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 34 + Left = 120 + TabIndex = 77 + Tag = "font2" + Top = 1680 + Width = 1335 + End + Begin VB.Label lblInfo + Alignment = 2 'Center + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 33 + Left = 2160 + TabIndex = 76 + Tag = "font2" + Top = 1320 + Width = 255 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Opacity:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 32 + Left = 120 + TabIndex = 75 + Tag = "font2" + Top = 1320 + Width = 975 + End + Begin VB.Label lblInfo + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "Y:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00E0E0E0& + Height = 255 + Index = 16 + Left = 1200 + TabIndex = 37 + Tag = "font2" + Top = 960 + Width = 255 + End + Begin VB.Label lblInfo + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + Caption = "X:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00E0E0E0& + Height = 255 + Index = 15 + Left = 1200 + TabIndex = 36 + Tag = "font2" + Top = 600 + Width = 255 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Texture:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 3 + Left = 120 + TabIndex = 35 + Tag = "font2" + Top = 600 + Width = 975 + End + Begin VB.Label lblInfo + BackColor = &H00614B3D& + Caption = "Type:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 120 + TabIndex = 33 + Tag = "font2" + Top = 120 + Width = 615 + End + End + Begin VB.Label lblIndex + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 2280 + TabIndex = 21 + Tag = "font1" + Top = 2400 + Width = 735 + End + Begin VB.Label lblSelScenery + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 120 + TabIndex = 20 + Tag = "font1" + Top = 2760 + Width = 2895 + End + Begin VB.Label lblSelPolys + BackStyle = 0 'Transparent + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 120 + TabIndex = 19 + Top = 2760 + Width = 1335 + End + Begin VB.Label lblCoords + BackStyle = 0 'Transparent + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 120 + TabIndex = 18 + Tag = "font1" + Top = 2400 + Width = 2055 + End + Begin VB.Menu mnuProperties + Caption = "Properties" + Visible = 0 'False + Begin VB.Menu mnuProp + Caption = "Polygon Properties" + Index = 0 + End + Begin VB.Menu mnuProp + Caption = "Scenery Properties" + Index = 1 + End + Begin VB.Menu mnuProp + Caption = "Transform" + Index = 2 + End + Begin VB.Menu mnuProp + Caption = "Texture Settings" + Index = 3 + End + Begin VB.Menu mnuProp + Caption = "Light Properties" + Index = 4 + End + Begin VB.Menu mnuProp + Caption = "Map Info" + Checked = -1 'True + Index = 5 + End + End +End +Attribute VB_Name = "frmInfo" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Dim formHeight As Integer +Public collapsed As Boolean + +Dim tempVal As Single + +Public xPos As Integer, yPos As Integer +Public noChange As Boolean +Private applyChange As Boolean + +Private Sub Form_Load() + + On Error GoTo ErrorHandler + + Me.SetColors + + formHeight = Me.ScaleHeight + + setForm + + + cboPolyType.ListIndex = 0 + lblDimensions.Caption = "Dimensions: " & frmSoldatMapEditor.xTexture & " x " & frmSoldatMapEditor.yTexture + txtQuadX(0).Text = 0 + txtQuadY(0).Text = 0 + txtQuadX(1).Text = frmSoldatMapEditor.xTexture + txtQuadY(1).Text = frmSoldatMapEditor.yTexture + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading Properties form" + +End Sub + +Public Sub setForm() + + Me.left = xPos * Screen.TwipsPerPixelX + Me.Top = yPos * Screen.TwipsPerPixelY + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub cboPolyType_Click() + + If Not noChange Then + frmSoldatMapEditor.applyPolyType cboPolyType.ListIndex + End If + + If cboPolyType.ListIndex = 18 Then + txtBounciness.Enabled = True + Else + txtBounciness.Enabled = False + End If + +End Sub + +Private Sub txtLightProp_GotFocus(Index As Integer) + + If IsNumeric(txtLightProp(Index).Text) Then + tempVal = txtLightProp(Index).Text + End If + SelectAllText txtLightProp(Index) + +End Sub + +Private Sub txtLightProp_LostFocus(Index As Integer) + + If IsNumeric(txtLightProp(Index).Text) And applyChange Then + If Index = 0 Then + frmSoldatMapEditor.applyLightProp txtLightProp(Index).Text, Index + ElseIf Index = 1 And txtLightProp(Index).Text >= 0 Then + frmSoldatMapEditor.applyLightProp txtLightProp(Index).Text, Index + ElseIf Index = 1 And txtLightProp(Index).Text >= 0 And txtLightProp(Index).Text <= 100 Then + Else + txtLightProp(Index).Text = tempVal + End If + Else + txtLightProp(Index).Text = tempVal + End If + tempVal = 0 + + applyChange = False + +End Sub + +Private Sub picLight_Click() + + frmSoldatMapEditor.setLightColor + +End Sub + +Private Sub txtQuadX_GotFocus(Index As Integer) + + If IsNumeric(txtQuadX(Index).Text) Then + tempVal = txtQuadX(Index).Text + End If + SelectAllText txtQuadX(Index) + +End Sub + +Private Sub txtQuadX_LostFocus(Index As Integer) + + If Not IsNumeric(txtQuadX(Index).Text) Then + txtQuadX(Index).Text = tempVal + ElseIf txtQuadX(Index).Text < 0 Or txtQuadX(Index).Text > frmSoldatMapEditor.xTexture Then + txtQuadX(Index).Text = tempVal + Else + frmTexture.setTexCoords txtQuadX(Index).Text, Index + End If + tempVal = 0 + +End Sub + +Private Sub txtQuadY_GotFocus(Index As Integer) + + If IsNumeric(txtQuadY(Index).Text) Then + tempVal = txtQuadY(Index).Text + End If + SelectAllText txtQuadY(Index) + +End Sub + +Private Sub txtQuadY_LostFocus(Index As Integer) + + If Not IsNumeric(txtQuadY(Index).Text) Then + txtQuadY(Index).Text = tempVal + ElseIf txtQuadY(Index).Text < 0 Or txtQuadY(Index).Text > frmSoldatMapEditor.yTexture Then + txtQuadY(Index).Text = tempVal + Else + frmTexture.setTexCoords txtQuadY(Index).Text, Index + 2 + End If + tempVal = 0 + +End Sub + +Private Sub txtRotate_GotFocus() + + If IsNumeric(txtRotate.Text) Then + tempVal = txtRotate.Text + End If + +End Sub + +Private Sub txtRotate_LostFocus() + + If IsNumeric(txtRotate.Text) And applyChange Then + frmSoldatMapEditor.applyRotate (txtRotate.Text / 180 * pi) + Else + txtRotate.Text = tempVal + End If + tempVal = 0 + +End Sub + +Private Sub txtScale_GotFocus(Index As Integer) + + If IsNumeric(txtScale(Index).Text) Then + tempVal = txtScale(Index).Text + End If + +End Sub + +Private Sub txtScale_LostFocus(Index As Integer) + + If IsNumeric(txtScale(Index).Text) And applyChange Then + If Index = 0 Then + frmSoldatMapEditor.applyScale (txtScale(Index).Text / 100), 1 + ElseIf Index = 1 Then + frmSoldatMapEditor.applyScale 1, (txtScale(Index).Text / 100) + End If + Else + txtScale(Index).Text = tempVal + End If + tempVal = 0 + + applyChange = False + +End Sub + +Private Sub cboLevel_Click() + + If Not noChange Then + frmSoldatMapEditor.applySceneryProp cboLevel.ListIndex, 4 + End If + +End Sub + +Private Sub txtScenProp_GotFocus(Index As Integer) + + If IsNumeric(txtScenProp(Index).Text) Then + tempVal = txtScenProp(Index).Text + End If + SelectAllText txtScenProp(Index) + +End Sub + +Private Sub txtScenProp_LostFocus(Index As Integer) + + If IsNumeric(txtScenProp(Index).Text) And applyChange Then + If Index = 0 Or Index = 1 Then + frmSoldatMapEditor.applySceneryProp txtScenProp(Index).Text / 100, Index + ElseIf Index = 2 And txtScenProp(Index).Text >= 0 And txtScenProp(Index).Text <= 100 Then + frmSoldatMapEditor.applySceneryProp (txtScenProp(Index).Text / 100) * 255, Index + ElseIf Index = 3 And txtScenProp(Index).Text >= -360 And txtScenProp(Index).Text <= 360 Then + frmSoldatMapEditor.applySceneryProp txtScenProp(Index).Text / 180 * pi, Index + Else + txtScenProp(Index).Text = tempVal + End If + Else + txtScenProp(Index).Text = tempVal + End If + tempVal = 0 + + applyChange = False + +End Sub + +Private Sub txtTexture_GotFocus(Index As Integer) + + If IsNumeric(txtTexture(Index).Text) Then + tempVal = txtTexture(Index).Text + End If + +End Sub + +Private Sub txtTexture_LostFocus(Index As Integer) + + If IsNumeric(txtTexture(Index).Text) And applyChange Then + frmSoldatMapEditor.applyTextureCoords txtTexture(Index).Text, Index + Else + txtTexture(Index).Text = tempVal + End If + tempVal = 0 + + applyChange = False + +End Sub + +Private Sub txtVertexAlpha_GotFocus() + + If IsNumeric(txtVertexAlpha.Text) Then + tempVal = txtVertexAlpha.Text + End If + +End Sub + +Private Sub txtVertexAlpha_LostFocus() + + If Not IsNumeric(txtVertexAlpha.Text) Then + txtVertexAlpha.Text = tempVal + ElseIf txtVertexAlpha.Text < 0 Or txtVertexAlpha.Text > 100 Then + txtVertexAlpha.Text = tempVal + ElseIf applyChange Then + frmSoldatMapEditor.applyVertexAlpha txtVertexAlpha.Text / 100 + End If + tempVal = 0 + + applyChange = False + +End Sub + +Private Sub txtBounciness_GotFocus() + + If IsNumeric(txtBounciness.Text) Then + tempVal = txtBounciness.Text + End If + +End Sub + +Private Sub txtBounciness_LostFocus() + + If Not IsNumeric(txtBounciness.Text) Then + txtBounciness.Text = tempVal + ElseIf txtBounciness.Text < 0 Then + txtBounciness.Text = tempVal + ElseIf applyChange Then + frmSoldatMapEditor.applyBounciness 1 + (txtBounciness.Text / 100) + End If + tempVal = 0 + + applyChange = False + +End Sub + +Private Sub cmdDefault_Click() + + applyChange = True + cmdDefault.SetFocus + frmSoldatMapEditor.RegainFocus + +End Sub + +Public Sub mnuProp_Click(Index As Integer) + + Dim i As Integer + + For i = 0 To 5 + mnuProp(i).Checked = False + picProp(i).Visible = False + Next + + mnuProp(Index).Checked = True + + picProp(Index).Visible = True + +End Sub + +Private Sub picTitle_DblClick() + + collapsed = Not collapsed + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + + snapForm Me, frmPalette + snapForm Me, frmWaypoints + snapForm Me, frmTools + snapForm Me, frmScenery + snapForm Me, frmDisplay + snapForm Me, frmTexture + Me.Tag = snapForm(Me, frmSoldatMapEditor) + + xPos = Me.left / Screen.TwipsPerPixelX + yPos = Me.Top / Screen.TwipsPerPixelY + +End Sub + +Private Sub picHide_Click() + + Me.Hide + frmSoldatMapEditor.mnuInfo.Checked = False + +End Sub + +Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub picPropMenu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picPropMenu, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + + PopupMenu mnuProperties, , picPropMenu.left + 32, picPropMenu.Top + 16 + + mouseEvent2 picPropMenu, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub picPropMenu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picPropMenu, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + Dim i As Integer + Dim c As Control + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_properties.bmp") + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picPropMenu, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + + Me.BackColor = bgClr + For i = 0 To 35 + lblInfo(i).BackColor = lblBackClr + lblInfo(i).ForeColor = lblTextClr + Next + For i = 0 To 5 + picProp(i).BackColor = bgClr + Next + + For i = 0 To 1 + txtScenProp(i).BackColor = txtBackClr + txtScenProp(i).ForeColor = txtTextClr + txtQuadX(i).BackColor = bgClr + txtQuadX(i).ForeColor = lblTextClr + txtQuadY(i).BackColor = bgClr + txtQuadY(i).ForeColor = lblTextClr + Next + For i = 0 To 1 + txtScale(i).BackColor = txtBackClr + txtScale(i).ForeColor = txtTextClr + txtTexture(i).BackColor = txtBackClr + txtTexture(i).ForeColor = txtTextClr + Next + For i = 0 To 6 + lblCount(i).BackColor = lblBackClr + lblCount(i).ForeColor = lblTextClr + Next + + lblDimensions.BackColor = lblBackClr + lblDimensions.ForeColor = lblTextClr + + txtRotate.BackColor = txtBackClr + txtRotate.ForeColor = txtTextClr + cboLevel.BackColor = txtBackClr + cboLevel.ForeColor = txtTextClr + cboPolyType.BackColor = txtBackClr + cboPolyType.ForeColor = txtTextClr + + txtLightProp(0).BackColor = txtBackClr + txtLightProp(0).ForeColor = txtTextClr + + square.BorderColor = lblTextClr + diagonal.BorderColor = lblTextClr + + For Each c In Me.Controls + If c.Tag = "font1" Then + c.Font.Name = font1 + ElseIf c.Tag = "font2" Then + c.Font.Name = font2 + End If + Next + +End Sub diff --git a/frmMap.frm b/frmMap.frm index ac500b3..92c9cb0 100644 --- a/frmMap.frm +++ b/frmMap.frm @@ -1,859 +1,859 @@ -VERSION 5.00 -Begin VB.Form frmMap - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 1 'Fixed Single - ClientHeight = 5040 - ClientLeft = 120 - ClientTop = 120 - ClientWidth = 5400 - ControlBox = 0 'False - KeyPreview = -1 'True - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 336 - ScaleMode = 3 'Pixel - ScaleWidth = 360 - ShowInTaskbar = 0 'False - StartUpPosition = 3 'Windows Default - Begin VB.PictureBox picOK - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 375 - Left = 4320 - ScaleHeight = 25 - ScaleMode = 3 'Pixel - ScaleWidth = 65 - TabIndex = 13 - TabStop = 0 'False - Tag = "0" - Top = 4560 - Width = 975 - End - Begin VB.TextBox txtJet - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 3120 - TabIndex = 12 - Tag = "font1" - Top = 1680 - Width = 855 - End - Begin VB.PictureBox picTexture - Appearance = 0 'Flat - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 1935 - Left = 3240 - ScaleHeight = 127 - ScaleMode = 3 'Pixel - ScaleWidth = 127 - TabIndex = 11 - ToolTipText = "Map Texture" - Top = 2400 - Width = 1935 - End - Begin VB.ComboBox cboTexture - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - ItemData = "frmMap.frx":0000 - Left = 360 - List = "frmMap.frx":0002 - Sorted = -1 'True - Style = 2 'Dropdown List - TabIndex = 10 - Tag = "font1" - ToolTipText = "Map Texture" - Top = 2760 - Width = 2655 - End - Begin VB.TextBox txtDesc - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 1920 - MaxLength = 38 - TabIndex = 0 - Tag = "font1" - Text = "New Soldat Map" - ToolTipText = "Map Description" - Top = 480 - Width = 3135 - End - Begin VB.PictureBox picBackClr - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 495 - Index = 0 - Left = 1920 - ScaleHeight = 31 - ScaleMode = 3 'Pixel - ScaleWidth = 31 - TabIndex = 9 - ToolTipText = "Top Background Color" - Top = 3240 - Width = 495 - End - Begin VB.PictureBox picBackClr - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 495 - Index = 1 - Left = 1920 - ScaleHeight = 31 - ScaleMode = 3 'Pixel - ScaleWidth = 31 - TabIndex = 8 - ToolTipText = "Bottom Background Color" - Top = 3840 - Width = 495 - End - Begin VB.ComboBox cboWeather - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - ItemData = "frmMap.frx":0004 - Left = 1560 - List = "frmMap.frx":0014 - Style = 2 'Dropdown List - TabIndex = 1 - Tag = "font1" - ToolTipText = "Weather" - Top = 960 - Width = 1335 - End - Begin VB.ComboBox cboJet - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - ItemData = "frmMap.frx":0035 - Left = 1560 - List = "frmMap.frx":0054 - Style = 2 'Dropdown List - TabIndex = 3 - Tag = "font1" - ToolTipText = "Jets" - Top = 1680 - Width = 1335 - End - Begin VB.ComboBox cboGrenades - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - ItemData = "frmMap.frx":009F - Left = 4440 - List = "frmMap.frx":00CA - Style = 2 'Dropdown List - TabIndex = 4 - Tag = "font1" - ToolTipText = "Grenade Kits" - Top = 960 - Width = 615 - End - Begin VB.ComboBox cboMedikits - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - ItemData = "frmMap.frx":00F8 - Left = 4440 - List = "frmMap.frx":0123 - Style = 2 'Dropdown List - TabIndex = 5 - Tag = "font1" - ToolTipText = "Medikits" - Top = 1320 - Width = 615 - End - Begin VB.ComboBox cboSteps - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - ItemData = "frmMap.frx":0151 - Left = 1560 - List = "frmMap.frx":015E - Style = 2 'Dropdown List - TabIndex = 2 - Tag = "font1" - ToolTipText = "Steps" - Top = 1320 - Width = 1335 - End - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 255 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 360 - TabIndex = 6 - TabStop = 0 'False - Top = 0 - Width = 5400 - Begin VB.PictureBox picHide - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 5160 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 7 - TabStop = 0 'False - Tag = "3" - Top = 0 - Width = 240 - End - End - Begin VB.PictureBox picCancel - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 375 - Left = 3960 - ScaleHeight = 25 - ScaleMode = 3 'Pixel - ScaleWidth = 65 - TabIndex = 14 - TabStop = 0 'False - Tag = "1" - Top = 3840 - Width = 975 - End - Begin VB.Shape fraMap - BorderColor = &H000B3C0D& - Height = 2175 - Index = 1 - Left = 120 - Top = 2280 - Width = 5175 - End - Begin VB.Shape fraMap - BorderColor = &H000B3C0D& - Height = 1815 - Index = 0 - Left = 120 - Top = 360 - Width = 5175 - End - Begin VB.Label lblMap - BackColor = &H00614B3D& - Caption = "Texture:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 6 - Left = 360 - TabIndex = 22 - Tag = "font2" - Top = 2400 - Width = 975 - End - Begin VB.Label lblMap - BackColor = &H00614B3D& - Caption = "Background:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 7 - Left = 360 - TabIndex = 21 - Tag = "font2" - Top = 3240 - Width = 1455 - End - Begin VB.Label lblMap - BackColor = &H00614B3D& - Caption = "Description:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 360 - TabIndex = 20 - Tag = "font2" - Top = 480 - Width = 1455 - End - Begin VB.Label lblMap - BackColor = &H00614B3D& - Caption = "Medikits:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 5 - Left = 3120 - TabIndex = 19 - Tag = "font2" - Top = 1320 - Width = 1215 - End - Begin VB.Label lblMap - BackColor = &H00614B3D& - Caption = "Grenades:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 4 - Left = 3120 - TabIndex = 18 - Tag = "font2" - Top = 960 - Width = 1215 - End - Begin VB.Label lblMap - BackColor = &H00614B3D& - Caption = "Jet Fuel:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 3 - Left = 360 - TabIndex = 17 - Tag = "font2" - Top = 1680 - Width = 1095 - End - Begin VB.Label lblMap - BackColor = &H00614B3D& - Caption = "Steps:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 360 - TabIndex = 16 - Tag = "font2" - Top = 1320 - Width = 1095 - End - Begin VB.Label lblMap - BackColor = &H00614B3D& - Caption = "Weather:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 360 - TabIndex = 15 - Tag = "font2" - Top = 960 - Width = 1095 - End -End -Attribute VB_Name = "frmMap" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Private Type TColor - red As Byte - green As Byte - blue As Byte -End Type - -Private Sub cboJet_Click() - - Select Case cboJet.ListIndex - Case 0 'none - txtJet.Text = "0" - Case 1 'minimal - txtJet.Text = "12" - Case 2 'very low - txtJet.Text = "45" - Case 3 'low - txtJet.Text = "95" - Case 4 'normal - txtJet.Text = "190" - Case 5 'high - txtJet.Text = "320" - Case 6 'maximum - txtJet.Text = "800" - Case 7 'infinite - txtJet.Text = "32766" - Case 8 'custom - - End Select - - If cboJet.ListIndex <> 8 Then - txtJet.Enabled = False - Else - txtJet.Enabled = True - End If - -End Sub - -Private Sub getJets() - - Select Case txtJet.Text - Case 0 'none - cboJet.ListIndex = 0 - Case 12 - cboJet.ListIndex = 1 - Case 45 - cboJet.ListIndex = 2 - Case 95 - cboJet.ListIndex = 3 - Case 190 - cboJet.ListIndex = 4 - Case 320 - cboJet.ListIndex = 5 - Case 800 - cboJet.ListIndex = 6 - Case 32766 - cboJet.ListIndex = 7 - Case Else - cboJet.ListIndex = 8 - End Select - -End Sub - -Public Sub Form_Load() - - On Error GoTo ErrorHandler - - Me.SetColors - - loadTextures2 - - frmSoldatMapEditor.getOptions - - getJets - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading Map form" - -End Sub - -Private Sub cboTexture_Click() - - On Error GoTo ErrorHandler - - If cboTexture.List(cboTexture.ListIndex) <> "" Then - - frmSoldatMapEditor.setMapTexture cboTexture.List(cboTexture.ListIndex) - frmTexture.setTexture cboTexture.List(cboTexture.ListIndex) - - Dim Token As Long - Token = InitGDIPlus - picTexture.Picture = LoadPictureGDIPlus(frmSoldatMapEditor.soldatDir & "textures\" & cboTexture.List(cboTexture.ListIndex), 128, 128) - FreeGDIPlus Token - End If - - Exit Sub - -ErrorHandler: - - MsgBox "Error showing texture" & vbNewLine & Error$ - -End Sub - -Public Sub loadTextures() - - On Error GoTo ErrorHandler - - Dim strParent As String - Dim strPath As String - - Dim objFSO As FileSystemObject - Dim objFiles As Files - Dim objFile As file - - cboTexture.Clear - - strParent = frmSoldatMapEditor.soldatDir - strPath = frmSoldatMapEditor.soldatDir & "textures\" - - Set objFSO = New FileSystemObject - - If Not objFSO.FolderExists(strPath) Then Exit Sub - - Set objFiles = objFSO.GetFolder(strPath).Files - - For Each objFile In objFiles - If right(objFile.Name, 3) = "bmp" Then - cboTexture.AddItem objFile.Name - End If - Next - - Exit Sub - -ErrorHandler: - - MsgBox "loading textures failed" & vbNewLine & Error$ - -End Sub - -Public Sub loadTextures2() - - On Error GoTo ErrorHandler - - Dim file As String - - cboTexture.Clear - - file = Dir$(frmSoldatMapEditor.soldatDir & "textures\" & "*.bmp", vbDirectory) - Do While Len(file) - cboTexture.AddItem file - file = Dir$ - Loop - - file = Dir$(frmSoldatMapEditor.soldatDir & "textures\" & "*.png", vbDirectory) - Do While Len(file) - cboTexture.AddItem file - file = Dir$ - Loop - - Exit Sub - -ErrorHandler: - - MsgBox "loading textures failed" & vbNewLine & Error$ - -End Sub - -Public Sub loadFromList() - - On Error GoTo ErrorHandler - - Dim textureName As String - - cboTexture.Clear - - Open appPath & "\texture_list.txt" For Input As #1 - - Do While Not EOF(1) - - Input #1, textureName - cboTexture.AddItem textureName - - Loop - - Close #1 - - Exit Sub - -ErrorHandler: - - MsgBox Error$ - -End Sub - -Public Sub mnuRefresh_Click() - - Dim i As Integer - - loadTextures2 - - For i = 0 To cboTexture.ListCount - 1 - If cboTexture.List(i) = frmSoldatMapEditor.textureFile And cboTexture.List(i) <> "" Then - cboTexture.ListIndex = i - End If - Next - -End Sub - -Private Sub picBackClr_Click(Index As Integer) - - picBackClr(Index).BackColor = frmSoldatMapEditor.setBGColor(Index + 1) - -End Sub - -Private Sub picCancel_Click() - - Unload Me - -End Sub - -Private Sub picOK_Click() - - frmSoldatMapEditor.setOptions - Unload Me - frmSoldatMapEditor.RegainFocus - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - -End Sub - -Private Sub picCancel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN - -End Sub - -Private Sub picCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE - -End Sub - -Private Sub picOK_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN - -End Sub - -Private Sub picOK_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_Click() - - frmSoldatMapEditor.setOptions - frmSoldatMapEditor.mnuMap.Checked = False - Unload Me - -End Sub - -Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub txtJet_KeyPress(KeyAscii As Integer) - - If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Then - Else - KeyAscii = 0 - End If - -End Sub - -Public Sub SetColors() - - On Error Resume Next - - Dim i As Integer - Dim c As Control - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_map.bmp") - - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picOK, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - mouseEvent2 picCancel, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - - Me.BackColor = bgClr - - For i = 0 To 7 - lblMap(i).BackColor = lblBackClr - lblMap(i).ForeColor = lblTextClr - Next - - txtDesc.BackColor = txtBackClr - txtDesc.ForeColor = txtTextClr - txtJet.BackColor = txtBackClr - txtJet.ForeColor = txtTextClr - - cboWeather.BackColor = txtBackClr - cboWeather.ForeColor = txtTextClr - cboSteps.BackColor = txtBackClr - cboSteps.ForeColor = txtTextClr - cboJet.BackColor = txtBackClr - cboJet.ForeColor = txtTextClr - cboGrenades.BackColor = txtBackClr - cboGrenades.ForeColor = txtTextClr - cboMedikits.BackColor = txtBackClr - cboMedikits.ForeColor = txtTextClr - cboTexture.BackColor = txtBackClr - cboTexture.ForeColor = txtTextClr - - fraMap(0).BorderColor = frameClr - fraMap(1).BorderColor = frameClr - - For Each c In Me.Controls - If c.Tag = "font1" Then - c.Font.Name = font1 - ElseIf c.Tag = "font2" Then - c.Font.Name = font2 - End If - Next - -End Sub +VERSION 5.00 +Begin VB.Form frmMap + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 1 'Fixed Single + ClientHeight = 5040 + ClientLeft = 120 + ClientTop = 120 + ClientWidth = 5400 + ControlBox = 0 'False + KeyPreview = -1 'True + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 336 + ScaleMode = 3 'Pixel + ScaleWidth = 360 + ShowInTaskbar = 0 'False + StartUpPosition = 3 'Windows Default + Begin VB.PictureBox picOK + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 375 + Left = 4320 + ScaleHeight = 25 + ScaleMode = 3 'Pixel + ScaleWidth = 65 + TabIndex = 13 + TabStop = 0 'False + Tag = "0" + Top = 4560 + Width = 975 + End + Begin VB.TextBox txtJet + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 3120 + TabIndex = 12 + Tag = "font1" + Top = 1680 + Width = 855 + End + Begin VB.PictureBox picTexture + Appearance = 0 'Flat + BackColor = &H00000000& + ForeColor = &H80000008& + Height = 1935 + Left = 3240 + ScaleHeight = 127 + ScaleMode = 3 'Pixel + ScaleWidth = 127 + TabIndex = 11 + ToolTipText = "Map Texture" + Top = 2400 + Width = 1935 + End + Begin VB.ComboBox cboTexture + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + ItemData = "frmMap.frx":0000 + Left = 360 + List = "frmMap.frx":0002 + Sorted = -1 'True + Style = 2 'Dropdown List + TabIndex = 10 + Tag = "font1" + ToolTipText = "Map Texture" + Top = 2760 + Width = 2655 + End + Begin VB.TextBox txtDesc + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 1920 + MaxLength = 38 + TabIndex = 0 + Tag = "font1" + Text = "New Soldat Map" + ToolTipText = "Map Description" + Top = 480 + Width = 3135 + End + Begin VB.PictureBox picBackClr + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H00000000& + ForeColor = &H80000008& + Height = 495 + Index = 0 + Left = 1920 + ScaleHeight = 31 + ScaleMode = 3 'Pixel + ScaleWidth = 31 + TabIndex = 9 + ToolTipText = "Top Background Color" + Top = 3240 + Width = 495 + End + Begin VB.PictureBox picBackClr + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H00000000& + ForeColor = &H80000008& + Height = 495 + Index = 1 + Left = 1920 + ScaleHeight = 31 + ScaleMode = 3 'Pixel + ScaleWidth = 31 + TabIndex = 8 + ToolTipText = "Bottom Background Color" + Top = 3840 + Width = 495 + End + Begin VB.ComboBox cboWeather + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + ItemData = "frmMap.frx":0004 + Left = 1560 + List = "frmMap.frx":0014 + Style = 2 'Dropdown List + TabIndex = 1 + Tag = "font1" + ToolTipText = "Weather" + Top = 960 + Width = 1335 + End + Begin VB.ComboBox cboJet + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + ItemData = "frmMap.frx":0035 + Left = 1560 + List = "frmMap.frx":0054 + Style = 2 'Dropdown List + TabIndex = 3 + Tag = "font1" + ToolTipText = "Jets" + Top = 1680 + Width = 1335 + End + Begin VB.ComboBox cboGrenades + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + ItemData = "frmMap.frx":009F + Left = 4440 + List = "frmMap.frx":00CA + Style = 2 'Dropdown List + TabIndex = 4 + Tag = "font1" + ToolTipText = "Grenade Kits" + Top = 960 + Width = 615 + End + Begin VB.ComboBox cboMedikits + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + ItemData = "frmMap.frx":00F8 + Left = 4440 + List = "frmMap.frx":0123 + Style = 2 'Dropdown List + TabIndex = 5 + Tag = "font1" + ToolTipText = "Medikits" + Top = 1320 + Width = 615 + End + Begin VB.ComboBox cboSteps + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + ItemData = "frmMap.frx":0151 + Left = 1560 + List = "frmMap.frx":015E + Style = 2 'Dropdown List + TabIndex = 2 + Tag = "font1" + ToolTipText = "Steps" + Top = 1320 + Width = 1335 + End + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 255 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 360 + TabIndex = 6 + TabStop = 0 'False + Top = 0 + Width = 5400 + Begin VB.PictureBox picHide + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 5160 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 7 + TabStop = 0 'False + Tag = "3" + Top = 0 + Width = 240 + End + End + Begin VB.PictureBox picCancel + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 375 + Left = 3960 + ScaleHeight = 25 + ScaleMode = 3 'Pixel + ScaleWidth = 65 + TabIndex = 14 + TabStop = 0 'False + Tag = "1" + Top = 3840 + Width = 975 + End + Begin VB.Shape fraMap + BorderColor = &H000B3C0D& + Height = 2175 + Index = 1 + Left = 120 + Top = 2280 + Width = 5175 + End + Begin VB.Shape fraMap + BorderColor = &H000B3C0D& + Height = 1815 + Index = 0 + Left = 120 + Top = 360 + Width = 5175 + End + Begin VB.Label lblMap + BackColor = &H00614B3D& + Caption = "Texture:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 6 + Left = 360 + TabIndex = 22 + Tag = "font2" + Top = 2400 + Width = 975 + End + Begin VB.Label lblMap + BackColor = &H00614B3D& + Caption = "Background:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 7 + Left = 360 + TabIndex = 21 + Tag = "font2" + Top = 3240 + Width = 1455 + End + Begin VB.Label lblMap + BackColor = &H00614B3D& + Caption = "Description:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 360 + TabIndex = 20 + Tag = "font2" + Top = 480 + Width = 1455 + End + Begin VB.Label lblMap + BackColor = &H00614B3D& + Caption = "Medikits:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 5 + Left = 3120 + TabIndex = 19 + Tag = "font2" + Top = 1320 + Width = 1215 + End + Begin VB.Label lblMap + BackColor = &H00614B3D& + Caption = "Grenades:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 4 + Left = 3120 + TabIndex = 18 + Tag = "font2" + Top = 960 + Width = 1215 + End + Begin VB.Label lblMap + BackColor = &H00614B3D& + Caption = "Jet Fuel:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 3 + Left = 360 + TabIndex = 17 + Tag = "font2" + Top = 1680 + Width = 1095 + End + Begin VB.Label lblMap + BackColor = &H00614B3D& + Caption = "Steps:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 360 + TabIndex = 16 + Tag = "font2" + Top = 1320 + Width = 1095 + End + Begin VB.Label lblMap + BackColor = &H00614B3D& + Caption = "Weather:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 360 + TabIndex = 15 + Tag = "font2" + Top = 960 + Width = 1095 + End +End +Attribute VB_Name = "frmMap" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Private Type TColor + red As Byte + green As Byte + blue As Byte +End Type + +Private Sub cboJet_Click() + + Select Case cboJet.ListIndex + Case 0 'none + txtJet.Text = "0" + Case 1 'minimal + txtJet.Text = "12" + Case 2 'very low + txtJet.Text = "45" + Case 3 'low + txtJet.Text = "95" + Case 4 'normal + txtJet.Text = "190" + Case 5 'high + txtJet.Text = "320" + Case 6 'maximum + txtJet.Text = "800" + Case 7 'infinite + txtJet.Text = "32766" + Case 8 'custom + + End Select + + If cboJet.ListIndex <> 8 Then + txtJet.Enabled = False + Else + txtJet.Enabled = True + End If + +End Sub + +Private Sub getJets() + + Select Case txtJet.Text + Case 0 'none + cboJet.ListIndex = 0 + Case 12 + cboJet.ListIndex = 1 + Case 45 + cboJet.ListIndex = 2 + Case 95 + cboJet.ListIndex = 3 + Case 190 + cboJet.ListIndex = 4 + Case 320 + cboJet.ListIndex = 5 + Case 800 + cboJet.ListIndex = 6 + Case 32766 + cboJet.ListIndex = 7 + Case Else + cboJet.ListIndex = 8 + End Select + +End Sub + +Public Sub Form_Load() + + On Error GoTo ErrorHandler + + Me.SetColors + + loadTextures2 + + frmSoldatMapEditor.getOptions + + getJets + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading Map form" + +End Sub + +Private Sub cboTexture_Click() + + On Error GoTo ErrorHandler + + If cboTexture.List(cboTexture.ListIndex) <> "" Then + + frmSoldatMapEditor.setMapTexture cboTexture.List(cboTexture.ListIndex) + frmTexture.setTexture cboTexture.List(cboTexture.ListIndex) + + Dim Token As Long + Token = InitGDIPlus + picTexture.Picture = LoadPictureGDIPlus(frmSoldatMapEditor.soldatDir & "textures\" & cboTexture.List(cboTexture.ListIndex), 128, 128) + FreeGDIPlus Token + End If + + Exit Sub + +ErrorHandler: + + MsgBox "Error showing texture" & vbNewLine & Error$ + +End Sub + +Public Sub loadTextures() + + On Error GoTo ErrorHandler + + Dim strParent As String + Dim strPath As String + + Dim objFSO As FileSystemObject + Dim objFiles As Files + Dim objFile As file + + cboTexture.Clear + + strParent = frmSoldatMapEditor.soldatDir + strPath = frmSoldatMapEditor.soldatDir & "textures\" + + Set objFSO = New FileSystemObject + + If Not objFSO.FolderExists(strPath) Then Exit Sub + + Set objFiles = objFSO.GetFolder(strPath).Files + + For Each objFile In objFiles + If right(objFile.Name, 3) = "bmp" Then + cboTexture.AddItem objFile.Name + End If + Next + + Exit Sub + +ErrorHandler: + + MsgBox "loading textures failed" & vbNewLine & Error$ + +End Sub + +Public Sub loadTextures2() + + On Error GoTo ErrorHandler + + Dim file As String + + cboTexture.Clear + + file = Dir$(frmSoldatMapEditor.soldatDir & "textures\" & "*.bmp", vbDirectory) + Do While Len(file) + cboTexture.AddItem file + file = Dir$ + Loop + + file = Dir$(frmSoldatMapEditor.soldatDir & "textures\" & "*.png", vbDirectory) + Do While Len(file) + cboTexture.AddItem file + file = Dir$ + Loop + + Exit Sub + +ErrorHandler: + + MsgBox "loading textures failed" & vbNewLine & Error$ + +End Sub + +Public Sub loadFromList() + + On Error GoTo ErrorHandler + + Dim textureName As String + + cboTexture.Clear + + Open appPath & "\texture_list.txt" For Input As #1 + + Do While Not EOF(1) + + Input #1, textureName + cboTexture.AddItem textureName + + Loop + + Close #1 + + Exit Sub + +ErrorHandler: + + MsgBox Error$ + +End Sub + +Public Sub mnuRefresh_Click() + + Dim i As Integer + + loadTextures2 + + For i = 0 To cboTexture.ListCount - 1 + If cboTexture.List(i) = frmSoldatMapEditor.textureFile And cboTexture.List(i) <> "" Then + cboTexture.ListIndex = i + End If + Next + +End Sub + +Private Sub picBackClr_Click(Index As Integer) + + picBackClr(Index).BackColor = frmSoldatMapEditor.setBGColor(Index + 1) + +End Sub + +Private Sub picCancel_Click() + + Unload Me + +End Sub + +Private Sub picOK_Click() + + frmSoldatMapEditor.setOptions + Unload Me + frmSoldatMapEditor.RegainFocus + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + +End Sub + +Private Sub picCancel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN + +End Sub + +Private Sub picCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE + +End Sub + +Private Sub picOK_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN + +End Sub + +Private Sub picOK_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_Click() + + frmSoldatMapEditor.setOptions + frmSoldatMapEditor.mnuMap.Checked = False + Unload Me + +End Sub + +Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub txtJet_KeyPress(KeyAscii As Integer) + + If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Then + Else + KeyAscii = 0 + End If + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + Dim i As Integer + Dim c As Control + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_map.bmp") + + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picOK, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + mouseEvent2 picCancel, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + + Me.BackColor = bgClr + + For i = 0 To 7 + lblMap(i).BackColor = lblBackClr + lblMap(i).ForeColor = lblTextClr + Next + + txtDesc.BackColor = txtBackClr + txtDesc.ForeColor = txtTextClr + txtJet.BackColor = txtBackClr + txtJet.ForeColor = txtTextClr + + cboWeather.BackColor = txtBackClr + cboWeather.ForeColor = txtTextClr + cboSteps.BackColor = txtBackClr + cboSteps.ForeColor = txtTextClr + cboJet.BackColor = txtBackClr + cboJet.ForeColor = txtTextClr + cboGrenades.BackColor = txtBackClr + cboGrenades.ForeColor = txtTextClr + cboMedikits.BackColor = txtBackClr + cboMedikits.ForeColor = txtTextClr + cboTexture.BackColor = txtBackClr + cboTexture.ForeColor = txtTextClr + + fraMap(0).BorderColor = frameClr + fraMap(1).BorderColor = frameClr + + For Each c In Me.Controls + If c.Tag = "font1" Then + c.Font.Name = font1 + ElseIf c.Tag = "font2" Then + c.Font.Name = font2 + End If + Next + +End Sub diff --git a/frmPalette.frm b/frmPalette.frm index 7e8335b..9c987e5 100644 --- a/frmPalette.frm +++ b/frmPalette.frm @@ -1,1175 +1,1175 @@ -VERSION 5.00 -Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" -Begin VB.Form frmPalette - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 1 'Fixed Single - ClientHeight = 4080 - ClientLeft = 120 - ClientTop = 120 - ClientWidth = 3120 - ControlBox = 0 'False - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 272 - ScaleMode = 3 'Pixel - ScaleWidth = 208 - ShowInTaskbar = 0 'False - StartUpPosition = 3 'Windows Default - Begin VB.PictureBox picClrMode - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 2 - Left = 1200 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 23 - Tag = "6" - Top = 1080 - Width = 240 - End - Begin VB.PictureBox picClrMode - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 1 - Left = 1200 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 22 - Tag = "6" - Top = 840 - Width = 240 - End - Begin VB.PictureBox picClrMode - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 0 - Left = 1200 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 21 - Tag = "6" - Top = 600 - Width = 240 - End - Begin VB.TextBox txtRadius - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 2520 - TabIndex = 16 - Tag = "font1" - Text = "0" - Top = 1440 - Width = 495 - End - Begin MSComDlg.CommonDialog commonDialog - Left = 360 - Top = 600 - _ExtentX = 847 - _ExtentY = 847 - _Version = 393216 - CancelError = -1 'True - End - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 255 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 208 - TabIndex = 13 - TabStop = 0 'False - Top = 0 - Width = 3120 - Begin VB.PictureBox picHide - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 2880 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 14 - TabStop = 0 'False - Tag = "3" - Top = 0 - Width = 240 - End - Begin VB.PictureBox picPaletteMenu - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 2640 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 15 - TabStop = 0 'False - Tag = "8" - Top = 0 - Width = 240 - End - End - Begin VB.ComboBox cboBlendMode - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - ItemData = "frmPalette.frx":0000 - Left = 2040 - List = "frmPalette.frx":0016 - Style = 2 'Dropdown List - TabIndex = 5 - Tag = "font1" - Top = 2160 - Width = 960 - End - Begin VB.PictureBox picColor - Appearance = 0 'Flat - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 975 - Left = 120 - ScaleHeight = 63 - ScaleMode = 3 'Pixel - ScaleWidth = 63 - TabIndex = 7 - TabStop = 0 'False - ToolTipText = "Current Color" - Top = 360 - Width = 975 - End - Begin VB.TextBox txtRGB - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Index = 0 - Left = 600 - TabIndex = 1 - Tag = "font1" - Text = "0" - Top = 1440 - Width = 480 - End - Begin VB.TextBox txtRGB - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Index = 1 - Left = 600 - TabIndex = 2 - Tag = "font1" - Text = "0" - Top = 1800 - Width = 480 - End - Begin VB.TextBox txtRGB - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Index = 2 - Left = 600 - TabIndex = 3 - Tag = "font1" - Text = "0" - Top = 2160 - Width = 480 - End - Begin VB.TextBox txtOpacity - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 2520 - TabIndex = 4 - Tag = "font1" - Text = "0" - Top = 1800 - Width = 480 - End - Begin VB.PictureBox picPalette - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H00000000& - FillColor = &H00FFFFFF& - ForeColor = &H00FFFFFF& - Height = 1470 - Left = 120 - ScaleHeight = 96 - ScaleMode = 3 'Pixel - ScaleWidth = 192 - TabIndex = 6 - TabStop = 0 'False - ToolTipText = "Palette" - Top = 2520 - Width = 2910 - Begin VB.Shape shpSel1 - BorderColor = &H00FFFFFF& - DrawMode = 6 'Mask Pen Not - Height = 210 - Left = 240 - Top = 0 - Width = 210 - End - Begin VB.Shape shpSel2 - Height = 240 - Left = 0 - Top = 0 - Width = 240 - End - End - Begin VB.CommandButton cmdDefault - Default = -1 'True - Height = 495 - Left = 360 - TabIndex = 0 - Top = 600 - Width = 495 - End - Begin VB.Label lblPal - BackStyle = 0 'Transparent - Caption = "Vertex Color:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 6 - Left = 1200 - TabIndex = 24 - Tag = "font2" - Top = 360 - Width = 1695 - End - Begin VB.Label lblClrMode - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = " Dynamic" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 1440 - TabIndex = 20 - Tag = "font2" - Top = 1080 - Width = 1095 - End - Begin VB.Label lblClrMode - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = " Normal" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 1440 - TabIndex = 19 - Tag = "font2" - Top = 840 - Width = 1095 - End - Begin VB.Label lblClrMode - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = " Precision" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 1440 - TabIndex = 18 - Tag = "font2" - Top = 600 - Width = 1095 - End - Begin VB.Label lblPal - BackColor = &H00614B3D& - Caption = "Radius:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 3 - Left = 1200 - TabIndex = 17 - Tag = "font2" - Top = 1440 - Width = 855 - End - Begin VB.Label lblPal - BackColor = &H00614B3D& - Caption = "Mode:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 5 - Left = 1200 - TabIndex = 12 - Tag = "font2" - Top = 2160 - Width = 735 - End - Begin VB.Label lblPal - BackColor = &H00614B3D& - Caption = "R:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 120 - TabIndex = 11 - Tag = "font2" - Top = 1440 - Width = 255 - End - Begin VB.Label lblPal - BackColor = &H00614B3D& - Caption = "G:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 120 - TabIndex = 10 - Tag = "font2" - Top = 1800 - Width = 255 - End - Begin VB.Label lblPal - BackColor = &H00614B3D& - Caption = "B:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 120 - TabIndex = 9 - Tag = "font2" - Top = 2160 - Width = 255 - End - Begin VB.Label lblPal - BackColor = &H00614B3D& - Caption = "Opacity:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 4 - Left = 1200 - TabIndex = 8 - Tag = "font2" - Top = 1800 - Width = 975 - End - Begin VB.Menu mnuPalette - Caption = "Palette" - Visible = 0 'False - Begin VB.Menu mnuLoadPalette - Caption = "Load Palette" - End - Begin VB.Menu mnuSavePalette - Caption = "Save Palette" - End - Begin VB.Menu mnuClearPalette - Caption = "Clear" - End - End - Begin VB.Menu mnuNewColor - Caption = "NewColor" - Visible = 0 'False - Begin VB.Menu mnuAddToPalette - Caption = "Add to Palette" - End - End -End -Attribute VB_Name = "frmPalette" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Private Type TColor - red As Byte - green As Byte - blue As Byte -End Type - -Dim clrPalette(0 To 11, 0 To 5) As TColor - -Dim formHeight As Integer -Public collapsed As Boolean -Public xPos As Integer, yPos As Integer - -Dim radius As Integer -Dim clrMode As Byte - -Dim xVal As Integer, yVal As Integer - -Dim tempVal As Integer - -Public Function getPalClr(X As Integer, Y As Integer) As Long - - getPalClr = RGB(clrPalette(X, Y).blue, clrPalette(X, Y).green, clrPalette(X, Y).red) - -End Function - -Public Sub setPalClr(X As Integer, Y As Integer, clrVal As Long) - - clrPalette(X, Y) = getRGB(clrVal) - -End Sub - -Public Sub refreshPalette(R As Integer, op As Single, blend As Integer, mode As Byte) - - Dim X As Integer, Y As Integer, i As Integer - - For Y = 0 To 5 - For X = 0 To 11 - frmPalette.picPalette.Line (X * 16, Y * 16)-(X * 16 + 16, 16 * 16 + 16), RGB(clrPalette(X, Y).red, clrPalette(X, Y).green, clrPalette(X, Y).blue), BF - Next - Next - - radius = R - txtRadius.Text = R - txtOpacity.Text = op * 100 - cboBlendMode.ListIndex = blend - clrMode = mode - - For i = 0 To 2 - If i = clrMode Then - BitBlt picClrMode(i).hDC, 0, 0, 16, 16, frmSoldatMapEditor.picGfx.hDC, 96, 112, vbSrcCopy - Else - BitBlt picClrMode(i).hDC, 0, 0, 16, 16, frmSoldatMapEditor.picGfx.hDC, 96, 96, vbSrcCopy - End If - picClrMode(i).Refresh - Next - - For i = 0 To 2 - mouseEvent2 picClrMode(i), 0, 0, BUTTON_SMALL, (clrMode = i), BUTTON_UP - Next - -End Sub - -Private Function getRGB(DecValue As Long) As TColor - - Dim hexValue As String - - hexValue = Hex$(Val(DecValue)) - - If Len(hexValue) < 6 Then - hexValue = String$(6 - Len(hexValue), "0") + hexValue - End If - - getRGB.blue = CLng("&H" + right(hexValue, 2)) - hexValue = left(hexValue, Len(hexValue) - 2) - getRGB.green = CLng("&H" + right(hexValue, 2)) - hexValue = left(hexValue, Len(hexValue) - 2) - getRGB.red = CLng("&H" + right(hexValue, 2)) - -End Function - -Public Sub checkPalette(red As Byte, green As Byte, blue As Byte) - - Dim X As Integer, Y As Integer - Dim foundClr As Boolean - - For Y = 0 To 5 - For X = 0 To 11 - If red = clrPalette(X, Y).red And green = clrPalette(X, Y).green And blue = clrPalette(X, Y).blue And Not foundClr Then - shpSel1.left = X * 16 + 1 - shpSel1.Top = Y * 16 + 1 - shpSel2.left = X * 16 - shpSel2.Top = Y * 16 - foundClr = True - End If - Next - Next - -End Sub - -Private Sub cmdDefault_Click() - - cmdDefault.SetFocus - -End Sub - -Private Sub Form_Click() - - cmdDefault.SetFocus - -End Sub - -Private Sub Form_Load() - - Dim i As Integer - - On Error GoTo ErrorHandler - - Me.SetColors - - frmPalette.loadPalette appPath & "\palettes\current.txt" - - setValues frmColor.red, frmColor.green, frmColor.blue - - shpSel1.left = picPalette.ScaleWidth + 2 - shpSel1.Top = picPalette.ScaleHeight + 2 - shpSel2.left = picPalette.ScaleWidth + 2 - shpSel2.Top = picPalette.ScaleHeight + 2 - - formHeight = Me.ScaleHeight - - setForm - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading Palette form" - -End Sub - -Public Sub setForm() - - Me.left = xPos * Screen.TwipsPerPixelX - Me.Top = yPos * Screen.TwipsPerPixelY - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Public Sub loadPalette(fileName As String) - - On Error GoTo ErrorHandler - - Dim X As Integer, Y As Integer - Dim fileOpen As Boolean - - fileOpen = False - - Open fileName For Input As #1 - fileOpen = True - - For Y = 0 To 5 - For X = 0 To 11 - Input #1, clrPalette(X, Y).red - Input #1, clrPalette(X, Y).green - Input #1, clrPalette(X, Y).blue - frmPalette.picPalette.Line (X * 16, Y * 16)-(X * 16 + 16, 16 * 16 + 16), RGB(clrPalette(X, Y).red, clrPalette(X, Y).green, clrPalette(X, Y).blue), BF - Next - Next - - Close #1 - fileOpen = False - - shpSel1.left = picPalette.ScaleWidth + 2 - shpSel1.Top = picPalette.ScaleHeight + 2 - shpSel2.left = picPalette.ScaleWidth + 2 - shpSel2.Top = picPalette.ScaleHeight + 2 - - picPalette.Refresh - - Exit Sub - -ErrorHandler: - - mnuClearPalette_Click - If fileOpen Then Close #1 - MsgBox "Error loading palette" & vbNewLine & Error$ - -End Sub - -Private Sub Form_LostFocus() - - cmdDefault.SetFocus - -End Sub - -Private Sub lblClrMode_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - picClrMode_MouseMove Index, 1, 0, 0, 0 - -End Sub - -Private Sub mnuLoadPalette_Click() - - On Error GoTo ErrorHandler - - commonDialog.InitDir = appPath & "\palettes\" - commonDialog.DialogTitle = "Load Palette" - commonDialog.Filter = "Text Documents (*.txt)|*.txt" - commonDialog.ShowOpen - - If commonDialog.fileName <> "" Then - loadPalette commonDialog.fileName - End If - - Exit Sub - -ErrorHandler: - -End Sub - -Public Sub savePalette(fileName As String) - - Dim X As Integer, Y As Integer - Dim fileOpen As Boolean - - On Error GoTo ErrorHandler - - fileOpen = False - - Open fileName For Output As #1 - fileOpen = True - - For Y = 0 To 5 - For X = 0 To 11 - Print #1, clrPalette(X, Y).red & ", " & clrPalette(X, Y).green & ", " & clrPalette(X, Y).blue - Next - Next - - Close #1 - fileOpen = False - - Exit Sub - -ErrorHandler: - - If fileOpen Then Close #1 - MsgBox "Error saving palette" & vbNewLine & Error$ - -End Sub - -Private Sub mnuSavePalette_Click() - - On Error GoTo ErrorHandler - - commonDialog.InitDir = appPath & "\palettes\" - commonDialog.DialogTitle = "Save Palette" - commonDialog.Filter = "Text Documents (*.txt)|*.txt" - commonDialog.ShowSave - - If commonDialog.fileName <> "" Then - savePalette commonDialog.fileName - End If - - Exit Sub - -ErrorHandler: - -End Sub - -Private Sub mnuClearPalette_Click() - - Dim X As Integer, Y As Integer - - For Y = 0 To 5 - For X = 0 To 11 - clrPalette(X, Y).red = 0 - clrPalette(X, Y).green = 0 - clrPalette(X, Y).blue = 0 - frmPalette.picPalette.Line (X * 16, Y * 16)-(X * 16 + 16, 16 * 16 + 16), 0, BF - Next - Next - - shpSel1.left = picPalette.ScaleWidth + 2 - shpSel1.Top = picPalette.ScaleHeight + 2 - shpSel2.left = picPalette.ScaleWidth + 2 - shpSel2.Top = picPalette.ScaleHeight + 2 - -End Sub - -Private Sub picHide_Click() - - Me.Hide - frmSoldatMapEditor.mnuPalette.Checked = False - -End Sub - -Private Sub picPalette_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - If Button = 1 Then 'select color - - xVal = Int(X / 16) - yVal = Int(Y / 16) - frmSoldatMapEditor.setPaletteColor clrPalette(xVal, yVal).red, clrPalette(xVal, yVal).green, clrPalette(xVal, yVal).blue - - txtRGB(0).Text = clrPalette(xVal, yVal).red - txtRGB(1).Text = clrPalette(xVal, yVal).green - txtRGB(2).Text = clrPalette(xVal, yVal).blue - picColor.BackColor = RGB(clrPalette(xVal, yVal).red, clrPalette(xVal, yVal).green, clrPalette(xVal, yVal).blue) - - shpSel1.left = Int(X / 16) * 16 + 1 - shpSel1.Top = Int(Y / 16) * 16 + 1 - shpSel2.left = Int(X / 16) * 16 - shpSel2.Top = Int(Y / 16) * 16 - - ElseIf Button = 2 Then 'new color - - xVal = Int(X / 16) - yVal = Int(Y / 16) - Me.PopupMenu mnuNewColor - - End If - - cmdDefault.SetFocus - -End Sub - -Public Sub newPaletteColor() - - clrPalette(xVal, yVal).red = txtRGB(0).Text - clrPalette(xVal, yVal).green = txtRGB(1).Text - clrPalette(xVal, yVal).blue = txtRGB(2).Text - picPalette.Line (xVal * 16, yVal * 16)-(xVal * 16 + 15, yVal * 16 + 15), RGB(clrPalette(xVal, yVal).red, clrPalette(xVal, yVal).green, clrPalette(xVal, yVal).blue), BF - shpSel1.left = xVal * 16 + 1 - shpSel1.Top = yVal * 16 + 1 - shpSel2.left = xVal * 16 - shpSel2.Top = yVal * 16 - -End Sub - -Private Sub mnuAddToPalette_Click() - - newPaletteColor - -End Sub - -Private Sub picColor_Click() - - frmColor.InitClr txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text - - frmColor.ChangeColor picColor, txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text, 0 - -End Sub - -Private Sub txtradius_Change() - - If IsNumeric(txtRadius.Text) = False And txtRadius.Text <> "" Then - txtRadius.Text = radius - End If - -End Sub - -Private Sub txtradius_GotFocus() - - SelectAllText txtRadius - -End Sub - -Private Sub txtradius_LostFocus() - - If IsNumeric(txtRadius.Text) = False And txtRadius.Text <> "" Then - txtRadius.Text = radius - ElseIf txtRadius.Text = "" Then - txtRadius.Text = radius - ElseIf txtRadius.Text >= 4 And txtRadius.Text <= 128 Then - radius = Int(txtRadius.Text) - txtRadius.Text = radius - frmSoldatMapEditor.setRadius radius - Else - If txtRadius.Text < 4 Then radius = 4 - If txtRadius.Text > 128 Then radius = 128 - txtRadius.Text = radius - frmSoldatMapEditor.setRadius radius - End If - -End Sub - -Private Sub txtRGB_Change(Index As Integer) - - If IsNumeric(txtRGB(Index).Text) = False And txtRGB(Index).Text <> "" Then - ElseIf txtRGB(Index).Text = "" Then - - ElseIf txtRGB(Index).Text >= 0 And txtRGB(Index).Text <= 255 Then - picColor.BackColor = RGB(txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text) - frmSoldatMapEditor.setPolyColor Index, txtRGB(Index).Text - End If - -End Sub - -Private Sub txtRGB_GotFocus(Index As Integer) - - If IsNumeric(txtRGB(Index).Text) Then - tempVal = txtRGB(Index).Text - Else - tempVal = 0 - End If - SelectAllText txtRGB(Index) - -End Sub - -Private Sub txtRGB_LostFocus(Index As Integer) - - If Not IsNumeric(txtRGB(Index).Text) Then - txtRGB(Index).Text = tempVal - ElseIf txtRGB(Index).Text = "" Then - txtRGB(Index).Text = tempVal - ElseIf txtRGB(Index).Text >= 0 And txtRGB(Index).Text <= 255 Then - frmSoldatMapEditor.setPolyColor Index, txtRGB(Index).Text - Else - txtRGB(Index).Text = tempVal - End If - - picColor.BackColor = RGB(txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text) - -End Sub - -Private Sub txtOpacity_Change() - - If IsNumeric(txtOpacity.Text) = False And txtOpacity.Text <> "" Then - txtOpacity.Text = 100 - ElseIf txtOpacity.Text = "" Then - - ElseIf txtOpacity.Text >= 0 And txtOpacity.Text <= 100 Then - frmSoldatMapEditor.setPolyColor 3, txtOpacity.Text - End If - -End Sub - -Private Sub txtOpacity_GotFocus() - - SelectAllText txtOpacity - -End Sub - -Private Sub txtOpacity_LostFocus() - - If txtOpacity.Text = "" Then - txtOpacity.Text = 0 - ElseIf txtOpacity.Text >= 0 And txtOpacity.Text <= 100 Then - Else - txtOpacity.Text = 0 - End If - -End Sub - -Private Sub cboBlendMode_Click() - - frmSoldatMapEditor.setBlendMode cboBlendMode.ListIndex - -End Sub - -Public Sub setValues(R As Byte, G As Byte, B As Byte) - - txtRGB(0).Text = R - txtRGB(1).Text = G - txtRGB(2).Text = B - picColor.BackColor = RGB(R, G, B) - shpSel1.left = picPalette.ScaleWidth + 2 - shpSel1.Top = picPalette.ScaleHeight + 2 - shpSel2.left = picPalette.ScaleWidth + 2 - shpSel2.Top = picPalette.ScaleHeight + 2 - -End Sub - -Public Function textControl() As Boolean - - Dim i As Integer - - textControl = False - - For i = 0 To 2 - If Me.ActiveControl = txtRGB(i) Then - textControl = True - End If - Next - If Me.ActiveControl = txtOpacity Then - textControl = True - ElseIf Me.ActiveControl = txtRadius Then - textControl = True - End If - -End Function - - -Public Sub picClrMode_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picClrMode(Index), X, Y, BUTTON_SMALL, (Index = clrMode), BUTTON_DOWN - -End Sub - -Private Sub picClrMode_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picClrMode(Index), X, Y, BUTTON_SMALL, (Index = clrMode), BUTTON_MOVE, lblClrMode(Index).Width + 16 - -End Sub - -Private Sub picClrMode_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - Dim i As Integer - - clrMode = Index - - For i = 0 To 2 - If i <> Index Then - mouseEvent2 picClrMode(i), X, Y, BUTTON_SMALL, (i = clrMode), BUTTON_UP - End If - Next - - frmSoldatMapEditor.setColorMode clrMode - frmSoldatMapEditor.RegainFocus - -End Sub - -Private Sub picTitle_DblClick() - - collapsed = Not collapsed - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - - snapForm Me, frmTools - ' snapForm Me, frmPalette - snapForm Me, frmWaypoints - snapForm Me, frmDisplay - snapForm Me, frmScenery - snapForm Me, frmInfo - snapForm Me, frmTexture - Me.Tag = snapForm(Me, frmSoldatMapEditor) - - xPos = Me.left / Screen.TwipsPerPixelX - yPos = Me.Top / Screen.TwipsPerPixelY - -End Sub - -Private Sub picPaletteMenu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picPaletteMenu, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - - PopupMenu mnuPalette, , picPaletteMenu.left + 32, picPaletteMenu.Top + 16 - - mouseEvent2 picPaletteMenu, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub picPaletteMenu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picPaletteMenu, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Public Sub SetColors() - - On Error Resume Next - - Dim i As Integer - Dim c As Control - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_palette.bmp") - - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picPaletteMenu, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - - For i = 0 To 2 - mouseEvent2 picClrMode(i), 0, 0, BUTTON_SMALL, (clrMode = i), BUTTON_UP - Next - - Me.BackColor = bgClr - For i = 0 To 6 - lblPal(i).BackColor = lblBackClr - lblPal(i).ForeColor = lblTextClr - Next - For i = 0 To 2 - lblClrMode(i).BackColor = lblBackClr - lblClrMode(i).ForeColor = lblTextClr - txtRGB(i).BackColor = txtBackClr - txtRGB(i).ForeColor = txtTextClr - Next - - txtOpacity.BackColor = txtBackClr - txtOpacity.ForeColor = txtTextClr - txtRadius.BackColor = txtBackClr - txtRadius.ForeColor = txtTextClr - cboBlendMode.BackColor = txtBackClr - cboBlendMode.ForeColor = txtTextClr - - For Each c In Me.Controls - If c.Tag = "font1" Then - c.Font.Name = font1 - ElseIf c.Tag = "font2" Then - c.Font.Name = font2 - End If - Next - -End Sub +VERSION 5.00 +Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" +Begin VB.Form frmPalette + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 1 'Fixed Single + ClientHeight = 4080 + ClientLeft = 120 + ClientTop = 120 + ClientWidth = 3120 + ControlBox = 0 'False + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 272 + ScaleMode = 3 'Pixel + ScaleWidth = 208 + ShowInTaskbar = 0 'False + StartUpPosition = 3 'Windows Default + Begin VB.PictureBox picClrMode + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 2 + Left = 1200 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 23 + Tag = "6" + Top = 1080 + Width = 240 + End + Begin VB.PictureBox picClrMode + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 1 + Left = 1200 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 22 + Tag = "6" + Top = 840 + Width = 240 + End + Begin VB.PictureBox picClrMode + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 0 + Left = 1200 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 21 + Tag = "6" + Top = 600 + Width = 240 + End + Begin VB.TextBox txtRadius + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 2520 + TabIndex = 16 + Tag = "font1" + Text = "0" + Top = 1440 + Width = 495 + End + Begin MSComDlg.CommonDialog commonDialog + Left = 360 + Top = 600 + _ExtentX = 847 + _ExtentY = 847 + _Version = 393216 + CancelError = -1 'True + End + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 255 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 208 + TabIndex = 13 + TabStop = 0 'False + Top = 0 + Width = 3120 + Begin VB.PictureBox picHide + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 2880 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 14 + TabStop = 0 'False + Tag = "3" + Top = 0 + Width = 240 + End + Begin VB.PictureBox picPaletteMenu + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 2640 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 15 + TabStop = 0 'False + Tag = "8" + Top = 0 + Width = 240 + End + End + Begin VB.ComboBox cboBlendMode + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + ItemData = "frmPalette.frx":0000 + Left = 2040 + List = "frmPalette.frx":0016 + Style = 2 'Dropdown List + TabIndex = 5 + Tag = "font1" + Top = 2160 + Width = 960 + End + Begin VB.PictureBox picColor + Appearance = 0 'Flat + BackColor = &H00000000& + ForeColor = &H80000008& + Height = 975 + Left = 120 + ScaleHeight = 63 + ScaleMode = 3 'Pixel + ScaleWidth = 63 + TabIndex = 7 + TabStop = 0 'False + ToolTipText = "Current Color" + Top = 360 + Width = 975 + End + Begin VB.TextBox txtRGB + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Index = 0 + Left = 600 + TabIndex = 1 + Tag = "font1" + Text = "0" + Top = 1440 + Width = 480 + End + Begin VB.TextBox txtRGB + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Index = 1 + Left = 600 + TabIndex = 2 + Tag = "font1" + Text = "0" + Top = 1800 + Width = 480 + End + Begin VB.TextBox txtRGB + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Index = 2 + Left = 600 + TabIndex = 3 + Tag = "font1" + Text = "0" + Top = 2160 + Width = 480 + End + Begin VB.TextBox txtOpacity + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 2520 + TabIndex = 4 + Tag = "font1" + Text = "0" + Top = 1800 + Width = 480 + End + Begin VB.PictureBox picPalette + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H00000000& + FillColor = &H00FFFFFF& + ForeColor = &H00FFFFFF& + Height = 1470 + Left = 120 + ScaleHeight = 96 + ScaleMode = 3 'Pixel + ScaleWidth = 192 + TabIndex = 6 + TabStop = 0 'False + ToolTipText = "Palette" + Top = 2520 + Width = 2910 + Begin VB.Shape shpSel1 + BorderColor = &H00FFFFFF& + DrawMode = 6 'Mask Pen Not + Height = 210 + Left = 240 + Top = 0 + Width = 210 + End + Begin VB.Shape shpSel2 + Height = 240 + Left = 0 + Top = 0 + Width = 240 + End + End + Begin VB.CommandButton cmdDefault + Default = -1 'True + Height = 495 + Left = 360 + TabIndex = 0 + Top = 600 + Width = 495 + End + Begin VB.Label lblPal + BackStyle = 0 'Transparent + Caption = "Vertex Color:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 6 + Left = 1200 + TabIndex = 24 + Tag = "font2" + Top = 360 + Width = 1695 + End + Begin VB.Label lblClrMode + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = " Dynamic" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 1440 + TabIndex = 20 + Tag = "font2" + Top = 1080 + Width = 1095 + End + Begin VB.Label lblClrMode + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = " Normal" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 1440 + TabIndex = 19 + Tag = "font2" + Top = 840 + Width = 1095 + End + Begin VB.Label lblClrMode + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = " Precision" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 1440 + TabIndex = 18 + Tag = "font2" + Top = 600 + Width = 1095 + End + Begin VB.Label lblPal + BackColor = &H00614B3D& + Caption = "Radius:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 3 + Left = 1200 + TabIndex = 17 + Tag = "font2" + Top = 1440 + Width = 855 + End + Begin VB.Label lblPal + BackColor = &H00614B3D& + Caption = "Mode:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 5 + Left = 1200 + TabIndex = 12 + Tag = "font2" + Top = 2160 + Width = 735 + End + Begin VB.Label lblPal + BackColor = &H00614B3D& + Caption = "R:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 120 + TabIndex = 11 + Tag = "font2" + Top = 1440 + Width = 255 + End + Begin VB.Label lblPal + BackColor = &H00614B3D& + Caption = "G:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 120 + TabIndex = 10 + Tag = "font2" + Top = 1800 + Width = 255 + End + Begin VB.Label lblPal + BackColor = &H00614B3D& + Caption = "B:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 120 + TabIndex = 9 + Tag = "font2" + Top = 2160 + Width = 255 + End + Begin VB.Label lblPal + BackColor = &H00614B3D& + Caption = "Opacity:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 4 + Left = 1200 + TabIndex = 8 + Tag = "font2" + Top = 1800 + Width = 975 + End + Begin VB.Menu mnuPalette + Caption = "Palette" + Visible = 0 'False + Begin VB.Menu mnuLoadPalette + Caption = "Load Palette" + End + Begin VB.Menu mnuSavePalette + Caption = "Save Palette" + End + Begin VB.Menu mnuClearPalette + Caption = "Clear" + End + End + Begin VB.Menu mnuNewColor + Caption = "NewColor" + Visible = 0 'False + Begin VB.Menu mnuAddToPalette + Caption = "Add to Palette" + End + End +End +Attribute VB_Name = "frmPalette" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Private Type TColor + red As Byte + green As Byte + blue As Byte +End Type + +Dim clrPalette(0 To 11, 0 To 5) As TColor + +Dim formHeight As Integer +Public collapsed As Boolean +Public xPos As Integer, yPos As Integer + +Dim radius As Integer +Dim clrMode As Byte + +Dim xVal As Integer, yVal As Integer + +Dim tempVal As Integer + +Public Function getPalClr(X As Integer, Y As Integer) As Long + + getPalClr = RGB(clrPalette(X, Y).blue, clrPalette(X, Y).green, clrPalette(X, Y).red) + +End Function + +Public Sub setPalClr(X As Integer, Y As Integer, clrVal As Long) + + clrPalette(X, Y) = getRGB(clrVal) + +End Sub + +Public Sub refreshPalette(R As Integer, op As Single, blend As Integer, mode As Byte) + + Dim X As Integer, Y As Integer, i As Integer + + For Y = 0 To 5 + For X = 0 To 11 + frmPalette.picPalette.Line (X * 16, Y * 16)-(X * 16 + 16, 16 * 16 + 16), RGB(clrPalette(X, Y).red, clrPalette(X, Y).green, clrPalette(X, Y).blue), BF + Next + Next + + radius = R + txtRadius.Text = R + txtOpacity.Text = op * 100 + cboBlendMode.ListIndex = blend + clrMode = mode + + For i = 0 To 2 + If i = clrMode Then + BitBlt picClrMode(i).hDC, 0, 0, 16, 16, frmSoldatMapEditor.picGfx.hDC, 96, 112, vbSrcCopy + Else + BitBlt picClrMode(i).hDC, 0, 0, 16, 16, frmSoldatMapEditor.picGfx.hDC, 96, 96, vbSrcCopy + End If + picClrMode(i).Refresh + Next + + For i = 0 To 2 + mouseEvent2 picClrMode(i), 0, 0, BUTTON_SMALL, (clrMode = i), BUTTON_UP + Next + +End Sub + +Private Function getRGB(DecValue As Long) As TColor + + Dim hexValue As String + + hexValue = Hex$(Val(DecValue)) + + If Len(hexValue) < 6 Then + hexValue = String$(6 - Len(hexValue), "0") + hexValue + End If + + getRGB.blue = CLng("&H" + right(hexValue, 2)) + hexValue = left(hexValue, Len(hexValue) - 2) + getRGB.green = CLng("&H" + right(hexValue, 2)) + hexValue = left(hexValue, Len(hexValue) - 2) + getRGB.red = CLng("&H" + right(hexValue, 2)) + +End Function + +Public Sub checkPalette(red As Byte, green As Byte, blue As Byte) + + Dim X As Integer, Y As Integer + Dim foundClr As Boolean + + For Y = 0 To 5 + For X = 0 To 11 + If red = clrPalette(X, Y).red And green = clrPalette(X, Y).green And blue = clrPalette(X, Y).blue And Not foundClr Then + shpSel1.left = X * 16 + 1 + shpSel1.Top = Y * 16 + 1 + shpSel2.left = X * 16 + shpSel2.Top = Y * 16 + foundClr = True + End If + Next + Next + +End Sub + +Private Sub cmdDefault_Click() + + cmdDefault.SetFocus + +End Sub + +Private Sub Form_Click() + + cmdDefault.SetFocus + +End Sub + +Private Sub Form_Load() + + Dim i As Integer + + On Error GoTo ErrorHandler + + Me.SetColors + + frmPalette.loadPalette appPath & "\palettes\current.txt" + + setValues frmColor.red, frmColor.green, frmColor.blue + + shpSel1.left = picPalette.ScaleWidth + 2 + shpSel1.Top = picPalette.ScaleHeight + 2 + shpSel2.left = picPalette.ScaleWidth + 2 + shpSel2.Top = picPalette.ScaleHeight + 2 + + formHeight = Me.ScaleHeight + + setForm + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading Palette form" + +End Sub + +Public Sub setForm() + + Me.left = xPos * Screen.TwipsPerPixelX + Me.Top = yPos * Screen.TwipsPerPixelY + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Public Sub loadPalette(fileName As String) + + On Error GoTo ErrorHandler + + Dim X As Integer, Y As Integer + Dim fileOpen As Boolean + + fileOpen = False + + Open fileName For Input As #1 + fileOpen = True + + For Y = 0 To 5 + For X = 0 To 11 + Input #1, clrPalette(X, Y).red + Input #1, clrPalette(X, Y).green + Input #1, clrPalette(X, Y).blue + frmPalette.picPalette.Line (X * 16, Y * 16)-(X * 16 + 16, 16 * 16 + 16), RGB(clrPalette(X, Y).red, clrPalette(X, Y).green, clrPalette(X, Y).blue), BF + Next + Next + + Close #1 + fileOpen = False + + shpSel1.left = picPalette.ScaleWidth + 2 + shpSel1.Top = picPalette.ScaleHeight + 2 + shpSel2.left = picPalette.ScaleWidth + 2 + shpSel2.Top = picPalette.ScaleHeight + 2 + + picPalette.Refresh + + Exit Sub + +ErrorHandler: + + mnuClearPalette_Click + If fileOpen Then Close #1 + MsgBox "Error loading palette" & vbNewLine & Error$ + +End Sub + +Private Sub Form_LostFocus() + + cmdDefault.SetFocus + +End Sub + +Private Sub lblClrMode_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + picClrMode_MouseMove Index, 1, 0, 0, 0 + +End Sub + +Private Sub mnuLoadPalette_Click() + + On Error GoTo ErrorHandler + + commonDialog.InitDir = appPath & "\palettes\" + commonDialog.DialogTitle = "Load Palette" + commonDialog.Filter = "Text Documents (*.txt)|*.txt" + commonDialog.ShowOpen + + If commonDialog.fileName <> "" Then + loadPalette commonDialog.fileName + End If + + Exit Sub + +ErrorHandler: + +End Sub + +Public Sub savePalette(fileName As String) + + Dim X As Integer, Y As Integer + Dim fileOpen As Boolean + + On Error GoTo ErrorHandler + + fileOpen = False + + Open fileName For Output As #1 + fileOpen = True + + For Y = 0 To 5 + For X = 0 To 11 + Print #1, clrPalette(X, Y).red & ", " & clrPalette(X, Y).green & ", " & clrPalette(X, Y).blue + Next + Next + + Close #1 + fileOpen = False + + Exit Sub + +ErrorHandler: + + If fileOpen Then Close #1 + MsgBox "Error saving palette" & vbNewLine & Error$ + +End Sub + +Private Sub mnuSavePalette_Click() + + On Error GoTo ErrorHandler + + commonDialog.InitDir = appPath & "\palettes\" + commonDialog.DialogTitle = "Save Palette" + commonDialog.Filter = "Text Documents (*.txt)|*.txt" + commonDialog.ShowSave + + If commonDialog.fileName <> "" Then + savePalette commonDialog.fileName + End If + + Exit Sub + +ErrorHandler: + +End Sub + +Private Sub mnuClearPalette_Click() + + Dim X As Integer, Y As Integer + + For Y = 0 To 5 + For X = 0 To 11 + clrPalette(X, Y).red = 0 + clrPalette(X, Y).green = 0 + clrPalette(X, Y).blue = 0 + frmPalette.picPalette.Line (X * 16, Y * 16)-(X * 16 + 16, 16 * 16 + 16), 0, BF + Next + Next + + shpSel1.left = picPalette.ScaleWidth + 2 + shpSel1.Top = picPalette.ScaleHeight + 2 + shpSel2.left = picPalette.ScaleWidth + 2 + shpSel2.Top = picPalette.ScaleHeight + 2 + +End Sub + +Private Sub picHide_Click() + + Me.Hide + frmSoldatMapEditor.mnuPalette.Checked = False + +End Sub + +Private Sub picPalette_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + If Button = 1 Then 'select color + + xVal = Int(X / 16) + yVal = Int(Y / 16) + frmSoldatMapEditor.setPaletteColor clrPalette(xVal, yVal).red, clrPalette(xVal, yVal).green, clrPalette(xVal, yVal).blue + + txtRGB(0).Text = clrPalette(xVal, yVal).red + txtRGB(1).Text = clrPalette(xVal, yVal).green + txtRGB(2).Text = clrPalette(xVal, yVal).blue + picColor.BackColor = RGB(clrPalette(xVal, yVal).red, clrPalette(xVal, yVal).green, clrPalette(xVal, yVal).blue) + + shpSel1.left = Int(X / 16) * 16 + 1 + shpSel1.Top = Int(Y / 16) * 16 + 1 + shpSel2.left = Int(X / 16) * 16 + shpSel2.Top = Int(Y / 16) * 16 + + ElseIf Button = 2 Then 'new color + + xVal = Int(X / 16) + yVal = Int(Y / 16) + Me.PopupMenu mnuNewColor + + End If + + cmdDefault.SetFocus + +End Sub + +Public Sub newPaletteColor() + + clrPalette(xVal, yVal).red = txtRGB(0).Text + clrPalette(xVal, yVal).green = txtRGB(1).Text + clrPalette(xVal, yVal).blue = txtRGB(2).Text + picPalette.Line (xVal * 16, yVal * 16)-(xVal * 16 + 15, yVal * 16 + 15), RGB(clrPalette(xVal, yVal).red, clrPalette(xVal, yVal).green, clrPalette(xVal, yVal).blue), BF + shpSel1.left = xVal * 16 + 1 + shpSel1.Top = yVal * 16 + 1 + shpSel2.left = xVal * 16 + shpSel2.Top = yVal * 16 + +End Sub + +Private Sub mnuAddToPalette_Click() + + newPaletteColor + +End Sub + +Private Sub picColor_Click() + + frmColor.InitClr txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text + + frmColor.ChangeColor picColor, txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text, 0 + +End Sub + +Private Sub txtradius_Change() + + If IsNumeric(txtRadius.Text) = False And txtRadius.Text <> "" Then + txtRadius.Text = radius + End If + +End Sub + +Private Sub txtradius_GotFocus() + + SelectAllText txtRadius + +End Sub + +Private Sub txtradius_LostFocus() + + If IsNumeric(txtRadius.Text) = False And txtRadius.Text <> "" Then + txtRadius.Text = radius + ElseIf txtRadius.Text = "" Then + txtRadius.Text = radius + ElseIf txtRadius.Text >= 4 And txtRadius.Text <= 128 Then + radius = Int(txtRadius.Text) + txtRadius.Text = radius + frmSoldatMapEditor.setRadius radius + Else + If txtRadius.Text < 4 Then radius = 4 + If txtRadius.Text > 128 Then radius = 128 + txtRadius.Text = radius + frmSoldatMapEditor.setRadius radius + End If + +End Sub + +Private Sub txtRGB_Change(Index As Integer) + + If IsNumeric(txtRGB(Index).Text) = False And txtRGB(Index).Text <> "" Then + ElseIf txtRGB(Index).Text = "" Then + + ElseIf txtRGB(Index).Text >= 0 And txtRGB(Index).Text <= 255 Then + picColor.BackColor = RGB(txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text) + frmSoldatMapEditor.setPolyColor Index, txtRGB(Index).Text + End If + +End Sub + +Private Sub txtRGB_GotFocus(Index As Integer) + + If IsNumeric(txtRGB(Index).Text) Then + tempVal = txtRGB(Index).Text + Else + tempVal = 0 + End If + SelectAllText txtRGB(Index) + +End Sub + +Private Sub txtRGB_LostFocus(Index As Integer) + + If Not IsNumeric(txtRGB(Index).Text) Then + txtRGB(Index).Text = tempVal + ElseIf txtRGB(Index).Text = "" Then + txtRGB(Index).Text = tempVal + ElseIf txtRGB(Index).Text >= 0 And txtRGB(Index).Text <= 255 Then + frmSoldatMapEditor.setPolyColor Index, txtRGB(Index).Text + Else + txtRGB(Index).Text = tempVal + End If + + picColor.BackColor = RGB(txtRGB(0).Text, txtRGB(1).Text, txtRGB(2).Text) + +End Sub + +Private Sub txtOpacity_Change() + + If IsNumeric(txtOpacity.Text) = False And txtOpacity.Text <> "" Then + txtOpacity.Text = 100 + ElseIf txtOpacity.Text = "" Then + + ElseIf txtOpacity.Text >= 0 And txtOpacity.Text <= 100 Then + frmSoldatMapEditor.setPolyColor 3, txtOpacity.Text + End If + +End Sub + +Private Sub txtOpacity_GotFocus() + + SelectAllText txtOpacity + +End Sub + +Private Sub txtOpacity_LostFocus() + + If txtOpacity.Text = "" Then + txtOpacity.Text = 0 + ElseIf txtOpacity.Text >= 0 And txtOpacity.Text <= 100 Then + Else + txtOpacity.Text = 0 + End If + +End Sub + +Private Sub cboBlendMode_Click() + + frmSoldatMapEditor.setBlendMode cboBlendMode.ListIndex + +End Sub + +Public Sub setValues(R As Byte, G As Byte, B As Byte) + + txtRGB(0).Text = R + txtRGB(1).Text = G + txtRGB(2).Text = B + picColor.BackColor = RGB(R, G, B) + shpSel1.left = picPalette.ScaleWidth + 2 + shpSel1.Top = picPalette.ScaleHeight + 2 + shpSel2.left = picPalette.ScaleWidth + 2 + shpSel2.Top = picPalette.ScaleHeight + 2 + +End Sub + +Public Function textControl() As Boolean + + Dim i As Integer + + textControl = False + + For i = 0 To 2 + If Me.ActiveControl = txtRGB(i) Then + textControl = True + End If + Next + If Me.ActiveControl = txtOpacity Then + textControl = True + ElseIf Me.ActiveControl = txtRadius Then + textControl = True + End If + +End Function + + +Public Sub picClrMode_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picClrMode(Index), X, Y, BUTTON_SMALL, (Index = clrMode), BUTTON_DOWN + +End Sub + +Private Sub picClrMode_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picClrMode(Index), X, Y, BUTTON_SMALL, (Index = clrMode), BUTTON_MOVE, lblClrMode(Index).Width + 16 + +End Sub + +Private Sub picClrMode_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + Dim i As Integer + + clrMode = Index + + For i = 0 To 2 + If i <> Index Then + mouseEvent2 picClrMode(i), X, Y, BUTTON_SMALL, (i = clrMode), BUTTON_UP + End If + Next + + frmSoldatMapEditor.setColorMode clrMode + frmSoldatMapEditor.RegainFocus + +End Sub + +Private Sub picTitle_DblClick() + + collapsed = Not collapsed + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + + snapForm Me, frmTools + ' snapForm Me, frmPalette + snapForm Me, frmWaypoints + snapForm Me, frmDisplay + snapForm Me, frmScenery + snapForm Me, frmInfo + snapForm Me, frmTexture + Me.Tag = snapForm(Me, frmSoldatMapEditor) + + xPos = Me.left / Screen.TwipsPerPixelX + yPos = Me.Top / Screen.TwipsPerPixelY + +End Sub + +Private Sub picPaletteMenu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picPaletteMenu, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + + PopupMenu mnuPalette, , picPaletteMenu.left + 32, picPaletteMenu.Top + 16 + + mouseEvent2 picPaletteMenu, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub picPaletteMenu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picPaletteMenu, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + Dim i As Integer + Dim c As Control + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_palette.bmp") + + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picPaletteMenu, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + + For i = 0 To 2 + mouseEvent2 picClrMode(i), 0, 0, BUTTON_SMALL, (clrMode = i), BUTTON_UP + Next + + Me.BackColor = bgClr + For i = 0 To 6 + lblPal(i).BackColor = lblBackClr + lblPal(i).ForeColor = lblTextClr + Next + For i = 0 To 2 + lblClrMode(i).BackColor = lblBackClr + lblClrMode(i).ForeColor = lblTextClr + txtRGB(i).BackColor = txtBackClr + txtRGB(i).ForeColor = txtTextClr + Next + + txtOpacity.BackColor = txtBackClr + txtOpacity.ForeColor = txtTextClr + txtRadius.BackColor = txtBackClr + txtRadius.ForeColor = txtTextClr + cboBlendMode.BackColor = txtBackClr + cboBlendMode.ForeColor = txtTextClr + + For Each c In Me.Controls + If c.Tag = "font1" Then + c.Font.Name = font1 + ElseIf c.Tag = "font2" Then + c.Font.Name = font2 + End If + Next + +End Sub diff --git a/frmPreferences.frm b/frmPreferences.frm index 1c9c675..6a6313e 100644 --- a/frmPreferences.frm +++ b/frmPreferences.frm @@ -1,2610 +1,2610 @@ -VERSION 5.00 -Begin VB.Form frmPreferences - BackColor = &H004A3C31& - BorderStyle = 1 'Fixed Single - ClientHeight = 6600 - ClientLeft = 15 - ClientTop = 15 - ClientWidth = 6840 - ControlBox = 0 'False - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 440 - ScaleMode = 3 'Pixel - ScaleWidth = 456 - ShowInTaskbar = 0 'False - StartUpPosition = 1 'CenterOwner - Begin VB.PictureBox picTopmost - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 4800 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 78 - TabStop = 0 'False - Tag = "4" - Top = 7440 - Visible = 0 'False - Width = 240 - End - Begin VB.PictureBox picScenery - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 4800 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 77 - TabStop = 0 'False - Tag = "4" - Top = 6960 - Width = 240 - End - Begin VB.ComboBox cboSkin - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 1320 - Style = 2 'Dropdown List - TabIndex = 6 - Tag = "font1" - Top = 3600 - Width = 2535 - End - Begin VB.TextBox txtHotkey - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 13 - Left = 6240 - TabIndex = 23 - Tag = "font1" - Top = 3720 - Width = 255 - End - Begin VB.TextBox txtHotkey - Alignment = 1 'Right Justify - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 12 - Left = 4800 - TabIndex = 22 - Tag = "font1" - Top = 3720 - Width = 255 - End - Begin VB.PictureBox picSekrit - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 360 - Left = 120 - ScaleHeight = 24 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 74 - TabStop = 0 'False - Tag = "3" - Top = 6120 - Width = 960 - End - Begin VB.TextBox txtWayptKey - Alignment = 2 'Center - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 4 - Left = 6120 - TabIndex = 28 - Tag = "font1" - Text = "X" - ToolTipText = "Fly" - Top = 5520 - Width = 255 - End - Begin VB.TextBox txtWayptKey - Alignment = 2 'Center - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 3 - Left = 5400 - TabIndex = 27 - Tag = "font1" - Text = "Z" - ToolTipText = "Down" - Top = 5520 - Width = 255 - End - Begin VB.TextBox txtWayptKey - Alignment = 2 'Center - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 2 - Left = 5400 - TabIndex = 24 - Tag = "font1" - Text = "W" - ToolTipText = "Up" - Top = 4800 - Width = 255 - End - Begin VB.TextBox txtWayptKey - Alignment = 2 'Center - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 1 - Left = 5760 - TabIndex = 26 - Tag = "font1" - Text = "S" - ToolTipText = "Right" - Top = 5160 - Width = 255 - End - Begin VB.TextBox txtWayptKey - Alignment = 2 'Center - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 0 - Left = 5040 - TabIndex = 25 - Tag = "font1" - Text = "A" - ToolTipText = "Left" - Top = 5160 - Width = 255 - End - Begin VB.PictureBox picPrefabs - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 3960 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 71 - TabStop = 0 'False - Tag = "10" - Top = 5520 - Width = 240 - End - Begin VB.TextBox txtPrefabs - Appearance = 0 'Flat - BackColor = &H00FFFFFF& - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00000000& - Height = 285 - Left = 360 - TabIndex = 9 - Tag = "font1" - Top = 5520 - Width = 3495 - End - Begin VB.TextBox txtUncomp - Appearance = 0 'Flat - BackColor = &H00FFFFFF& - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00000000& - Height = 285 - Left = 360 - TabIndex = 8 - Tag = "font1" - Top = 4920 - Width = 3495 - End - Begin VB.PictureBox picUncomp - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 3960 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 68 - TabStop = 0 'False - Tag = "10" - Top = 4920 - Width = 240 - End - Begin VB.TextBox txtHotkey - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 11 - Left = 6240 - TabIndex = 21 - Tag = "font1" - Top = 3240 - Width = 255 - End - Begin VB.TextBox txtHotkey - Alignment = 1 'Right Justify - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 10 - Left = 4800 - TabIndex = 20 - Tag = "font1" - Top = 3240 - Width = 255 - End - Begin VB.TextBox txtHotkey - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 9 - Left = 6240 - TabIndex = 19 - Tag = "font1" - Top = 2760 - Width = 255 - End - Begin VB.TextBox txtHotkey - Alignment = 1 'Right Justify - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 8 - Left = 4800 - TabIndex = 18 - Tag = "font1" - Top = 2760 - Width = 255 - End - Begin VB.TextBox txtHotkey - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 7 - Left = 6240 - TabIndex = 17 - Tag = "font1" - Top = 2280 - Width = 255 - End - Begin VB.TextBox txtHotkey - Alignment = 1 'Right Justify - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 6 - Left = 4800 - TabIndex = 16 - Tag = "font1" - Top = 2280 - Width = 255 - End - Begin VB.TextBox txtHotkey - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 5 - Left = 6240 - TabIndex = 15 - Tag = "font1" - Top = 1800 - Width = 255 - End - Begin VB.TextBox txtHotkey - Alignment = 1 'Right Justify - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 4 - Left = 4800 - TabIndex = 14 - Tag = "font1" - Top = 1800 - Width = 255 - End - Begin VB.TextBox txtHotkey - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 3 - Left = 6240 - TabIndex = 13 - Tag = "font1" - Top = 1320 - Width = 255 - End - Begin VB.TextBox txtHotkey - Alignment = 1 'Right Justify - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 2 - Left = 4800 - TabIndex = 12 - Tag = "font1" - Top = 1320 - Width = 255 - End - Begin VB.TextBox txtHotkey - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 1 - Left = 6240 - TabIndex = 11 - Tag = "font1" - Top = 840 - Width = 255 - End - Begin VB.TextBox txtHotkey - Alignment = 1 'Right Justify - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 285 - Index = 0 - Left = 4800 - TabIndex = 10 - Tag = "font1" - Top = 840 - Width = 255 - End - Begin VB.PictureBox picHotkeys - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 3360 - Left = 5160 - ScaleHeight = 224 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 67 - TabStop = 0 'False - Top = 720 - Width = 960 - End - Begin VB.TextBox txtOpacity2 - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 2880 - TabIndex = 5 - Tag = "font1" - Top = 2640 - Width = 495 - End - Begin VB.TextBox txtOpacity1 - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 2880 - TabIndex = 4 - Tag = "font1" - Top = 2280 - Width = 495 - End - Begin VB.PictureBox picGridClr2 - Appearance = 0 'Flat - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 255 - Left = 3960 - ScaleHeight = 225 - ScaleWidth = 225 - TabIndex = 60 - TabStop = 0 'False - Top = 2640 - Width = 255 - End - Begin VB.PictureBox picFolder - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 3960 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 33 - TabStop = 0 'False - Tag = "10" - Top = 4320 - Width = 240 - End - Begin VB.TextBox txtHeight - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 1560 - TabIndex = 1 - Tag = "font1" - Top = 1320 - Width = 615 - End - Begin VB.TextBox txtWidth - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 1560 - TabIndex = 0 - Tag = "font1" - Top = 960 - Width = 615 - End - Begin VB.TextBox txtDir - Appearance = 0 'Flat - BackColor = &H00FFFFFF& - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00000000& - Height = 285 - Left = 360 - TabIndex = 7 - Tag = "font1" - Top = 4320 - Width = 3495 - End - Begin VB.TextBox txtDivisions - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 1560 - TabIndex = 3 - Tag = "font1" - Top = 2640 - Width = 495 - End - Begin VB.TextBox txtSpacing - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - Left = 1560 - TabIndex = 2 - Tag = "font1" - Top = 2280 - Width = 495 - End - Begin VB.PictureBox picGridClr - Appearance = 0 'Flat - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 255 - Left = 3960 - ScaleHeight = 225 - ScaleWidth = 225 - TabIndex = 53 - TabStop = 0 'False - Top = 2280 - Width = 255 - End - Begin VB.PictureBox picApply - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 360 - Left = 5760 - ScaleHeight = 24 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 49 - TabStop = 0 'False - Tag = "2" - Top = 6120 - Width = 960 - End - Begin VB.PictureBox picOK - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 360 - Left = 3600 - ScaleHeight = 24 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 48 - TabStop = 0 'False - Tag = "0" - Top = 6120 - Width = 960 - End - Begin VB.PictureBox picCancel - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 360 - Left = 4680 - ScaleHeight = 24 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 47 - TabStop = 0 'False - Tag = "1" - Top = 6120 - Width = 960 - End - Begin VB.PictureBox picBackClr - Appearance = 0 'Flat - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 255 - Left = 3960 - ScaleHeight = 225 - ScaleWidth = 225 - TabIndex = 38 - TabStop = 0 'False - Top = 1680 - Width = 255 - End - Begin VB.PictureBox picPointClr - Appearance = 0 'Flat - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 255 - Left = 3960 - ScaleHeight = 225 - ScaleWidth = 225 - TabIndex = 37 - TabStop = 0 'False - Top = 960 - Width = 255 - End - Begin VB.PictureBox picSelectionClr - Appearance = 0 'Flat - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 255 - Left = 3960 - ScaleHeight = 225 - ScaleWidth = 225 - TabIndex = 36 - TabStop = 0 'False - Top = 1320 - Width = 255 - End - Begin VB.ComboBox cboWireSrc - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 315 - ItemData = "frmPreferences.frx":0000 - Left = 1200 - List = "frmPreferences.frx":001C - Style = 2 'Dropdown List - TabIndex = 29 - TabStop = 0 'False - Top = 7080 - Width = 1455 - End - Begin VB.ComboBox cboWireDest - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 315 - ItemData = "frmPreferences.frx":0072 - Left = 1200 - List = "frmPreferences.frx":008E - Style = 2 'Dropdown List - TabIndex = 30 - TabStop = 0 'False - Top = 7440 - Width = 1455 - End - Begin VB.ComboBox cboPolyDest - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 315 - ItemData = "frmPreferences.frx":00E4 - Left = 2760 - List = "frmPreferences.frx":0100 - Style = 2 'Dropdown List - TabIndex = 32 - TabStop = 0 'False - Top = 7440 - Width = 1455 - End - Begin VB.ComboBox cboPolySrc - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 315 - ItemData = "frmPreferences.frx":0156 - Left = 2760 - List = "frmPreferences.frx":0172 - Style = 2 'Dropdown List - TabIndex = 31 - TabStop = 0 'False - Top = 7080 - Width = 1455 - End - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 255 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 456 - TabIndex = 34 - TabStop = 0 'False - Top = 0 - Width = 6840 - Begin VB.PictureBox picHide - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 6600 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 35 - TabStop = 0 'False - Tag = "3" - Top = 0 - Width = 240 - End - End - Begin VB.Label lblPref - BackStyle = 0 'Transparent - Caption = "Fullscreen always on top" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 375 - Index = 24 - Left = 5040 - TabIndex = 80 - Tag = "font2" - Top = 7440 - Visible = 0 'False - Width = 1575 - End - Begin VB.Label lblPref - BackStyle = 0 'Transparent - Caption = "Use 4 verts for scenery" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 375 - Index = 23 - Left = 5040 - TabIndex = 79 - Tag = "font2" - Top = 6960 - Width = 1575 - End - Begin VB.Label lblOther - BackColor = &H004A3C31& - Caption = "Other" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 4800 - TabIndex = 76 - Top = 6600 - Width = 735 - End - Begin VB.Shape fraPref - BorderColor = &H000B3C0D& - Height = 1215 - Index = 5 - Left = 4560 - Top = 6720 - Width = 2175 - End - Begin VB.Label lblPref - BackColor = &H004A3C31& - BackStyle = 0 'Transparent - Caption = "Skin" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 22 - Left = 360 - TabIndex = 75 - Tag = "font2" - Top = 3600 - Width = 975 - End - Begin VB.Label lblWayKeys - Alignment = 2 'Center - BackColor = &H004A3C31& - Caption = "Waypoint Keys" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 4800 - TabIndex = 73 - Tag = "font2" - Top = 4440 - Width = 1575 - End - Begin VB.Shape fraPref - BorderColor = &H000B3C0D& - Height = 1455 - Index = 3 - Left = 4560 - Top = 4560 - Width = 2175 - End - Begin VB.Label lblPref - BackColor = &H004A3C31& - BackStyle = 0 'Transparent - Caption = "Prefabs" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 17 - Left = 360 - TabIndex = 72 - Tag = "font2" - Top = 5280 - Width = 1335 - End - Begin VB.Label lblPref - BackColor = &H004A3C31& - BackStyle = 0 'Transparent - Caption = "Uncompiled" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 16 - Left = 360 - TabIndex = 70 - Tag = "font2" - Top = 4680 - Width = 1335 - End - Begin VB.Label lblPref - BackColor = &H004A3C31& - BackStyle = 0 'Transparent - Caption = "Soldat" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 10 - Left = 360 - TabIndex = 69 - Tag = "font2" - Top = 4080 - Width = 975 - End - Begin VB.Label lblHotkeys - Alignment = 2 'Center - BackColor = &H004F3D31& - Caption = "HotKeys" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 4800 - TabIndex = 66 - Tag = "font2" - Top = 360 - Width = 975 - End - Begin VB.Shape fraPref - BorderColor = &H000B3C0D& - Height = 3855 - Index = 1 - Left = 4560 - Top = 480 - Width = 2175 - End - Begin VB.Label lblPref - BackStyle = 0 'Transparent - Caption = "px" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 12 - Left = 2280 - TabIndex = 65 - Tag = "font2" - Top = 1320 - Width = 375 - End - Begin VB.Label lblPref - BackStyle = 0 'Transparent - Caption = "px" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 11 - Left = 2280 - TabIndex = 64 - Tag = "font2" - Top = 960 - Width = 375 - End - Begin VB.Label lblPref - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 15 - Left = 3360 - TabIndex = 63 - Tag = "font2" - Top = 2640 - Width = 255 - End - Begin VB.Label lblPref - BackStyle = 0 'Transparent - Caption = "%" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 14 - Left = 3360 - TabIndex = 62 - Tag = "font2" - Top = 2280 - Width = 255 - End - Begin VB.Label lblPref - Alignment = 2 'Center - BackColor = &H004A3C31& - BackStyle = 0 'Transparent - Caption = "Colors" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 8 - Left = 3000 - TabIndex = 61 - Tag = "font2" - Top = 720 - Width = 855 - End - Begin VB.Label lblPref - BackColor = &H004A3C31& - BackStyle = 0 'Transparent - Caption = "Window" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 7 - Left = 360 - TabIndex = 59 - Tag = "font2" - Top = 720 - Width = 855 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - Caption = "Height:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 360 - TabIndex = 58 - Tag = "font2" - Top = 1320 - Width = 1095 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - Caption = "Width:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 360 - TabIndex = 57 - Tag = "font2" - Top = 960 - Width = 1095 - End - Begin VB.Label lblPref - BackStyle = 0 'Transparent - Caption = "px" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 13 - Left = 2160 - TabIndex = 56 - Tag = "font2" - Top = 2280 - Width = 375 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - Caption = "Divisions:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 6 - Left = 360 - TabIndex = 55 - Tag = "font2" - Top = 2640 - Width = 1095 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - Caption = "Spacing:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 5 - Left = 360 - TabIndex = 54 - Tag = "font2" - Top = 2280 - Width = 1095 - End - Begin VB.Label lblPref - BackColor = &H004F3D31& - BackStyle = 0 'Transparent - Caption = "Grid" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 9 - Left = 360 - TabIndex = 52 - Tag = "font2" - Top = 2040 - Width = 615 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = "Wireframe" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 18 - Left = 1200 - TabIndex = 51 - Top = 6840 - Width = 1455 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - BackStyle = 0 'Transparent - Caption = "Polygon" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 19 - Left = 2880 - TabIndex = 50 - Top = 6840 - Width = 1455 - End - Begin VB.Label lblDirs - Alignment = 2 'Center - BackColor = &H004A3C31& - Caption = "Directories" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 360 - TabIndex = 46 - Tag = "font2" - Top = 3240 - Width = 1335 - End - Begin VB.Shape fraPref - BorderColor = &H000B3C0D& - Height = 2655 - Index = 2 - Left = 120 - Top = 3360 - Width = 4335 - End - Begin VB.Label lblDisplay - Alignment = 2 'Center - BackColor = &H004F3D31& - Caption = "Display" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 360 - TabIndex = 45 - Tag = "font2" - Top = 360 - Width = 855 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - Caption = "Pattern:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 3 - Left = 2880 - TabIndex = 44 - Tag = "font2" - Top = 1320 - Width = 975 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - Caption = "SRC:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 20 - Left = 360 - TabIndex = 43 - Top = 7080 - Width = 735 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - Caption = "DEST:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 21 - Left = 360 - TabIndex = 42 - Top = 7440 - Width = 735 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - Caption = "Back:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 4 - Left = 2880 - TabIndex = 41 - Tag = "font2" - Top = 1680 - Width = 975 - End - Begin VB.Label lblPref - BackColor = &H00614B3D& - Caption = "Point:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 2880 - TabIndex = 40 - Tag = "font2" - Top = 960 - Width = 975 - End - Begin VB.Label lblBlending - BackColor = &H004A3C31& - Caption = "Blending" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 360 - TabIndex = 39 - Top = 6600 - Width = 975 - End - Begin VB.Shape fraPref - BorderColor = &H000B3C0D& - Height = 2655 - Index = 0 - Left = 120 - Top = 480 - Width = 4335 - End - Begin VB.Shape fraPref - BorderColor = &H000B3C0D& - Height = 1215 - Index = 4 - Left = 120 - Top = 6720 - Width = 4335 - End -End -Attribute VB_Name = "frmPreferences" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Private Type TColor - red As Byte - green As Byte - blue As Byte -End Type - -Dim blendModes(0 To 7) As Integer - -Dim backClr As TColor -Dim pointClr As TColor -Dim selClr As TColor -Dim gridClr As TColor -Dim gridClr2 As TColor - -Dim spacing As Integer, divisions As Integer -Dim formWidth As Integer, formHeight As Integer -Dim opacity1 As Integer, opacity2 As Integer -Dim sceneryVerts As Boolean, topmost As Boolean - -Private Sub picHide_Click() - - Me.ScaleHeight = 408 - Unload Me - frmSoldatMapEditor.RegainFocus - -End Sub - -Private Sub picSekrit_Click() - - If Me.ScaleHeight < 460 Then - Me.Height = 544 * Screen.TwipsPerPixelY - Else - Me.Height = 440 * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - -End Sub - -Private Sub picApply_Click() - - applyPreferences - -End Sub - -Private Sub picCancel_Click() - - Me.ScaleHeight = 408 - Unload Me - frmSoldatMapEditor.RegainFocus - -End Sub - -Private Function applyPreferences() As Boolean - - Dim i As Integer - - On Error GoTo ErrorHandler - - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picOK, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - mouseEvent2 picCancel, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - mouseEvent2 picSekrit, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - mouseEvent2 picApply, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - mouseEvent2 picFolder, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - - If right(txtDir.Text, 1) <> "\" Then txtDir.Text = txtDir.Text + "\" - - If Len(Dir(txtDir.Text, vbDirectory)) <> 0 And frmSoldatMapEditor.soldatDir <> txtDir.Text Then - If Not Len(Dir(txtDir.Text & "Maps\", vbDirectory)) <> 0 Then - MsgBox "'Maps' folder does not exist in Soldat directory." - Exit Function - End If - If Not Len(Dir(txtDir.Text & "Textures\", vbDirectory)) <> 0 Then - MsgBox "'Textures' folder does not exist in Soldat directory." - Exit Function - End If - If Not Len(Dir(txtDir.Text & "Scenery-gfx\", vbDirectory)) <> 0 Then - MsgBox "'Scenery-gfx' folder does not exist in Soldat directory." - Exit Function - End If - - frmSoldatMapEditor.soldatDir = txtDir.Text - ElseIf Len(Dir(txtDir.Text, vbDirectory)) = 0 Then - MsgBox "Soldat directory does not exist." - Exit Function - End If - - If right(txtUncomp.Text, 1) <> "\" Then txtUncomp.Text = txtUncomp.Text + "\" - - If Len(Dir(txtUncomp.Text, vbDirectory)) <> 0 Then - frmSoldatMapEditor.uncompDir = txtUncomp.Text - Else - MsgBox "Uncompiled Maps directory does not exist." - Exit Function - End If - - If right(txtPrefabs.Text, 1) <> "\" Then txtPrefabs.Text = txtPrefabs.Text + "\" - - If Len(Dir(txtPrefabs.Text, vbDirectory)) <> 0 Then - frmSoldatMapEditor.prefabDir = txtPrefabs.Text - Else - MsgBox "Prefabs Maps directory does not exist." - Exit Function - End If - - frmSoldatMapEditor.wireBlendSrc = blendModes(cboWireSrc.ListIndex) - frmSoldatMapEditor.wireBlendDest = blendModes(cboWireDest.ListIndex) - frmSoldatMapEditor.polyBlendSrc = blendModes(cboPolySrc.ListIndex) - frmSoldatMapEditor.polyBlendDest = blendModes(cboPolyDest.ListIndex) - - frmSoldatMapEditor.backClr = RGB(backClr.blue, backClr.green, backClr.red) - frmSoldatMapEditor.pointClr = RGB(pointClr.blue, pointClr.green, pointClr.red) - frmSoldatMapEditor.selectionClr = RGB(selClr.blue, selClr.green, selClr.red) - frmSoldatMapEditor.gridClr = RGB(gridClr.blue, gridClr.green, gridClr.red) - frmSoldatMapEditor.gridClr2 = RGB(gridClr2.blue, gridClr2.green, gridClr2.red) - - frmSoldatMapEditor.formWidth = formWidth - frmSoldatMapEditor.formHeight = formHeight - If frmSoldatMapEditor.WindowState = vbNormal Then - frmSoldatMapEditor.Width = formWidth * Screen.TwipsPerPixelX - frmSoldatMapEditor.Height = formHeight * Screen.TwipsPerPixelY - ElseIf frmSoldatMapEditor.WindowState = vbMaximized Then - frmSoldatMapEditor.WindowState = vbNormal - frmSoldatMapEditor.Width = formWidth * Screen.TwipsPerPixelX - frmSoldatMapEditor.Height = formHeight * Screen.TwipsPerPixelY - frmSoldatMapEditor.WindowState = vbMaximized - End If - - frmSoldatMapEditor.gridSpacing = spacing - frmSoldatMapEditor.gridDivisions = divisions - frmSoldatMapEditor.gridOp1 = opacity1 / 100 * 255 - frmSoldatMapEditor.gridOp2 = opacity2 / 100 * 255 - - frmSoldatMapEditor.sceneryVerts = sceneryVerts - frmSoldatMapEditor.topmost = topmost - - For i = 0 To 13 - frmTools.setHotKey i, MapVirtualKey(CInt(txtHotkey(i).Tag), 0) - frmTools.picTools(i).ToolTipText = frmTools.picTools(i).Tag & " (" & (txtHotkey(i).Text) & ")" - Next - - For i = 0 To 4 - frmWaypoints.setWayptKey i, MapVirtualKey(CInt(txtWayptKey(i).Tag), 0) - frmWaypoints.picType(i).ToolTipText = " (" & (txtWayptKey(i).Text) & ")" - frmWaypoints.lblType(i).ToolTipText = " (" & (txtWayptKey(i).Text) & ")" - Next - - If cboSkin.List(cboSkin.ListIndex) <> gfxDir Then - gfxDir = cboSkin.List(cboSkin.ListIndex) - frmSoldatMapEditor.loadColors - frmSoldatMapEditor.SetColors - frmSoldatMapEditor.initGfx - frmColor.SetColors - frmDisplay.SetColors - frmInfo.SetColors - frmMap.SetColors - frmPalette.SetColors - frmPreferences.SetColors - frmScenery.SetColors - frmSoldatMapEditor.SetColors - frmTexture.SetColors - frmTools.SetColors - frmWaypoints.SetColors - frmDisplay.refreshButtons - End If - - frmSoldatMapEditor.setPreferences - - applyPreferences = True - - Exit Function - -ErrorHandler: - - MsgBox "Error applying preferences" & vbNewLine & Error$ - -End Function - -Private Sub picOK_Click() - - Me.ScaleHeight = 408 - Me.Hide - If applyPreferences Then - Unload Me - frmSoldatMapEditor.RegainFocus - Else - Me.Show - End If - -End Sub - -Private Sub Form_Load() - - Dim i As Integer - - On Error GoTo ErrorHandler - - sceneryVerts = frmSoldatMapEditor.sceneryVerts - topmost = frmSoldatMapEditor.topmost - - Me.SetColors - - blendModes(0) = 1 - blendModes(1) = 2 - blendModes(2) = 3 - blendModes(3) = 4 - blendModes(4) = 9 - blendModes(5) = 10 - blendModes(6) = 5 - blendModes(7) = 6 - - backClr = getRGB(frmSoldatMapEditor.backClr) - pointClr = getRGB(frmSoldatMapEditor.pointClr) - selClr = getRGB(frmSoldatMapEditor.selectionClr) - gridClr = getRGB(frmSoldatMapEditor.gridClr) - gridClr2 = getRGB(frmSoldatMapEditor.gridClr2) - - For i = 0 To 7 - If frmSoldatMapEditor.wireBlendSrc = blendModes(i) Then cboWireSrc.ListIndex = i - If frmSoldatMapEditor.wireBlendDest = blendModes(i) Then cboWireDest.ListIndex = i - If frmSoldatMapEditor.polyBlendSrc = blendModes(i) Then cboPolySrc.ListIndex = i - If frmSoldatMapEditor.polyBlendDest = blendModes(i) Then cboPolyDest.ListIndex = i - Next - - Me.picBackClr.BackColor = RGB(backClr.red, backClr.green, backClr.blue) - Me.picPointClr.BackColor = RGB(pointClr.red, pointClr.green, pointClr.blue) - Me.picSelectionClr.BackColor = RGB(selClr.red, selClr.green, selClr.blue) - Me.picGridClr.BackColor = RGB(gridClr.red, gridClr.green, gridClr.blue) - Me.picGridClr2.BackColor = RGB(gridClr2.red, gridClr2.green, gridClr2.blue) - - txtWidth.Text = frmSoldatMapEditor.formWidth - txtHeight.Text = frmSoldatMapEditor.formHeight - formWidth = txtWidth.Text - formHeight = txtHeight.Text - - txtSpacing.Text = frmSoldatMapEditor.gridSpacing - txtDivisions.Text = frmSoldatMapEditor.gridDivisions - spacing = txtSpacing.Text - divisions = txtDivisions.Text - opacity1 = frmSoldatMapEditor.gridOp1 / 255 * 100 - txtOpacity1.Text = opacity1 - opacity2 = frmSoldatMapEditor.gridOp2 / 255 * 100 - txtOpacity2.Text = opacity2 - - For i = 0 To 13 - txtHotkey(i).Text = Chr$(MapVirtualKey(frmTools.getHotKey(i), 1)) - txtHotkey(i).Tag = Asc(txtHotkey(i).Text) - Next - - For i = 0 To 4 - txtWayptKey(i).Text = Chr$(MapVirtualKey(frmWaypoints.getWayptKey(i), 1)) - txtWayptKey(i).Tag = Asc(txtWayptKey(i).Text) - Next - - Dim file As Variant - - file = Dir$(appPath & "\*.*", vbDirectory) - Do While Len(file) - If FileExists(appPath & "\" & file & "\colors.ini") Then - cboSkin.AddItem file - If file = gfxDir Then cboSkin.ListIndex = cboSkin.ListCount - 1 - End If - file = Dir$ - Loop - - txtDir.Text = frmSoldatMapEditor.soldatDir - txtUncomp.Text = frmSoldatMapEditor.uncompDir - txtPrefabs.Text = frmSoldatMapEditor.prefabDir - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading Preferences form" - -End Sub - -Private Function FileExists(fileName As String) As Boolean - - On Error GoTo ErrorHandler - - FileExists = FileLen(fileName) > 0 - -ErrorHandler: - -End Function - - -Private Sub picPointClr_Click() - - frmColor.InitClr pointClr.red, pointClr.green, pointClr.blue - frmColor.Show 1 - picPointClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) - pointClr.red = frmColor.red - pointClr.green = frmColor.green - pointClr.blue = frmColor.blue - -End Sub - -Private Sub picSelectionClr_Click() - - frmColor.InitClr selClr.red, selClr.green, selClr.blue - frmColor.Show 1 - picSelectionClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) - selClr.red = frmColor.red - selClr.green = frmColor.green - selClr.blue = frmColor.blue - -End Sub - -Private Sub picBackClr_Click() - - frmColor.InitClr backClr.red, backClr.green, backClr.blue - frmColor.Show 1 - picBackClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) - backClr.red = frmColor.red - backClr.green = frmColor.green - backClr.blue = frmColor.blue - -End Sub - -Private Sub picGridClr_Click() - - frmColor.InitClr gridClr.red, gridClr.green, gridClr.blue - frmColor.Show 1 - picGridClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) - gridClr.red = frmColor.red - gridClr.green = frmColor.green - gridClr.blue = frmColor.blue - -End Sub - -Private Sub picGridClr2_Click() - - frmColor.InitClr gridClr2.red, gridClr2.green, gridClr2.blue - frmColor.Show 1 - picGridClr2.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) - gridClr2.red = frmColor.red - gridClr2.green = frmColor.green - gridClr2.blue = frmColor.blue - -End Sub - -Private Sub picFolder_Click() - - Dim folder As String - - folder = SelectFolder(Me) - - If right(folder, 1) <> "\" Then folder = folder & "\" - - If Len(folder) > 1 Then - txtDir.Text = folder - End If - - mouseEvent2 picFolder, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub picUncomp_Click() - - Dim folder As String - - folder = SelectFolder(Me) - - If right(folder, 1) <> "\" Then folder = folder & "\" - - If Len(folder) > 1 Then - txtUncomp.Text = folder - End If - - mouseEvent2 picUncomp, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub picPrefabs_Click() - - Dim folder As String - - folder = SelectFolder(Me) - - If right(folder, 1) <> "\" Then folder = folder & "\" - - If Len(folder) > 1 Then - txtPrefabs.Text = folder - End If - - mouseEvent2 picPrefabs, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub txtHotkey_GotFocus(Index As Integer) - - txtHotkey(Index).SelStart = 0 - txtHotkey(Index).SelLength = Len(txtHotkey(Index).Text) - -End Sub - -Private Sub txtHotkey_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) - - txtHotkey(Index).Tag = KeyCode - -End Sub - -Private Sub txtHotkey_KeyPress(Index As Integer, KeyAscii As Integer) - - txtHotkey(Index).Text = UCase$(Chr$(KeyAscii)) - KeyAscii = 0 - -End Sub - -Private Sub txtWayptKey_GotFocus(Index As Integer) - - txtWayptKey(Index).SelStart = 0 - txtWayptKey(Index).SelLength = Len(txtWayptKey(Index).Text) - -End Sub - -Private Sub txtWayptKey_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) - - txtWayptKey(Index).Tag = KeyCode - -End Sub - -Private Sub txtWayptKey_KeyPress(Index As Integer, KeyAscii As Integer) - - txtWayptKey(Index).Text = UCase$(Chr$(KeyAscii)) - KeyAscii = 0 - -End Sub - -Private Sub txtSpacing_Change() - - If IsNumeric(txtSpacing.Text) = False And txtSpacing.Text <> "" Then - txtSpacing.Text = spacing - End If - -End Sub - -Private Sub txtSpacing_GotFocus() - - txtSpacing.SelStart = 0 - txtSpacing.SelLength = Len(txtSpacing.Text) - -End Sub - -Private Sub txtSpacing_LostFocus() - - If IsNumeric(txtSpacing.Text) = False And txtSpacing.Text <> "" Then - txtSpacing.Text = spacing - ElseIf txtSpacing.Text = "" Then - txtSpacing.Text = spacing - ElseIf txtSpacing.Text >= 10 And txtSpacing.Text <= 100 Then - spacing = Int(txtSpacing.Text) - txtSpacing.Text = spacing - Else - If txtSpacing.Text < 10 Then spacing = 10 - If txtSpacing.Text > 100 Then spacing = 100 - txtSpacing.Text = spacing - End If - -End Sub - -Private Sub txtDivisions_Change() - - If IsNumeric(txtDivisions.Text) = False And txtDivisions.Text <> "" Then - txtDivisions.Text = divisions - End If - -End Sub - -Private Sub txtDivisions_GotFocus() - - txtDivisions.SelStart = 0 - txtDivisions.SelLength = Len(txtDivisions.Text) - -End Sub - -Private Sub txtDivisions_LostFocus() - - If IsNumeric(txtDivisions.Text) = False And txtDivisions.Text <> "" Then - txtDivisions.Text = divisions - ElseIf txtDivisions.Text = "" Then - txtDivisions.Text = divisions - ElseIf txtDivisions.Text >= 1 And txtDivisions.Text <= 10 Then - divisions = Int(txtDivisions.Text) - txtDivisions = divisions - Else - If txtDivisions.Text < 1 Then divisions = 1 - If txtDivisions.Text > Int(spacing / 4) Then divisions = Int(spacing / 4) - txtDivisions.Text = divisions - End If - -End Sub - -Private Sub txtOpacity1_Change() - - If IsNumeric(txtOpacity1.Text) = False And txtOpacity1.Text <> "" Then - txtOpacity1.Text = opacity1 - End If - -End Sub - -Private Sub txtOpacity1_GotFocus() - - txtOpacity1.SelStart = 0 - txtOpacity1.SelLength = Len(txtOpacity1.Text) - -End Sub - -Private Sub txtOpacity1_LostFocus() - - If IsNumeric(txtOpacity1.Text) = False And txtOpacity1.Text <> "" Then - txtOpacity1.Text = opacity1 - ElseIf txtOpacity1.Text = "" Then - txtOpacity1.Text = opacity1 - ElseIf txtOpacity1.Text >= 10 And txtOpacity1.Text <= 100 Then - opacity1 = Int(txtOpacity1.Text) - txtOpacity1.Text = opacity1 - Else - txtOpacity1.Text = opacity1 - End If - -End Sub - -Private Sub txtOpacity2_Change() - - If IsNumeric(txtOpacity2.Text) = False And txtOpacity2.Text <> "" Then - txtOpacity2.Text = opacity2 - End If - -End Sub - -Private Sub txtOpacity2_GotFocus() - - txtOpacity2.SelStart = 0 - txtOpacity2.SelLength = Len(txtOpacity2.Text) - -End Sub - -Private Sub txtOpacity2_LostFocus() - - If IsNumeric(txtOpacity2.Text) = False And txtOpacity2.Text <> "" Then - txtOpacity2.Text = opacity2 - ElseIf txtOpacity2.Text = "" Then - txtOpacity2.Text = opacity2 - ElseIf txtOpacity2.Text >= 10 And txtOpacity2.Text <= 100 Then - opacity2 = Int(txtOpacity2.Text) - txtOpacity2.Text = opacity2 - Else - txtOpacity2.Text = opacity2 - End If - -End Sub - -Private Sub txtWidth_Change() - - If IsNumeric(txtWidth.Text) = False And txtWidth.Text <> "" Then - txtWidth.Text = formWidth - End If - -End Sub - -Private Sub txtWidth_GotFocus() - - txtWidth.SelStart = 0 - txtWidth.SelLength = Len(txtWidth.Text) - -End Sub - -Private Sub txtWidth_LostFocus() - - If IsNumeric(txtWidth.Text) = False And txtWidth.Text <> "" Then - txtWidth.Text = formWidth - ElseIf txtWidth.Text = "" Then - txtWidth.Text = formWidth - ElseIf txtWidth.Text >= 320 And txtWidth.Text <= Screen.Width / Screen.TwipsPerPixelX Then - formWidth = Int(txtWidth.Text) - txtWidth.Text = formWidth - Else - If txtWidth.Text < 320 Then formWidth = 320 - If txtWidth.Text > (Screen.Width / Screen.TwipsPerPixelX) Then formWidth = (Screen.Width / Screen.TwipsPerPixelX) - txtWidth.Text = formWidth - End If - -End Sub - -Private Sub txtHeight_Change() - - If IsNumeric(txtHeight.Text) = False And txtHeight.Text <> "" Then - txtHeight.Text = formHeight - End If - -End Sub - -Private Sub txtHeight_GotFocus() - - txtHeight.SelStart = 0 - txtHeight.SelLength = Len(txtHeight.Text) - -End Sub - -Private Sub txtHeight_LostFocus() - - If IsNumeric(txtHeight.Text) = False And txtHeight.Text <> "" Then - txtHeight.Text = formHeight - ElseIf txtHeight.Text = "" Then - txtHeight.Text = formHeight - ElseIf txtHeight.Text >= 320 And txtHeight.Text <= Screen.Height / Screen.TwipsPerPixelY Then - formHeight = Int(txtHeight.Text) - txtHeight.Text = formHeight - Else - If txtHeight.Text < 320 Then formHeight = 320 - If txtHeight.Text > (Screen.Height / Screen.TwipsPerPixelY) Then formHeight = (Screen.Height / Screen.TwipsPerPixelY) - txtHeight.Text = formHeight - End If - -End Sub - -Private Function getRGB(DecValue As Long) As TColor - - Dim hexValue As String - - hexValue = Hex(Val(DecValue)) - - If Len(hexValue) < 6 Then - hexValue = String(6 - Len(hexValue), "0") + hexValue - End If - - getRGB.red = CLng("&H" + mid(hexValue, 1, 2)) - getRGB.green = CLng("&H" + mid(hexValue, 3, 2)) - getRGB.blue = CLng("&H" + mid(hexValue, 5, 2)) - -End Function - -Private Sub picSekrit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picSekrit, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN - -End Sub - -Private Sub picSekrit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picSekrit, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE - -End Sub - -Private Sub picCancel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN - -End Sub - -Private Sub picCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE - -End Sub - -Private Sub picOK_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN - -End Sub - -Private Sub picOK_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE - -End Sub - -Private Sub picApply_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picApply, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN - -End Sub - -Private Sub picApply_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picApply, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub picfolder_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picFolder, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picfolder_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picFolder, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picUncomp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picUncomp, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picUncomp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picUncomp, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picPrefabs_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picPrefabs, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picPrefabs_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picPrefabs, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picScenery_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picScenery, X, Y, BUTTON_SMALL, sceneryVerts, BUTTON_DOWN - -End Sub - -Private Sub picScenery_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picScenery, X, Y, BUTTON_SMALL, sceneryVerts, BUTTON_MOVE - -End Sub - -Private Sub picScenery_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - sceneryVerts = Not sceneryVerts - mouseEvent2 picScenery, X, Y, BUTTON_SMALL, sceneryVerts, BUTTON_UP - -End Sub - -Private Sub picTopmost_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picTopmost, X, Y, BUTTON_SMALL, topmost, BUTTON_DOWN - -End Sub - -Private Sub picTopmost_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picTopmost, X, Y, BUTTON_SMALL, topmost, BUTTON_MOVE - -End Sub - -Private Sub picTopmost_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - topmost = Not topmost - mouseEvent2 picTopmost, X, Y, BUTTON_SMALL, topmost, BUTTON_UP - -End Sub - -Public Sub SetColors() - - On Error Resume Next - - Dim i As Integer - Dim c As Control - - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_preferences.bmp") - picHotkeys.Picture = LoadPicture(appPath & "\" & gfxDir & "\tools.bmp") - - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picOK, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - mouseEvent2 picCancel, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - mouseEvent2 picSekrit, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - mouseEvent2 picApply, 0, 0, BUTTON_LARGE, 0, BUTTON_UP - mouseEvent2 picFolder, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picUncomp, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picPrefabs, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picScenery, 0, 0, BUTTON_SMALL, sceneryVerts, BUTTON_UP - mouseEvent2 picTopmost, 0, 0, BUTTON_SMALL, topmost, BUTTON_UP - - - Me.BackColor = bgClr - - For i = 0 To 22 - lblPref(i).BackColor = lblBackClr - lblPref(i).ForeColor = lblTextClr - Next - - lblDisplay.BackColor = bgClr - lblDisplay.ForeColor = lblTextClr - lblHotkeys.BackColor = bgClr - lblHotkeys.ForeColor = lblTextClr - lblDirs.BackColor = bgClr - lblDirs.ForeColor = lblTextClr - lblWayKeys.BackColor = bgClr - lblWayKeys.ForeColor = lblTextClr - lblBlending.BackColor = bgClr - lblBlending.ForeColor = lblTextClr - - For i = 0 To 13 - txtHotkey(i).BackColor = bgClr - txtHotkey(i).ForeColor = lblTextClr - Next - - For i = 0 To 4 - txtWayptKey(i).BackColor = bgClr - txtWayptKey(i).ForeColor = lblTextClr - fraPref(i).BorderColor = frameClr - Next - - txtWidth.BackColor = txtBackClr - txtWidth.ForeColor = txtTextClr - txtHeight.BackColor = txtBackClr - txtHeight.ForeColor = txtTextClr - txtSpacing.BackColor = txtBackClr - txtSpacing.ForeColor = txtTextClr - txtDivisions.BackColor = txtBackClr - txtDivisions.ForeColor = txtTextClr - txtOpacity1.BackColor = txtBackClr - txtOpacity1.ForeColor = txtTextClr - txtOpacity2.BackColor = txtBackClr - txtOpacity2.ForeColor = txtTextClr - txtDir.BackColor = txtBackClr - txtDir.ForeColor = txtTextClr - txtUncomp.BackColor = txtBackClr - txtUncomp.ForeColor = txtTextClr - txtPrefabs.BackColor = txtBackClr - txtPrefabs.ForeColor = txtTextClr - - cboWireSrc.BackColor = txtBackClr - cboWireSrc.ForeColor = txtTextClr - cboWireDest.BackColor = txtBackClr - cboWireDest.ForeColor = txtTextClr - cboPolySrc.BackColor = txtBackClr - cboPolySrc.ForeColor = txtTextClr - cboPolyDest.BackColor = txtBackClr - cboPolyDest.ForeColor = txtTextClr - - cboSkin.BackColor = txtBackClr - cboSkin.ForeColor = txtTextClr - - For Each c In Me.Controls - If c.Tag = "font1" Then - c.Font.Name = font1 - ElseIf c.Tag = "font2" Then - c.Font.Name = font2 - End If - Next - -End Sub +VERSION 5.00 +Begin VB.Form frmPreferences + BackColor = &H004A3C31& + BorderStyle = 1 'Fixed Single + ClientHeight = 6600 + ClientLeft = 15 + ClientTop = 15 + ClientWidth = 6840 + ControlBox = 0 'False + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 440 + ScaleMode = 3 'Pixel + ScaleWidth = 456 + ShowInTaskbar = 0 'False + StartUpPosition = 1 'CenterOwner + Begin VB.PictureBox picTopmost + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 4800 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 78 + TabStop = 0 'False + Tag = "4" + Top = 7440 + Visible = 0 'False + Width = 240 + End + Begin VB.PictureBox picScenery + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 4800 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 77 + TabStop = 0 'False + Tag = "4" + Top = 6960 + Width = 240 + End + Begin VB.ComboBox cboSkin + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 1320 + Style = 2 'Dropdown List + TabIndex = 6 + Tag = "font1" + Top = 3600 + Width = 2535 + End + Begin VB.TextBox txtHotkey + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 13 + Left = 6240 + TabIndex = 23 + Tag = "font1" + Top = 3720 + Width = 255 + End + Begin VB.TextBox txtHotkey + Alignment = 1 'Right Justify + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 12 + Left = 4800 + TabIndex = 22 + Tag = "font1" + Top = 3720 + Width = 255 + End + Begin VB.PictureBox picSekrit + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 360 + Left = 120 + ScaleHeight = 24 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 74 + TabStop = 0 'False + Tag = "3" + Top = 6120 + Width = 960 + End + Begin VB.TextBox txtWayptKey + Alignment = 2 'Center + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 4 + Left = 6120 + TabIndex = 28 + Tag = "font1" + Text = "X" + ToolTipText = "Fly" + Top = 5520 + Width = 255 + End + Begin VB.TextBox txtWayptKey + Alignment = 2 'Center + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 3 + Left = 5400 + TabIndex = 27 + Tag = "font1" + Text = "Z" + ToolTipText = "Down" + Top = 5520 + Width = 255 + End + Begin VB.TextBox txtWayptKey + Alignment = 2 'Center + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 2 + Left = 5400 + TabIndex = 24 + Tag = "font1" + Text = "W" + ToolTipText = "Up" + Top = 4800 + Width = 255 + End + Begin VB.TextBox txtWayptKey + Alignment = 2 'Center + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 1 + Left = 5760 + TabIndex = 26 + Tag = "font1" + Text = "S" + ToolTipText = "Right" + Top = 5160 + Width = 255 + End + Begin VB.TextBox txtWayptKey + Alignment = 2 'Center + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 0 + Left = 5040 + TabIndex = 25 + Tag = "font1" + Text = "A" + ToolTipText = "Left" + Top = 5160 + Width = 255 + End + Begin VB.PictureBox picPrefabs + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 3960 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 71 + TabStop = 0 'False + Tag = "10" + Top = 5520 + Width = 240 + End + Begin VB.TextBox txtPrefabs + Appearance = 0 'Flat + BackColor = &H00FFFFFF& + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00000000& + Height = 285 + Left = 360 + TabIndex = 9 + Tag = "font1" + Top = 5520 + Width = 3495 + End + Begin VB.TextBox txtUncomp + Appearance = 0 'Flat + BackColor = &H00FFFFFF& + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00000000& + Height = 285 + Left = 360 + TabIndex = 8 + Tag = "font1" + Top = 4920 + Width = 3495 + End + Begin VB.PictureBox picUncomp + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 3960 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 68 + TabStop = 0 'False + Tag = "10" + Top = 4920 + Width = 240 + End + Begin VB.TextBox txtHotkey + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 11 + Left = 6240 + TabIndex = 21 + Tag = "font1" + Top = 3240 + Width = 255 + End + Begin VB.TextBox txtHotkey + Alignment = 1 'Right Justify + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 10 + Left = 4800 + TabIndex = 20 + Tag = "font1" + Top = 3240 + Width = 255 + End + Begin VB.TextBox txtHotkey + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 9 + Left = 6240 + TabIndex = 19 + Tag = "font1" + Top = 2760 + Width = 255 + End + Begin VB.TextBox txtHotkey + Alignment = 1 'Right Justify + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 8 + Left = 4800 + TabIndex = 18 + Tag = "font1" + Top = 2760 + Width = 255 + End + Begin VB.TextBox txtHotkey + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 7 + Left = 6240 + TabIndex = 17 + Tag = "font1" + Top = 2280 + Width = 255 + End + Begin VB.TextBox txtHotkey + Alignment = 1 'Right Justify + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 6 + Left = 4800 + TabIndex = 16 + Tag = "font1" + Top = 2280 + Width = 255 + End + Begin VB.TextBox txtHotkey + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 5 + Left = 6240 + TabIndex = 15 + Tag = "font1" + Top = 1800 + Width = 255 + End + Begin VB.TextBox txtHotkey + Alignment = 1 'Right Justify + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 4 + Left = 4800 + TabIndex = 14 + Tag = "font1" + Top = 1800 + Width = 255 + End + Begin VB.TextBox txtHotkey + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 3 + Left = 6240 + TabIndex = 13 + Tag = "font1" + Top = 1320 + Width = 255 + End + Begin VB.TextBox txtHotkey + Alignment = 1 'Right Justify + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 2 + Left = 4800 + TabIndex = 12 + Tag = "font1" + Top = 1320 + Width = 255 + End + Begin VB.TextBox txtHotkey + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 1 + Left = 6240 + TabIndex = 11 + Tag = "font1" + Top = 840 + Width = 255 + End + Begin VB.TextBox txtHotkey + Alignment = 1 'Right Justify + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 285 + Index = 0 + Left = 4800 + TabIndex = 10 + Tag = "font1" + Top = 840 + Width = 255 + End + Begin VB.PictureBox picHotkeys + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 3360 + Left = 5160 + ScaleHeight = 224 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 67 + TabStop = 0 'False + Top = 720 + Width = 960 + End + Begin VB.TextBox txtOpacity2 + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 2880 + TabIndex = 5 + Tag = "font1" + Top = 2640 + Width = 495 + End + Begin VB.TextBox txtOpacity1 + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 2880 + TabIndex = 4 + Tag = "font1" + Top = 2280 + Width = 495 + End + Begin VB.PictureBox picGridClr2 + Appearance = 0 'Flat + BackColor = &H00000000& + ForeColor = &H80000008& + Height = 255 + Left = 3960 + ScaleHeight = 225 + ScaleWidth = 225 + TabIndex = 60 + TabStop = 0 'False + Top = 2640 + Width = 255 + End + Begin VB.PictureBox picFolder + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 3960 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 33 + TabStop = 0 'False + Tag = "10" + Top = 4320 + Width = 240 + End + Begin VB.TextBox txtHeight + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 1560 + TabIndex = 1 + Tag = "font1" + Top = 1320 + Width = 615 + End + Begin VB.TextBox txtWidth + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 1560 + TabIndex = 0 + Tag = "font1" + Top = 960 + Width = 615 + End + Begin VB.TextBox txtDir + Appearance = 0 'Flat + BackColor = &H00FFFFFF& + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00000000& + Height = 285 + Left = 360 + TabIndex = 7 + Tag = "font1" + Top = 4320 + Width = 3495 + End + Begin VB.TextBox txtDivisions + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 1560 + TabIndex = 3 + Tag = "font1" + Top = 2640 + Width = 495 + End + Begin VB.TextBox txtSpacing + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 1560 + TabIndex = 2 + Tag = "font1" + Top = 2280 + Width = 495 + End + Begin VB.PictureBox picGridClr + Appearance = 0 'Flat + BackColor = &H00000000& + ForeColor = &H80000008& + Height = 255 + Left = 3960 + ScaleHeight = 225 + ScaleWidth = 225 + TabIndex = 53 + TabStop = 0 'False + Top = 2280 + Width = 255 + End + Begin VB.PictureBox picApply + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 360 + Left = 5760 + ScaleHeight = 24 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 49 + TabStop = 0 'False + Tag = "2" + Top = 6120 + Width = 960 + End + Begin VB.PictureBox picOK + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 360 + Left = 3600 + ScaleHeight = 24 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 48 + TabStop = 0 'False + Tag = "0" + Top = 6120 + Width = 960 + End + Begin VB.PictureBox picCancel + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 360 + Left = 4680 + ScaleHeight = 24 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 47 + TabStop = 0 'False + Tag = "1" + Top = 6120 + Width = 960 + End + Begin VB.PictureBox picBackClr + Appearance = 0 'Flat + BackColor = &H00000000& + ForeColor = &H80000008& + Height = 255 + Left = 3960 + ScaleHeight = 225 + ScaleWidth = 225 + TabIndex = 38 + TabStop = 0 'False + Top = 1680 + Width = 255 + End + Begin VB.PictureBox picPointClr + Appearance = 0 'Flat + BackColor = &H00000000& + ForeColor = &H80000008& + Height = 255 + Left = 3960 + ScaleHeight = 225 + ScaleWidth = 225 + TabIndex = 37 + TabStop = 0 'False + Top = 960 + Width = 255 + End + Begin VB.PictureBox picSelectionClr + Appearance = 0 'Flat + BackColor = &H00000000& + ForeColor = &H80000008& + Height = 255 + Left = 3960 + ScaleHeight = 225 + ScaleWidth = 225 + TabIndex = 36 + TabStop = 0 'False + Top = 1320 + Width = 255 + End + Begin VB.ComboBox cboWireSrc + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 315 + ItemData = "frmPreferences.frx":0000 + Left = 1200 + List = "frmPreferences.frx":001C + Style = 2 'Dropdown List + TabIndex = 29 + TabStop = 0 'False + Top = 7080 + Width = 1455 + End + Begin VB.ComboBox cboWireDest + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 315 + ItemData = "frmPreferences.frx":0072 + Left = 1200 + List = "frmPreferences.frx":008E + Style = 2 'Dropdown List + TabIndex = 30 + TabStop = 0 'False + Top = 7440 + Width = 1455 + End + Begin VB.ComboBox cboPolyDest + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 315 + ItemData = "frmPreferences.frx":00E4 + Left = 2760 + List = "frmPreferences.frx":0100 + Style = 2 'Dropdown List + TabIndex = 32 + TabStop = 0 'False + Top = 7440 + Width = 1455 + End + Begin VB.ComboBox cboPolySrc + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 315 + ItemData = "frmPreferences.frx":0156 + Left = 2760 + List = "frmPreferences.frx":0172 + Style = 2 'Dropdown List + TabIndex = 31 + TabStop = 0 'False + Top = 7080 + Width = 1455 + End + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 255 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 456 + TabIndex = 34 + TabStop = 0 'False + Top = 0 + Width = 6840 + Begin VB.PictureBox picHide + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 6600 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 35 + TabStop = 0 'False + Tag = "3" + Top = 0 + Width = 240 + End + End + Begin VB.Label lblPref + BackStyle = 0 'Transparent + Caption = "Fullscreen always on top" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 375 + Index = 24 + Left = 5040 + TabIndex = 80 + Tag = "font2" + Top = 7440 + Visible = 0 'False + Width = 1575 + End + Begin VB.Label lblPref + BackStyle = 0 'Transparent + Caption = "Use 4 verts for scenery" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 375 + Index = 23 + Left = 5040 + TabIndex = 79 + Tag = "font2" + Top = 6960 + Width = 1575 + End + Begin VB.Label lblOther + BackColor = &H004A3C31& + Caption = "Other" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 4800 + TabIndex = 76 + Top = 6600 + Width = 735 + End + Begin VB.Shape fraPref + BorderColor = &H000B3C0D& + Height = 1215 + Index = 5 + Left = 4560 + Top = 6720 + Width = 2175 + End + Begin VB.Label lblPref + BackColor = &H004A3C31& + BackStyle = 0 'Transparent + Caption = "Skin" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 22 + Left = 360 + TabIndex = 75 + Tag = "font2" + Top = 3600 + Width = 975 + End + Begin VB.Label lblWayKeys + Alignment = 2 'Center + BackColor = &H004A3C31& + Caption = "Waypoint Keys" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 4800 + TabIndex = 73 + Tag = "font2" + Top = 4440 + Width = 1575 + End + Begin VB.Shape fraPref + BorderColor = &H000B3C0D& + Height = 1455 + Index = 3 + Left = 4560 + Top = 4560 + Width = 2175 + End + Begin VB.Label lblPref + BackColor = &H004A3C31& + BackStyle = 0 'Transparent + Caption = "Prefabs" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 17 + Left = 360 + TabIndex = 72 + Tag = "font2" + Top = 5280 + Width = 1335 + End + Begin VB.Label lblPref + BackColor = &H004A3C31& + BackStyle = 0 'Transparent + Caption = "Uncompiled" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 16 + Left = 360 + TabIndex = 70 + Tag = "font2" + Top = 4680 + Width = 1335 + End + Begin VB.Label lblPref + BackColor = &H004A3C31& + BackStyle = 0 'Transparent + Caption = "Soldat" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 10 + Left = 360 + TabIndex = 69 + Tag = "font2" + Top = 4080 + Width = 975 + End + Begin VB.Label lblHotkeys + Alignment = 2 'Center + BackColor = &H004F3D31& + Caption = "HotKeys" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 4800 + TabIndex = 66 + Tag = "font2" + Top = 360 + Width = 975 + End + Begin VB.Shape fraPref + BorderColor = &H000B3C0D& + Height = 3855 + Index = 1 + Left = 4560 + Top = 480 + Width = 2175 + End + Begin VB.Label lblPref + BackStyle = 0 'Transparent + Caption = "px" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 12 + Left = 2280 + TabIndex = 65 + Tag = "font2" + Top = 1320 + Width = 375 + End + Begin VB.Label lblPref + BackStyle = 0 'Transparent + Caption = "px" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 11 + Left = 2280 + TabIndex = 64 + Tag = "font2" + Top = 960 + Width = 375 + End + Begin VB.Label lblPref + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 15 + Left = 3360 + TabIndex = 63 + Tag = "font2" + Top = 2640 + Width = 255 + End + Begin VB.Label lblPref + BackStyle = 0 'Transparent + Caption = "%" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 14 + Left = 3360 + TabIndex = 62 + Tag = "font2" + Top = 2280 + Width = 255 + End + Begin VB.Label lblPref + Alignment = 2 'Center + BackColor = &H004A3C31& + BackStyle = 0 'Transparent + Caption = "Colors" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 8 + Left = 3000 + TabIndex = 61 + Tag = "font2" + Top = 720 + Width = 855 + End + Begin VB.Label lblPref + BackColor = &H004A3C31& + BackStyle = 0 'Transparent + Caption = "Window" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 7 + Left = 360 + TabIndex = 59 + Tag = "font2" + Top = 720 + Width = 855 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + Caption = "Height:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 360 + TabIndex = 58 + Tag = "font2" + Top = 1320 + Width = 1095 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + Caption = "Width:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 360 + TabIndex = 57 + Tag = "font2" + Top = 960 + Width = 1095 + End + Begin VB.Label lblPref + BackStyle = 0 'Transparent + Caption = "px" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 13 + Left = 2160 + TabIndex = 56 + Tag = "font2" + Top = 2280 + Width = 375 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + Caption = "Divisions:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 6 + Left = 360 + TabIndex = 55 + Tag = "font2" + Top = 2640 + Width = 1095 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + Caption = "Spacing:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 5 + Left = 360 + TabIndex = 54 + Tag = "font2" + Top = 2280 + Width = 1095 + End + Begin VB.Label lblPref + BackColor = &H004F3D31& + BackStyle = 0 'Transparent + Caption = "Grid" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 9 + Left = 360 + TabIndex = 52 + Tag = "font2" + Top = 2040 + Width = 615 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = "Wireframe" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 18 + Left = 1200 + TabIndex = 51 + Top = 6840 + Width = 1455 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + BackStyle = 0 'Transparent + Caption = "Polygon" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 19 + Left = 2880 + TabIndex = 50 + Top = 6840 + Width = 1455 + End + Begin VB.Label lblDirs + Alignment = 2 'Center + BackColor = &H004A3C31& + Caption = "Directories" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 360 + TabIndex = 46 + Tag = "font2" + Top = 3240 + Width = 1335 + End + Begin VB.Shape fraPref + BorderColor = &H000B3C0D& + Height = 2655 + Index = 2 + Left = 120 + Top = 3360 + Width = 4335 + End + Begin VB.Label lblDisplay + Alignment = 2 'Center + BackColor = &H004F3D31& + Caption = "Display" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 360 + TabIndex = 45 + Tag = "font2" + Top = 360 + Width = 855 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + Caption = "Pattern:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 3 + Left = 2880 + TabIndex = 44 + Tag = "font2" + Top = 1320 + Width = 975 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + Caption = "SRC:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 20 + Left = 360 + TabIndex = 43 + Top = 7080 + Width = 735 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + Caption = "DEST:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 21 + Left = 360 + TabIndex = 42 + Top = 7440 + Width = 735 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + Caption = "Back:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 4 + Left = 2880 + TabIndex = 41 + Tag = "font2" + Top = 1680 + Width = 975 + End + Begin VB.Label lblPref + BackColor = &H00614B3D& + Caption = "Point:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 2880 + TabIndex = 40 + Tag = "font2" + Top = 960 + Width = 975 + End + Begin VB.Label lblBlending + BackColor = &H004A3C31& + Caption = "Blending" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 360 + TabIndex = 39 + Top = 6600 + Width = 975 + End + Begin VB.Shape fraPref + BorderColor = &H000B3C0D& + Height = 2655 + Index = 0 + Left = 120 + Top = 480 + Width = 4335 + End + Begin VB.Shape fraPref + BorderColor = &H000B3C0D& + Height = 1215 + Index = 4 + Left = 120 + Top = 6720 + Width = 4335 + End +End +Attribute VB_Name = "frmPreferences" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Private Type TColor + red As Byte + green As Byte + blue As Byte +End Type + +Dim blendModes(0 To 7) As Integer + +Dim backClr As TColor +Dim pointClr As TColor +Dim selClr As TColor +Dim gridClr As TColor +Dim gridClr2 As TColor + +Dim spacing As Integer, divisions As Integer +Dim formWidth As Integer, formHeight As Integer +Dim opacity1 As Integer, opacity2 As Integer +Dim sceneryVerts As Boolean, topmost As Boolean + +Private Sub picHide_Click() + + Me.ScaleHeight = 408 + Unload Me + frmSoldatMapEditor.RegainFocus + +End Sub + +Private Sub picSekrit_Click() + + If Me.ScaleHeight < 460 Then + Me.Height = 544 * Screen.TwipsPerPixelY + Else + Me.Height = 440 * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + +End Sub + +Private Sub picApply_Click() + + applyPreferences + +End Sub + +Private Sub picCancel_Click() + + Me.ScaleHeight = 408 + Unload Me + frmSoldatMapEditor.RegainFocus + +End Sub + +Private Function applyPreferences() As Boolean + + Dim i As Integer + + On Error GoTo ErrorHandler + + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picOK, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + mouseEvent2 picCancel, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + mouseEvent2 picSekrit, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + mouseEvent2 picApply, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + mouseEvent2 picFolder, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + + If right(txtDir.Text, 1) <> "\" Then txtDir.Text = txtDir.Text + "\" + + If Len(Dir(txtDir.Text, vbDirectory)) <> 0 And frmSoldatMapEditor.soldatDir <> txtDir.Text Then + If Not Len(Dir(txtDir.Text & "Maps\", vbDirectory)) <> 0 Then + MsgBox "'Maps' folder does not exist in Soldat directory." + Exit Function + End If + If Not Len(Dir(txtDir.Text & "Textures\", vbDirectory)) <> 0 Then + MsgBox "'Textures' folder does not exist in Soldat directory." + Exit Function + End If + If Not Len(Dir(txtDir.Text & "Scenery-gfx\", vbDirectory)) <> 0 Then + MsgBox "'Scenery-gfx' folder does not exist in Soldat directory." + Exit Function + End If + + frmSoldatMapEditor.soldatDir = txtDir.Text + ElseIf Len(Dir(txtDir.Text, vbDirectory)) = 0 Then + MsgBox "Soldat directory does not exist." + Exit Function + End If + + If right(txtUncomp.Text, 1) <> "\" Then txtUncomp.Text = txtUncomp.Text + "\" + + If Len(Dir(txtUncomp.Text, vbDirectory)) <> 0 Then + frmSoldatMapEditor.uncompDir = txtUncomp.Text + Else + MsgBox "Uncompiled Maps directory does not exist." + Exit Function + End If + + If right(txtPrefabs.Text, 1) <> "\" Then txtPrefabs.Text = txtPrefabs.Text + "\" + + If Len(Dir(txtPrefabs.Text, vbDirectory)) <> 0 Then + frmSoldatMapEditor.prefabDir = txtPrefabs.Text + Else + MsgBox "Prefabs Maps directory does not exist." + Exit Function + End If + + frmSoldatMapEditor.wireBlendSrc = blendModes(cboWireSrc.ListIndex) + frmSoldatMapEditor.wireBlendDest = blendModes(cboWireDest.ListIndex) + frmSoldatMapEditor.polyBlendSrc = blendModes(cboPolySrc.ListIndex) + frmSoldatMapEditor.polyBlendDest = blendModes(cboPolyDest.ListIndex) + + frmSoldatMapEditor.backClr = RGB(backClr.blue, backClr.green, backClr.red) + frmSoldatMapEditor.pointClr = RGB(pointClr.blue, pointClr.green, pointClr.red) + frmSoldatMapEditor.selectionClr = RGB(selClr.blue, selClr.green, selClr.red) + frmSoldatMapEditor.gridClr = RGB(gridClr.blue, gridClr.green, gridClr.red) + frmSoldatMapEditor.gridClr2 = RGB(gridClr2.blue, gridClr2.green, gridClr2.red) + + frmSoldatMapEditor.formWidth = formWidth + frmSoldatMapEditor.formHeight = formHeight + If frmSoldatMapEditor.WindowState = vbNormal Then + frmSoldatMapEditor.Width = formWidth * Screen.TwipsPerPixelX + frmSoldatMapEditor.Height = formHeight * Screen.TwipsPerPixelY + ElseIf frmSoldatMapEditor.WindowState = vbMaximized Then + frmSoldatMapEditor.WindowState = vbNormal + frmSoldatMapEditor.Width = formWidth * Screen.TwipsPerPixelX + frmSoldatMapEditor.Height = formHeight * Screen.TwipsPerPixelY + frmSoldatMapEditor.WindowState = vbMaximized + End If + + frmSoldatMapEditor.gridSpacing = spacing + frmSoldatMapEditor.gridDivisions = divisions + frmSoldatMapEditor.gridOp1 = opacity1 / 100 * 255 + frmSoldatMapEditor.gridOp2 = opacity2 / 100 * 255 + + frmSoldatMapEditor.sceneryVerts = sceneryVerts + frmSoldatMapEditor.topmost = topmost + + For i = 0 To 13 + frmTools.setHotKey i, MapVirtualKey(CInt(txtHotkey(i).Tag), 0) + frmTools.picTools(i).ToolTipText = frmTools.picTools(i).Tag & " (" & (txtHotkey(i).Text) & ")" + Next + + For i = 0 To 4 + frmWaypoints.setWayptKey i, MapVirtualKey(CInt(txtWayptKey(i).Tag), 0) + frmWaypoints.picType(i).ToolTipText = " (" & (txtWayptKey(i).Text) & ")" + frmWaypoints.lblType(i).ToolTipText = " (" & (txtWayptKey(i).Text) & ")" + Next + + If cboSkin.List(cboSkin.ListIndex) <> gfxDir Then + gfxDir = cboSkin.List(cboSkin.ListIndex) + frmSoldatMapEditor.loadColors + frmSoldatMapEditor.SetColors + frmSoldatMapEditor.initGfx + frmColor.SetColors + frmDisplay.SetColors + frmInfo.SetColors + frmMap.SetColors + frmPalette.SetColors + frmPreferences.SetColors + frmScenery.SetColors + frmSoldatMapEditor.SetColors + frmTexture.SetColors + frmTools.SetColors + frmWaypoints.SetColors + frmDisplay.refreshButtons + End If + + frmSoldatMapEditor.setPreferences + + applyPreferences = True + + Exit Function + +ErrorHandler: + + MsgBox "Error applying preferences" & vbNewLine & Error$ + +End Function + +Private Sub picOK_Click() + + Me.ScaleHeight = 408 + Me.Hide + If applyPreferences Then + Unload Me + frmSoldatMapEditor.RegainFocus + Else + Me.Show + End If + +End Sub + +Private Sub Form_Load() + + Dim i As Integer + + On Error GoTo ErrorHandler + + sceneryVerts = frmSoldatMapEditor.sceneryVerts + topmost = frmSoldatMapEditor.topmost + + Me.SetColors + + blendModes(0) = 1 + blendModes(1) = 2 + blendModes(2) = 3 + blendModes(3) = 4 + blendModes(4) = 9 + blendModes(5) = 10 + blendModes(6) = 5 + blendModes(7) = 6 + + backClr = getRGB(frmSoldatMapEditor.backClr) + pointClr = getRGB(frmSoldatMapEditor.pointClr) + selClr = getRGB(frmSoldatMapEditor.selectionClr) + gridClr = getRGB(frmSoldatMapEditor.gridClr) + gridClr2 = getRGB(frmSoldatMapEditor.gridClr2) + + For i = 0 To 7 + If frmSoldatMapEditor.wireBlendSrc = blendModes(i) Then cboWireSrc.ListIndex = i + If frmSoldatMapEditor.wireBlendDest = blendModes(i) Then cboWireDest.ListIndex = i + If frmSoldatMapEditor.polyBlendSrc = blendModes(i) Then cboPolySrc.ListIndex = i + If frmSoldatMapEditor.polyBlendDest = blendModes(i) Then cboPolyDest.ListIndex = i + Next + + Me.picBackClr.BackColor = RGB(backClr.red, backClr.green, backClr.blue) + Me.picPointClr.BackColor = RGB(pointClr.red, pointClr.green, pointClr.blue) + Me.picSelectionClr.BackColor = RGB(selClr.red, selClr.green, selClr.blue) + Me.picGridClr.BackColor = RGB(gridClr.red, gridClr.green, gridClr.blue) + Me.picGridClr2.BackColor = RGB(gridClr2.red, gridClr2.green, gridClr2.blue) + + txtWidth.Text = frmSoldatMapEditor.formWidth + txtHeight.Text = frmSoldatMapEditor.formHeight + formWidth = txtWidth.Text + formHeight = txtHeight.Text + + txtSpacing.Text = frmSoldatMapEditor.gridSpacing + txtDivisions.Text = frmSoldatMapEditor.gridDivisions + spacing = txtSpacing.Text + divisions = txtDivisions.Text + opacity1 = frmSoldatMapEditor.gridOp1 / 255 * 100 + txtOpacity1.Text = opacity1 + opacity2 = frmSoldatMapEditor.gridOp2 / 255 * 100 + txtOpacity2.Text = opacity2 + + For i = 0 To 13 + txtHotkey(i).Text = Chr$(MapVirtualKey(frmTools.getHotKey(i), 1)) + txtHotkey(i).Tag = Asc(txtHotkey(i).Text) + Next + + For i = 0 To 4 + txtWayptKey(i).Text = Chr$(MapVirtualKey(frmWaypoints.getWayptKey(i), 1)) + txtWayptKey(i).Tag = Asc(txtWayptKey(i).Text) + Next + + Dim file As Variant + + file = Dir$(appPath & "\*.*", vbDirectory) + Do While Len(file) + If FileExists(appPath & "\" & file & "\colors.ini") Then + cboSkin.AddItem file + If file = gfxDir Then cboSkin.ListIndex = cboSkin.ListCount - 1 + End If + file = Dir$ + Loop + + txtDir.Text = frmSoldatMapEditor.soldatDir + txtUncomp.Text = frmSoldatMapEditor.uncompDir + txtPrefabs.Text = frmSoldatMapEditor.prefabDir + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading Preferences form" + +End Sub + +Private Function FileExists(fileName As String) As Boolean + + On Error GoTo ErrorHandler + + FileExists = FileLen(fileName) > 0 + +ErrorHandler: + +End Function + + +Private Sub picPointClr_Click() + + frmColor.InitClr pointClr.red, pointClr.green, pointClr.blue + frmColor.Show 1 + picPointClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + pointClr.red = frmColor.red + pointClr.green = frmColor.green + pointClr.blue = frmColor.blue + +End Sub + +Private Sub picSelectionClr_Click() + + frmColor.InitClr selClr.red, selClr.green, selClr.blue + frmColor.Show 1 + picSelectionClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + selClr.red = frmColor.red + selClr.green = frmColor.green + selClr.blue = frmColor.blue + +End Sub + +Private Sub picBackClr_Click() + + frmColor.InitClr backClr.red, backClr.green, backClr.blue + frmColor.Show 1 + picBackClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + backClr.red = frmColor.red + backClr.green = frmColor.green + backClr.blue = frmColor.blue + +End Sub + +Private Sub picGridClr_Click() + + frmColor.InitClr gridClr.red, gridClr.green, gridClr.blue + frmColor.Show 1 + picGridClr.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + gridClr.red = frmColor.red + gridClr.green = frmColor.green + gridClr.blue = frmColor.blue + +End Sub + +Private Sub picGridClr2_Click() + + frmColor.InitClr gridClr2.red, gridClr2.green, gridClr2.blue + frmColor.Show 1 + picGridClr2.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + gridClr2.red = frmColor.red + gridClr2.green = frmColor.green + gridClr2.blue = frmColor.blue + +End Sub + +Private Sub picFolder_Click() + + Dim folder As String + + folder = SelectFolder(Me) + + If right(folder, 1) <> "\" Then folder = folder & "\" + + If Len(folder) > 1 Then + txtDir.Text = folder + End If + + mouseEvent2 picFolder, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub picUncomp_Click() + + Dim folder As String + + folder = SelectFolder(Me) + + If right(folder, 1) <> "\" Then folder = folder & "\" + + If Len(folder) > 1 Then + txtUncomp.Text = folder + End If + + mouseEvent2 picUncomp, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub picPrefabs_Click() + + Dim folder As String + + folder = SelectFolder(Me) + + If right(folder, 1) <> "\" Then folder = folder & "\" + + If Len(folder) > 1 Then + txtPrefabs.Text = folder + End If + + mouseEvent2 picPrefabs, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub txtHotkey_GotFocus(Index As Integer) + + txtHotkey(Index).SelStart = 0 + txtHotkey(Index).SelLength = Len(txtHotkey(Index).Text) + +End Sub + +Private Sub txtHotkey_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) + + txtHotkey(Index).Tag = KeyCode + +End Sub + +Private Sub txtHotkey_KeyPress(Index As Integer, KeyAscii As Integer) + + txtHotkey(Index).Text = UCase$(Chr$(KeyAscii)) + KeyAscii = 0 + +End Sub + +Private Sub txtWayptKey_GotFocus(Index As Integer) + + txtWayptKey(Index).SelStart = 0 + txtWayptKey(Index).SelLength = Len(txtWayptKey(Index).Text) + +End Sub + +Private Sub txtWayptKey_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) + + txtWayptKey(Index).Tag = KeyCode + +End Sub + +Private Sub txtWayptKey_KeyPress(Index As Integer, KeyAscii As Integer) + + txtWayptKey(Index).Text = UCase$(Chr$(KeyAscii)) + KeyAscii = 0 + +End Sub + +Private Sub txtSpacing_Change() + + If IsNumeric(txtSpacing.Text) = False And txtSpacing.Text <> "" Then + txtSpacing.Text = spacing + End If + +End Sub + +Private Sub txtSpacing_GotFocus() + + txtSpacing.SelStart = 0 + txtSpacing.SelLength = Len(txtSpacing.Text) + +End Sub + +Private Sub txtSpacing_LostFocus() + + If IsNumeric(txtSpacing.Text) = False And txtSpacing.Text <> "" Then + txtSpacing.Text = spacing + ElseIf txtSpacing.Text = "" Then + txtSpacing.Text = spacing + ElseIf txtSpacing.Text >= 10 And txtSpacing.Text <= 100 Then + spacing = Int(txtSpacing.Text) + txtSpacing.Text = spacing + Else + If txtSpacing.Text < 10 Then spacing = 10 + If txtSpacing.Text > 100 Then spacing = 100 + txtSpacing.Text = spacing + End If + +End Sub + +Private Sub txtDivisions_Change() + + If IsNumeric(txtDivisions.Text) = False And txtDivisions.Text <> "" Then + txtDivisions.Text = divisions + End If + +End Sub + +Private Sub txtDivisions_GotFocus() + + txtDivisions.SelStart = 0 + txtDivisions.SelLength = Len(txtDivisions.Text) + +End Sub + +Private Sub txtDivisions_LostFocus() + + If IsNumeric(txtDivisions.Text) = False And txtDivisions.Text <> "" Then + txtDivisions.Text = divisions + ElseIf txtDivisions.Text = "" Then + txtDivisions.Text = divisions + ElseIf txtDivisions.Text >= 1 And txtDivisions.Text <= 10 Then + divisions = Int(txtDivisions.Text) + txtDivisions = divisions + Else + If txtDivisions.Text < 1 Then divisions = 1 + If txtDivisions.Text > Int(spacing / 4) Then divisions = Int(spacing / 4) + txtDivisions.Text = divisions + End If + +End Sub + +Private Sub txtOpacity1_Change() + + If IsNumeric(txtOpacity1.Text) = False And txtOpacity1.Text <> "" Then + txtOpacity1.Text = opacity1 + End If + +End Sub + +Private Sub txtOpacity1_GotFocus() + + txtOpacity1.SelStart = 0 + txtOpacity1.SelLength = Len(txtOpacity1.Text) + +End Sub + +Private Sub txtOpacity1_LostFocus() + + If IsNumeric(txtOpacity1.Text) = False And txtOpacity1.Text <> "" Then + txtOpacity1.Text = opacity1 + ElseIf txtOpacity1.Text = "" Then + txtOpacity1.Text = opacity1 + ElseIf txtOpacity1.Text >= 10 And txtOpacity1.Text <= 100 Then + opacity1 = Int(txtOpacity1.Text) + txtOpacity1.Text = opacity1 + Else + txtOpacity1.Text = opacity1 + End If + +End Sub + +Private Sub txtOpacity2_Change() + + If IsNumeric(txtOpacity2.Text) = False And txtOpacity2.Text <> "" Then + txtOpacity2.Text = opacity2 + End If + +End Sub + +Private Sub txtOpacity2_GotFocus() + + txtOpacity2.SelStart = 0 + txtOpacity2.SelLength = Len(txtOpacity2.Text) + +End Sub + +Private Sub txtOpacity2_LostFocus() + + If IsNumeric(txtOpacity2.Text) = False And txtOpacity2.Text <> "" Then + txtOpacity2.Text = opacity2 + ElseIf txtOpacity2.Text = "" Then + txtOpacity2.Text = opacity2 + ElseIf txtOpacity2.Text >= 10 And txtOpacity2.Text <= 100 Then + opacity2 = Int(txtOpacity2.Text) + txtOpacity2.Text = opacity2 + Else + txtOpacity2.Text = opacity2 + End If + +End Sub + +Private Sub txtWidth_Change() + + If IsNumeric(txtWidth.Text) = False And txtWidth.Text <> "" Then + txtWidth.Text = formWidth + End If + +End Sub + +Private Sub txtWidth_GotFocus() + + txtWidth.SelStart = 0 + txtWidth.SelLength = Len(txtWidth.Text) + +End Sub + +Private Sub txtWidth_LostFocus() + + If IsNumeric(txtWidth.Text) = False And txtWidth.Text <> "" Then + txtWidth.Text = formWidth + ElseIf txtWidth.Text = "" Then + txtWidth.Text = formWidth + ElseIf txtWidth.Text >= 320 And txtWidth.Text <= Screen.Width / Screen.TwipsPerPixelX Then + formWidth = Int(txtWidth.Text) + txtWidth.Text = formWidth + Else + If txtWidth.Text < 320 Then formWidth = 320 + If txtWidth.Text > (Screen.Width / Screen.TwipsPerPixelX) Then formWidth = (Screen.Width / Screen.TwipsPerPixelX) + txtWidth.Text = formWidth + End If + +End Sub + +Private Sub txtHeight_Change() + + If IsNumeric(txtHeight.Text) = False And txtHeight.Text <> "" Then + txtHeight.Text = formHeight + End If + +End Sub + +Private Sub txtHeight_GotFocus() + + txtHeight.SelStart = 0 + txtHeight.SelLength = Len(txtHeight.Text) + +End Sub + +Private Sub txtHeight_LostFocus() + + If IsNumeric(txtHeight.Text) = False And txtHeight.Text <> "" Then + txtHeight.Text = formHeight + ElseIf txtHeight.Text = "" Then + txtHeight.Text = formHeight + ElseIf txtHeight.Text >= 320 And txtHeight.Text <= Screen.Height / Screen.TwipsPerPixelY Then + formHeight = Int(txtHeight.Text) + txtHeight.Text = formHeight + Else + If txtHeight.Text < 320 Then formHeight = 320 + If txtHeight.Text > (Screen.Height / Screen.TwipsPerPixelY) Then formHeight = (Screen.Height / Screen.TwipsPerPixelY) + txtHeight.Text = formHeight + End If + +End Sub + +Private Function getRGB(DecValue As Long) As TColor + + Dim hexValue As String + + hexValue = Hex(Val(DecValue)) + + If Len(hexValue) < 6 Then + hexValue = String(6 - Len(hexValue), "0") + hexValue + End If + + getRGB.red = CLng("&H" + mid(hexValue, 1, 2)) + getRGB.green = CLng("&H" + mid(hexValue, 3, 2)) + getRGB.blue = CLng("&H" + mid(hexValue, 5, 2)) + +End Function + +Private Sub picSekrit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picSekrit, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN + +End Sub + +Private Sub picSekrit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picSekrit, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE + +End Sub + +Private Sub picCancel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN + +End Sub + +Private Sub picCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picCancel, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE + +End Sub + +Private Sub picOK_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN + +End Sub + +Private Sub picOK_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picOK, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE + +End Sub + +Private Sub picApply_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picApply, X, Y, BUTTON_LARGE, 0, BUTTON_DOWN + +End Sub + +Private Sub picApply_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picApply, X, Y, BUTTON_LARGE, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub picfolder_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picFolder, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picfolder_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picFolder, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picUncomp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picUncomp, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picUncomp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picUncomp, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picPrefabs_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picPrefabs, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picPrefabs_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picPrefabs, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picScenery_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picScenery, X, Y, BUTTON_SMALL, sceneryVerts, BUTTON_DOWN + +End Sub + +Private Sub picScenery_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picScenery, X, Y, BUTTON_SMALL, sceneryVerts, BUTTON_MOVE + +End Sub + +Private Sub picScenery_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + sceneryVerts = Not sceneryVerts + mouseEvent2 picScenery, X, Y, BUTTON_SMALL, sceneryVerts, BUTTON_UP + +End Sub + +Private Sub picTopmost_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picTopmost, X, Y, BUTTON_SMALL, topmost, BUTTON_DOWN + +End Sub + +Private Sub picTopmost_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picTopmost, X, Y, BUTTON_SMALL, topmost, BUTTON_MOVE + +End Sub + +Private Sub picTopmost_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + topmost = Not topmost + mouseEvent2 picTopmost, X, Y, BUTTON_SMALL, topmost, BUTTON_UP + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + Dim i As Integer + Dim c As Control + + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_preferences.bmp") + picHotkeys.Picture = LoadPicture(appPath & "\" & gfxDir & "\tools.bmp") + + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picOK, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + mouseEvent2 picCancel, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + mouseEvent2 picSekrit, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + mouseEvent2 picApply, 0, 0, BUTTON_LARGE, 0, BUTTON_UP + mouseEvent2 picFolder, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picUncomp, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picPrefabs, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picScenery, 0, 0, BUTTON_SMALL, sceneryVerts, BUTTON_UP + mouseEvent2 picTopmost, 0, 0, BUTTON_SMALL, topmost, BUTTON_UP + + + Me.BackColor = bgClr + + For i = 0 To 22 + lblPref(i).BackColor = lblBackClr + lblPref(i).ForeColor = lblTextClr + Next + + lblDisplay.BackColor = bgClr + lblDisplay.ForeColor = lblTextClr + lblHotkeys.BackColor = bgClr + lblHotkeys.ForeColor = lblTextClr + lblDirs.BackColor = bgClr + lblDirs.ForeColor = lblTextClr + lblWayKeys.BackColor = bgClr + lblWayKeys.ForeColor = lblTextClr + lblBlending.BackColor = bgClr + lblBlending.ForeColor = lblTextClr + + For i = 0 To 13 + txtHotkey(i).BackColor = bgClr + txtHotkey(i).ForeColor = lblTextClr + Next + + For i = 0 To 4 + txtWayptKey(i).BackColor = bgClr + txtWayptKey(i).ForeColor = lblTextClr + fraPref(i).BorderColor = frameClr + Next + + txtWidth.BackColor = txtBackClr + txtWidth.ForeColor = txtTextClr + txtHeight.BackColor = txtBackClr + txtHeight.ForeColor = txtTextClr + txtSpacing.BackColor = txtBackClr + txtSpacing.ForeColor = txtTextClr + txtDivisions.BackColor = txtBackClr + txtDivisions.ForeColor = txtTextClr + txtOpacity1.BackColor = txtBackClr + txtOpacity1.ForeColor = txtTextClr + txtOpacity2.BackColor = txtBackClr + txtOpacity2.ForeColor = txtTextClr + txtDir.BackColor = txtBackClr + txtDir.ForeColor = txtTextClr + txtUncomp.BackColor = txtBackClr + txtUncomp.ForeColor = txtTextClr + txtPrefabs.BackColor = txtBackClr + txtPrefabs.ForeColor = txtTextClr + + cboWireSrc.BackColor = txtBackClr + cboWireSrc.ForeColor = txtTextClr + cboWireDest.BackColor = txtBackClr + cboWireDest.ForeColor = txtTextClr + cboPolySrc.BackColor = txtBackClr + cboPolySrc.ForeColor = txtTextClr + cboPolyDest.BackColor = txtBackClr + cboPolyDest.ForeColor = txtTextClr + + cboSkin.BackColor = txtBackClr + cboSkin.ForeColor = txtTextClr + + For Each c In Me.Controls + If c.Tag = "font1" Then + c.Font.Name = font1 + ElseIf c.Tag = "font2" Then + c.Font.Name = font2 + End If + Next + +End Sub diff --git a/frmScenery.frm b/frmScenery.frm index 11d72c3..6cea557 100644 --- a/frmScenery.frm +++ b/frmScenery.frm @@ -1,735 +1,735 @@ -VERSION 5.00 -Begin VB.Form frmScenery - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 1 'Fixed Single - ClientHeight = 2550 - ClientLeft = 120 - ClientTop = 120 - ClientWidth = 3120 - ControlBox = 0 'False - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 170 - ScaleMode = 3 'Pixel - ScaleWidth = 208 - ShowInTaskbar = 0 'False - StartUpPosition = 3 'Windows Default - Begin VB.PictureBox picRotate - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 1320 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 12 - Tag = "4" - Top = 1920 - Width = 240 - End - Begin VB.PictureBox picScale - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 1320 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 11 - Tag = "4" - Top = 2160 - Width = 240 - End - Begin VB.PictureBox picLevel - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 2 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 10 - Tag = "6" - Top = 2160 - Width = 240 - End - Begin VB.PictureBox picLevel - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 1 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 6 - Tag = "6" - Top = 1920 - Width = 240 - End - Begin VB.PictureBox picLevel - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 0 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 5 - Tag = "6" - Top = 1680 - Width = 240 - End - Begin VB.PictureBox picScenery - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 975 - Left = 120 - ScaleHeight = 65 - ScaleMode = 3 'Pixel - ScaleWidth = 65 - TabIndex = 4 - Top = 360 - Width = 975 - End - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 255 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 208 - TabIndex = 1 - TabStop = 0 'False - Top = 0 - Width = 3120 - Begin VB.PictureBox picSceneryMenu - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 2640 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 3 - TabStop = 0 'False - Tag = "8" - Top = 0 - Width = 240 - End - Begin VB.PictureBox picHide - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 2880 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 2 - TabStop = 0 'False - Tag = "3" - Top = 0 - Width = 240 - End - End - Begin VB.ListBox lstScenery - Appearance = 0 'Flat - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 1350 - Left = 1320 - Sorted = -1 'True - TabIndex = 0 - Tag = "font1" - Top = 360 - Width = 1695 - End - Begin VB.Label lblLvl - BackStyle = 0 'Transparent - Caption = "Level:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 120 - TabIndex = 15 - Tag = "font2" - Top = 1440 - Width = 855 - End - Begin VB.Label lblRotate - BackStyle = 0 'Transparent - Caption = "Rotate" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 1680 - TabIndex = 14 - Tag = "font2" - Top = 1920 - Width = 735 - End - Begin VB.Label lblScale - BackStyle = 0 'Transparent - Caption = "Scale" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 1680 - TabIndex = 13 - Tag = "font2" - Top = 2160 - Width = 735 - End - Begin VB.Label lblLevel - BackStyle = 0 'Transparent - Caption = "Front" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 480 - TabIndex = 9 - Tag = "font2" - Top = 2160 - Width = 615 - End - Begin VB.Label lblLevel - BackStyle = 0 'Transparent - Caption = "Middle" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 480 - TabIndex = 8 - Tag = "font2" - Top = 1920 - Width = 735 - End - Begin VB.Label lblLevel - BackStyle = 0 'Transparent - Caption = "Back" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 480 - TabIndex = 7 - Tag = "font2" - Top = 1680 - Width = 735 - End - Begin VB.Image imgScenery - Appearance = 0 'Flat - Height = 975 - Left = 120 - Top = 360 - Width = 975 - End - Begin VB.Menu mnuScenery - Caption = "Scenery" - Visible = 0 'False - Begin VB.Menu mnuClearUnused - Caption = "Clear Unused" - End - Begin VB.Menu mnuReload - Caption = "Reload Scenery List" - End - Begin VB.Menu mnuRefresh - Caption = "Refresh Scenery" - End - End -End -Attribute VB_Name = "frmScenery" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Dim formHeight As Integer -Public collapsed As Boolean -Public xPos As Integer, yPos As Integer -Public level As Byte -Public rotateScenery As Boolean, scaleScenery As Boolean -Public notClicked As Boolean -Dim checkVal As Boolean -Dim selNode As Node - -Private Sub Form_Load() - - Dim i As Integer - - On Error GoTo ErrorHandler - - Me.SetColors - - formHeight = Me.ScaleHeight - - setForm - - listScenery - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading Scenery form" - -End Sub - -Public Sub setForm() - - Me.left = xPos * Screen.TwipsPerPixelX - Me.Top = yPos * Screen.TwipsPerPixelY - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Public Sub listScenery() - - On Error GoTo ErrorHandler - - Dim file As Variant - Dim Index As Integer - Dim i As Integer - Dim sceneryName As String - Dim fileOpen As Boolean - Dim tempNode As Node - - frmSoldatMapEditor.tvwScenery.Nodes.Clear - - frmSoldatMapEditor.tvwScenery.Nodes.Add , , "In Use", "In Use" - - 'load all scenery - frmSoldatMapEditor.tvwScenery.Nodes.Add , , "Master List", "Master List" - - file = Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & "*.bmp", vbDirectory) - Do While Len(file) - frmSoldatMapEditor.tvwScenery.Nodes.Add "Master List", tvwChild, , file - file = Dir$ - Loop - - file = Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & "*.png", vbDirectory) - Do While Len(file) - frmSoldatMapEditor.tvwScenery.Nodes.Add "Master List", tvwChild, , file - file = Dir$ - Loop - - file = Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & "*.tga", vbDirectory) - Do While Len(file) - frmSoldatMapEditor.tvwScenery.Nodes.Add "Master List", tvwChild, , file - file = Dir$ - Loop - - file = Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & "*.gif", vbDirectory) - Do While Len(file) - frmSoldatMapEditor.tvwScenery.Nodes.Add "Master List", tvwChild, , file - file = Dir$ - Loop - - frmSoldatMapEditor.tvwScenery.Nodes("Master List").Sorted = True - frmSoldatMapEditor.tvwScenery.Nodes("Master List").Sorted = False - - frmSoldatMapEditor.tvwScenery.Nodes("Master List").Child.selected = True - frmSoldatMapEditor.tvwScenery_NodeClick frmSoldatMapEditor.tvwScenery.SelectedItem - - 'load lists - - file = Dir$(appPath & "\lists\" & "*.txt", vbDirectory) - Do While Len(file) 'for every txt file in lists - - file = left(file, Len(file) - 4) - frmSoldatMapEditor.tvwScenery.Nodes.Add , , file, file - fileOpen = True - Open appPath & "\lists\" & file & ".txt" For Input As #1 - - Do Until EOF(1) - Input #1, sceneryName - frmSoldatMapEditor.tvwScenery.Nodes.Add file, tvwChild, , sceneryName - Loop - - Close #1 - - fileOpen = False - file = Dir$ - - Loop - - Exit Sub - -ErrorHandler: - - MsgBox "loading scenery tree failed" & vbNewLine & Error$ & vbNewLine & sceneryName - If fileOpen Then Close #1 - -End Sub - -Private Function FileExists(fileName As String) As Boolean - - On Error GoTo ErrorHandler - - FileExists = FileLen(fileName) > 0 - -ErrorHandler: - -End Function - -Private Sub lblLevel_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - picLevel_MouseMove Index, 1, 0, 0, 0 - -End Sub - -Private Sub lblRotate_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - picRotate_MouseMove 1, 0, 0, 0 - -End Sub - -Private Sub lblScale_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - picScale_MouseMove 1, 0, 0, 0 - -End Sub - -Public Sub lstScenery_Click() - - Dim Token As Long - - On Error GoTo ErrorHandler - - If lstScenery.List(lstScenery.ListIndex) = "" Then - lstScenery.ListIndex = -1 - Exit Sub - End If - - If Len(Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & lstScenery.List(lstScenery.ListIndex))) <> 0 Then - Token = InitGDIPlus - picScenery.Picture = LoadPictureGDIPlus(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & lstScenery.List(lstScenery.ListIndex), , , RGB(0, 255, 0)) - FreeGDIPlus Token - frmSoldatMapEditor.setCurrentScenery lstScenery.ListIndex + 1, lstScenery.List(lstScenery.ListIndex) - Else - frmSoldatMapEditor.setCurrentScenery lstScenery.ListIndex + 1, "notfound.bmp" - picScenery.Picture = LoadPicture(appPath & "\" & gfxDir & "\notfound.bmp") - frmSoldatMapEditor.tvwScenery.SelectedItem = Nothing - End If - - lstScenery.ToolTipText = lstScenery.List(lstScenery.ListIndex) - frmSoldatMapEditor.tvwScenery.Nodes(lstScenery.List(lstScenery.ListIndex)).selected = True - - Exit Sub - -ErrorHandler: - - MsgBox "Error clicking scenery" & vbNewLine & Error$ - -End Sub - -Private Sub mnuClearUnused_Click() - - frmSoldatMapEditor.ClearUnused - -End Sub - -Private Sub mnuReload_Click() - - Dim i As Integer - - listScenery - - For i = 0 To lstScenery.ListCount - 1 - frmSoldatMapEditor.tvwScenery.Nodes.Add "In Use", tvwChild, lstScenery.List(i), lstScenery.List(i) - Next - -End Sub - -Private Sub mnuRefresh_Click() - - Dim Index As Integer - - For Index = 1 To lstScenery.ListCount - frmSoldatMapEditor.RefreshSceneryTextures Index - Next - frmSoldatMapEditor.Render - -End Sub - -Private Sub picSceneryMenu_Click() - - PopupMenu mnuScenery, , picHide.left + picHide.ScaleWidth, picSceneryMenu.Top + picSceneryMenu.ScaleHeight - -End Sub - -Private Sub picSceneryMenu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picSceneryMenu, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picSceneryMenu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picSceneryMenu, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picSceneryMenu_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picSceneryMenu, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub picTitle_DblClick() - - collapsed = Not collapsed - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - - snapForm Me, frmPalette - snapForm Me, frmWaypoints - snapForm Me, frmDisplay - snapForm Me, frmTools - snapForm Me, frmInfo - snapForm Me, frmTexture - Me.Tag = snapForm(Me, frmSoldatMapEditor) - - xPos = Me.left / Screen.TwipsPerPixelX - yPos = Me.Top / Screen.TwipsPerPixelY - -End Sub - -Private Sub picHide_Click() - - Me.Hide - frmSoldatMapEditor.mnuScenery.Checked = False - -End Sub - -Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub picRotate_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picRotate, X, Y, BUTTON_SMALL, rotateScenery, BUTTON_DOWN - -End Sub - -Private Sub picRotate_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picRotate, X, Y, BUTTON_SMALL, rotateScenery, BUTTON_MOVE, lblRotate.Width + 16 - -End Sub - -Private Sub picRotate_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - rotateScenery = Not rotateScenery - -End Sub - -Private Sub picScale_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picScale, X, Y, BUTTON_SMALL, scaleScenery, BUTTON_DOWN - -End Sub - -Private Sub picScale_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picScale, X, Y, BUTTON_SMALL, scaleScenery, BUTTON_MOVE, lblScale.Width + 16 - -End Sub - -Private Sub picScale_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - scaleScenery = Not scaleScenery - -End Sub - -Public Sub picLevel_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picLevel(Index), X, Y, BUTTON_SMALL, (Index = level), BUTTON_DOWN - -End Sub - -Private Sub picLevel_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picLevel(Index), X, Y, BUTTON_SMALL, (Index = level), BUTTON_MOVE, lblLevel(Index).Width + 16 - -End Sub - -Private Sub picLevel_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - Dim i As Integer - - level = Index - - For i = 0 To 2 - If i <> Index Then - mouseEvent2 picLevel(i), X, Y, BUTTON_SMALL, (i = level), BUTTON_UP - End If - Next - - frmSoldatMapEditor.setSceneryLevel level - frmSoldatMapEditor.RegainFocus - -End Sub - -Public Sub SetColors() - - On Error Resume Next - - Dim i As Integer - Dim c As Control - - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_scenery.bmp") - - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picSceneryMenu, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - - For i = 0 To 2 - mouseEvent2 picLevel(i), 0, 0, BUTTON_SMALL, (i = level), BUTTON_UP - Next - - mouseEvent2 picScale, 0, 0, BUTTON_SMALL, scaleScenery, BUTTON_UP - mouseEvent2 picRotate, 0, 0, BUTTON_SMALL, rotateScenery, BUTTON_UP - - - Me.BackColor = bgClr - lblLvl.BackColor = lblBackClr - lblLvl.ForeColor = lblTextClr - For i = 0 To 2 - lblLevel(i).BackColor = lblBackClr - lblLevel(i).ForeColor = lblTextClr - Next - lblRotate.BackColor = lblBackClr - lblRotate.ForeColor = lblTextClr - lblScale.BackColor = lblBackClr - lblScale.ForeColor = lblTextClr - lstScenery.BackColor = txtBackClr - lstScenery.ForeColor = txtTextClr - picScenery.BackColor = bgClr - - For Each c In Me.Controls - If c.Tag = "font1" Then - c.Font.Name = font1 - ElseIf c.Tag = "font2" Then - c.Font.Name = font2 - End If - Next - -End Sub +VERSION 5.00 +Begin VB.Form frmScenery + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 1 'Fixed Single + ClientHeight = 2550 + ClientLeft = 120 + ClientTop = 120 + ClientWidth = 3120 + ControlBox = 0 'False + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 170 + ScaleMode = 3 'Pixel + ScaleWidth = 208 + ShowInTaskbar = 0 'False + StartUpPosition = 3 'Windows Default + Begin VB.PictureBox picRotate + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 1320 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 12 + Tag = "4" + Top = 1920 + Width = 240 + End + Begin VB.PictureBox picScale + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 1320 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 11 + Tag = "4" + Top = 2160 + Width = 240 + End + Begin VB.PictureBox picLevel + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 2 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 10 + Tag = "6" + Top = 2160 + Width = 240 + End + Begin VB.PictureBox picLevel + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 1 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 6 + Tag = "6" + Top = 1920 + Width = 240 + End + Begin VB.PictureBox picLevel + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 0 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 5 + Tag = "6" + Top = 1680 + Width = 240 + End + Begin VB.PictureBox picScenery + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 975 + Left = 120 + ScaleHeight = 65 + ScaleMode = 3 'Pixel + ScaleWidth = 65 + TabIndex = 4 + Top = 360 + Width = 975 + End + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 255 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 208 + TabIndex = 1 + TabStop = 0 'False + Top = 0 + Width = 3120 + Begin VB.PictureBox picSceneryMenu + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 2640 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 3 + TabStop = 0 'False + Tag = "8" + Top = 0 + Width = 240 + End + Begin VB.PictureBox picHide + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 2880 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 2 + TabStop = 0 'False + Tag = "3" + Top = 0 + Width = 240 + End + End + Begin VB.ListBox lstScenery + Appearance = 0 'Flat + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 1350 + Left = 1320 + Sorted = -1 'True + TabIndex = 0 + Tag = "font1" + Top = 360 + Width = 1695 + End + Begin VB.Label lblLvl + BackStyle = 0 'Transparent + Caption = "Level:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 120 + TabIndex = 15 + Tag = "font2" + Top = 1440 + Width = 855 + End + Begin VB.Label lblRotate + BackStyle = 0 'Transparent + Caption = "Rotate" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 1680 + TabIndex = 14 + Tag = "font2" + Top = 1920 + Width = 735 + End + Begin VB.Label lblScale + BackStyle = 0 'Transparent + Caption = "Scale" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 1680 + TabIndex = 13 + Tag = "font2" + Top = 2160 + Width = 735 + End + Begin VB.Label lblLevel + BackStyle = 0 'Transparent + Caption = "Front" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 480 + TabIndex = 9 + Tag = "font2" + Top = 2160 + Width = 615 + End + Begin VB.Label lblLevel + BackStyle = 0 'Transparent + Caption = "Middle" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 480 + TabIndex = 8 + Tag = "font2" + Top = 1920 + Width = 735 + End + Begin VB.Label lblLevel + BackStyle = 0 'Transparent + Caption = "Back" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 480 + TabIndex = 7 + Tag = "font2" + Top = 1680 + Width = 735 + End + Begin VB.Image imgScenery + Appearance = 0 'Flat + Height = 975 + Left = 120 + Top = 360 + Width = 975 + End + Begin VB.Menu mnuScenery + Caption = "Scenery" + Visible = 0 'False + Begin VB.Menu mnuClearUnused + Caption = "Clear Unused" + End + Begin VB.Menu mnuReload + Caption = "Reload Scenery List" + End + Begin VB.Menu mnuRefresh + Caption = "Refresh Scenery" + End + End +End +Attribute VB_Name = "frmScenery" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Dim formHeight As Integer +Public collapsed As Boolean +Public xPos As Integer, yPos As Integer +Public level As Byte +Public rotateScenery As Boolean, scaleScenery As Boolean +Public notClicked As Boolean +Dim checkVal As Boolean +Dim selNode As Node + +Private Sub Form_Load() + + Dim i As Integer + + On Error GoTo ErrorHandler + + Me.SetColors + + formHeight = Me.ScaleHeight + + setForm + + listScenery + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading Scenery form" + +End Sub + +Public Sub setForm() + + Me.left = xPos * Screen.TwipsPerPixelX + Me.Top = yPos * Screen.TwipsPerPixelY + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Public Sub listScenery() + + On Error GoTo ErrorHandler + + Dim file As Variant + Dim Index As Integer + Dim i As Integer + Dim sceneryName As String + Dim fileOpen As Boolean + Dim tempNode As Node + + frmSoldatMapEditor.tvwScenery.Nodes.Clear + + frmSoldatMapEditor.tvwScenery.Nodes.Add , , "In Use", "In Use" + + 'load all scenery + frmSoldatMapEditor.tvwScenery.Nodes.Add , , "Master List", "Master List" + + file = Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & "*.bmp", vbDirectory) + Do While Len(file) + frmSoldatMapEditor.tvwScenery.Nodes.Add "Master List", tvwChild, , file + file = Dir$ + Loop + + file = Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & "*.png", vbDirectory) + Do While Len(file) + frmSoldatMapEditor.tvwScenery.Nodes.Add "Master List", tvwChild, , file + file = Dir$ + Loop + + file = Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & "*.tga", vbDirectory) + Do While Len(file) + frmSoldatMapEditor.tvwScenery.Nodes.Add "Master List", tvwChild, , file + file = Dir$ + Loop + + file = Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & "*.gif", vbDirectory) + Do While Len(file) + frmSoldatMapEditor.tvwScenery.Nodes.Add "Master List", tvwChild, , file + file = Dir$ + Loop + + frmSoldatMapEditor.tvwScenery.Nodes("Master List").Sorted = True + frmSoldatMapEditor.tvwScenery.Nodes("Master List").Sorted = False + + frmSoldatMapEditor.tvwScenery.Nodes("Master List").Child.selected = True + frmSoldatMapEditor.tvwScenery_NodeClick frmSoldatMapEditor.tvwScenery.SelectedItem + + 'load lists + + file = Dir$(appPath & "\lists\" & "*.txt", vbDirectory) + Do While Len(file) 'for every txt file in lists + + file = left(file, Len(file) - 4) + frmSoldatMapEditor.tvwScenery.Nodes.Add , , file, file + fileOpen = True + Open appPath & "\lists\" & file & ".txt" For Input As #1 + + Do Until EOF(1) + Input #1, sceneryName + frmSoldatMapEditor.tvwScenery.Nodes.Add file, tvwChild, , sceneryName + Loop + + Close #1 + + fileOpen = False + file = Dir$ + + Loop + + Exit Sub + +ErrorHandler: + + MsgBox "loading scenery tree failed" & vbNewLine & Error$ & vbNewLine & sceneryName + If fileOpen Then Close #1 + +End Sub + +Private Function FileExists(fileName As String) As Boolean + + On Error GoTo ErrorHandler + + FileExists = FileLen(fileName) > 0 + +ErrorHandler: + +End Function + +Private Sub lblLevel_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + picLevel_MouseMove Index, 1, 0, 0, 0 + +End Sub + +Private Sub lblRotate_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + picRotate_MouseMove 1, 0, 0, 0 + +End Sub + +Private Sub lblScale_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + picScale_MouseMove 1, 0, 0, 0 + +End Sub + +Public Sub lstScenery_Click() + + Dim Token As Long + + On Error GoTo ErrorHandler + + If lstScenery.List(lstScenery.ListIndex) = "" Then + lstScenery.ListIndex = -1 + Exit Sub + End If + + If Len(Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & lstScenery.List(lstScenery.ListIndex))) <> 0 Then + Token = InitGDIPlus + picScenery.Picture = LoadPictureGDIPlus(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & lstScenery.List(lstScenery.ListIndex), , , RGB(0, 255, 0)) + FreeGDIPlus Token + frmSoldatMapEditor.setCurrentScenery lstScenery.ListIndex + 1, lstScenery.List(lstScenery.ListIndex) + Else + frmSoldatMapEditor.setCurrentScenery lstScenery.ListIndex + 1, "notfound.bmp" + picScenery.Picture = LoadPicture(appPath & "\" & gfxDir & "\notfound.bmp") + frmSoldatMapEditor.tvwScenery.SelectedItem = Nothing + End If + + lstScenery.ToolTipText = lstScenery.List(lstScenery.ListIndex) + frmSoldatMapEditor.tvwScenery.Nodes(lstScenery.List(lstScenery.ListIndex)).selected = True + + Exit Sub + +ErrorHandler: + + MsgBox "Error clicking scenery" & vbNewLine & Error$ + +End Sub + +Private Sub mnuClearUnused_Click() + + frmSoldatMapEditor.ClearUnused + +End Sub + +Private Sub mnuReload_Click() + + Dim i As Integer + + listScenery + + For i = 0 To lstScenery.ListCount - 1 + frmSoldatMapEditor.tvwScenery.Nodes.Add "In Use", tvwChild, lstScenery.List(i), lstScenery.List(i) + Next + +End Sub + +Private Sub mnuRefresh_Click() + + Dim Index As Integer + + For Index = 1 To lstScenery.ListCount + frmSoldatMapEditor.RefreshSceneryTextures Index + Next + frmSoldatMapEditor.Render + +End Sub + +Private Sub picSceneryMenu_Click() + + PopupMenu mnuScenery, , picHide.left + picHide.ScaleWidth, picSceneryMenu.Top + picSceneryMenu.ScaleHeight + +End Sub + +Private Sub picSceneryMenu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picSceneryMenu, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picSceneryMenu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picSceneryMenu, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picSceneryMenu_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picSceneryMenu, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub picTitle_DblClick() + + collapsed = Not collapsed + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + + snapForm Me, frmPalette + snapForm Me, frmWaypoints + snapForm Me, frmDisplay + snapForm Me, frmTools + snapForm Me, frmInfo + snapForm Me, frmTexture + Me.Tag = snapForm(Me, frmSoldatMapEditor) + + xPos = Me.left / Screen.TwipsPerPixelX + yPos = Me.Top / Screen.TwipsPerPixelY + +End Sub + +Private Sub picHide_Click() + + Me.Hide + frmSoldatMapEditor.mnuScenery.Checked = False + +End Sub + +Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub picRotate_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picRotate, X, Y, BUTTON_SMALL, rotateScenery, BUTTON_DOWN + +End Sub + +Private Sub picRotate_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picRotate, X, Y, BUTTON_SMALL, rotateScenery, BUTTON_MOVE, lblRotate.Width + 16 + +End Sub + +Private Sub picRotate_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + rotateScenery = Not rotateScenery + +End Sub + +Private Sub picScale_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picScale, X, Y, BUTTON_SMALL, scaleScenery, BUTTON_DOWN + +End Sub + +Private Sub picScale_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picScale, X, Y, BUTTON_SMALL, scaleScenery, BUTTON_MOVE, lblScale.Width + 16 + +End Sub + +Private Sub picScale_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + scaleScenery = Not scaleScenery + +End Sub + +Public Sub picLevel_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picLevel(Index), X, Y, BUTTON_SMALL, (Index = level), BUTTON_DOWN + +End Sub + +Private Sub picLevel_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picLevel(Index), X, Y, BUTTON_SMALL, (Index = level), BUTTON_MOVE, lblLevel(Index).Width + 16 + +End Sub + +Private Sub picLevel_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + Dim i As Integer + + level = Index + + For i = 0 To 2 + If i <> Index Then + mouseEvent2 picLevel(i), X, Y, BUTTON_SMALL, (i = level), BUTTON_UP + End If + Next + + frmSoldatMapEditor.setSceneryLevel level + frmSoldatMapEditor.RegainFocus + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + Dim i As Integer + Dim c As Control + + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_scenery.bmp") + + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picSceneryMenu, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + + For i = 0 To 2 + mouseEvent2 picLevel(i), 0, 0, BUTTON_SMALL, (i = level), BUTTON_UP + Next + + mouseEvent2 picScale, 0, 0, BUTTON_SMALL, scaleScenery, BUTTON_UP + mouseEvent2 picRotate, 0, 0, BUTTON_SMALL, rotateScenery, BUTTON_UP + + + Me.BackColor = bgClr + lblLvl.BackColor = lblBackClr + lblLvl.ForeColor = lblTextClr + For i = 0 To 2 + lblLevel(i).BackColor = lblBackClr + lblLevel(i).ForeColor = lblTextClr + Next + lblRotate.BackColor = lblBackClr + lblRotate.ForeColor = lblTextClr + lblScale.BackColor = lblBackClr + lblScale.ForeColor = lblTextClr + lstScenery.BackColor = txtBackClr + lstScenery.ForeColor = txtTextClr + picScenery.BackColor = bgClr + + For Each c In Me.Controls + If c.Tag = "font1" Then + c.Font.Name = font1 + ElseIf c.Tag = "font2" Then + c.Font.Name = font2 + End If + Next + +End Sub diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 626033e..603bb77 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -1,15052 +1,15052 @@ -VERSION 5.00 -Object = "{DDA53BD0-2CD0-11D4-8ED4-00E07D815373}#1.0#0"; "MBMouse.ocx" -Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" -Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx" -Begin VB.Form frmSoldatMapEditor - BackColor = &H00000000& - BorderStyle = 1 'Fixed Single - ClientHeight = 9000 - ClientLeft = 3600 - ClientTop = 3180 - ClientWidth = 12000 - ControlBox = 0 'False - DrawMode = 6 'Mask Pen Not - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Icon = "frmSoldatMapEditor.frx":0000 - KeyPreview = -1 'True - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - MousePointer = 99 'Custom - OLEDropMode = 1 'Manual - ScaleHeight = 600 - ScaleMode = 3 'Pixel - ScaleWidth = 800 - ShowInTaskbar = 0 'False - Begin VB.PictureBox picButtonGfx - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - Enabled = 0 'False - ForeColor = &H80000008& - Height = 2895 - Left = 4080 - ScaleHeight = 193 - ScaleMode = 3 'Pixel - ScaleWidth = 241 - TabIndex = 13 - TabStop = 0 'False - Top = 1200 - Width = 3615 - Visible = 0 'False - End - Begin MSComctlLib.ImageList ImageList - Left = 4080 - Top = 4200 - _ExtentX = 1005 - _ExtentY = 1005 - BackColor = -2147483643 - ImageWidth = 32 - ImageHeight = 32 - MaskColor = 16777215 - _Version = 393216 - End - Begin VB.PictureBox picStatus - Align = 2 'Align Bottom - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H00FFFFFF& - Height = 270 - Left = 0 - ScaleHeight = 18 - ScaleMode = 3 'Pixel - ScaleWidth = 800 - TabIndex = 10 - TabStop = 0 'False - Top = 8730 - Width = 12000 - Begin VB.TextBox txtZoom - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 240 - Left = 3000 - TabIndex = 14 - TabStop = 0 'False - Tag = "font1" - Top = 45 - Width = 735 - End - Begin VB.Label lblMousePosition - BackStyle = 0 'Transparent - Caption = "Position:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 8160 - TabIndex = 20 - Tag = "font2" - Top = 45 - Width = 3735 - End - Begin VB.Label lblFileName - BackColor = &H004A3C31& - BackStyle = 0 'Transparent - Caption = "Untitled.pms" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 120 - TabIndex = 16 - Tag = "font2" - Top = 45 - Width = 2055 - End - Begin VB.Label lblZoom - BackStyle = 0 'Transparent - Caption = "Zoom:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 2400 - TabIndex = 12 - Tag = "font2" - Top = 45 - Width = 615 - End - Begin VB.Label lblCurrentTool - BackStyle = 0 'Transparent - Caption = "Current Tool:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 4080 - TabIndex = 11 - Tag = "font2" - Top = 45 - Width = 3855 - End - End - Begin VB.PictureBox picMenuBar - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 0 - MousePointer = 1 'Arrow - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 800 - TabIndex = 2 - TabStop = 0 'False - Top = 375 - Width = 12000 - Begin VB.PictureBox picMenu - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - FillColor = &H00FFFFFF& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 4 - Left = 3840 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 19 - TabStop = 0 'False - Top = 0 - Width = 960 - End - Begin VB.PictureBox picProgress - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - FillColor = &H007B614A& - ForeColor = &H80000008& - Height = 150 - Left = 9960 - ScaleHeight = 11 - ScaleMode = 0 'User - ScaleWidth = 128 - TabIndex = 15 - TabStop = 0 'False - Top = 30 - Width = 1920 - End - Begin VB.PictureBox picMenu - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - FillColor = &H00FFFFFF& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 1920 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 9 - TabStop = 0 'False - Top = 0 - Width = 960 - End - Begin VB.PictureBox picMenu - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - FillColor = &H00FFFFFF& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 960 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 5 - TabStop = 0 'False - Top = 0 - Width = 960 - End - Begin VB.PictureBox picMenu - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - FillColor = &H00FFFFFF& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 3 - Left = 2880 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 4 - TabStop = 0 'False - Top = 0 - Width = 960 - End - Begin VB.PictureBox picMenu - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - FillColor = &H00FFFFFF& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 3 - TabStop = 0 'False - Top = 0 - Width = 960 - End - End - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H00FFFFFF& - Height = 375 - Left = 0 - MousePointer = 1 'Arrow - ScaleHeight = 25 - ScaleMode = 3 'Pixel - ScaleWidth = 800 - TabIndex = 0 - Top = 0 - Width = 12000 - Begin VB.PictureBox picHelp - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - FillColor = &H80000008& - ForeColor = &H80000008& - Height = 240 - Left = 10800 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 17 - TabStop = 0 'False - Tag = "9" - ToolTipText = "Help" - Top = 0 - Width = 240 - End - Begin VB.PictureBox picMinimize - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 11280 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 8 - TabStop = 0 'False - Tag = "0" - ToolTipText = "Minimize" - Top = 0 - Width = 240 - End - Begin VB.PictureBox picMaximize - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 11520 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 7 - TabStop = 0 'False - Tag = "1" - ToolTipText = "Restore Down/Maximize" - Top = 0 - Width = 240 - End - Begin VB.PictureBox picExit - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 11760 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 6 - TabStop = 0 'False - Tag = "3" - ToolTipText = "Close" - Top = 0 - Width = 240 - End - End - Begin MSComDlg.CommonDialog commonDialog - Left = 3120 - Top = 600 - _ExtentX = 847 - _ExtentY = 847 - _Version = 393216 - CancelError = -1 'True - End - Begin VB.PictureBox picGfx - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - Enabled = 0 'False - ForeColor = &H80000008& - Height = 6735 - Left = 2520 - ScaleHeight = 449 - ScaleMode = 3 'Pixel - ScaleWidth = 97 - TabIndex = 1 - TabStop = 0 'False - Top = 1200 - Width = 1455 - Visible = 0 'False - End - Begin MSComctlLib.TreeView tvwScenery - Height = 8085 - Left = 0 - TabIndex = 18 - Tag = "font1" - Top = 600 - Width = 5730 - Visible = 0 'False - _ExtentX = 10107 - _ExtentY = 14261 - _Version = 393217 - HideSelection = 0 'False - Indentation = 423 - LabelEdit = 1 - Style = 7 - FullRowSelect = -1 'True - Appearance = 0 - MousePointer = 1 - BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - OLEDragMode = 1 - End - Begin MBMouseHelper.MouseHelper MouseHelper - Left = 2520 - Top = 600 - _ExtentX = 900 - _ExtentY = 900 - End - Begin VB.Menu mnuMenu - Caption = "&File" - Index = 0 - Visible = 0 'False - Begin VB.Menu mnuNew - Caption = "&New" - Shortcut = ^N - End - Begin VB.Menu mnuOpen - Caption = "&Open..." - Shortcut = ^O - End - Begin VB.Menu mnuOpenCompiled - Caption = "O&pen Compiled..." - End - Begin VB.Menu mnuRecentFiles - Caption = "Open &Recent" - Begin VB.Menu mnuRecent - Caption = "" - Index = 0 - End - Begin VB.Menu mnuRecent - Caption = "" - Index = 1 - End - Begin VB.Menu mnuRecent - Caption = "" - Index = 2 - End - Begin VB.Menu mnuRecent - Caption = "" - Index = 3 - End - Begin VB.Menu mnuRecent - Caption = "" - Index = 4 - End - Begin VB.Menu mnuRecent - Caption = "" - Index = 5 - End - Begin VB.Menu mnuRecent - Caption = "" - Index = 6 - End - Begin VB.Menu mnuRecent - Caption = "" - Index = 7 - End - Begin VB.Menu mnuRecent - Caption = "" - Index = 8 - End - Begin VB.Menu mnuRecent - Caption = "" - Index = 9 - End - End - Begin VB.Menu mnuSep3 - Caption = "-" - End - Begin VB.Menu mnuSave - Caption = "&Save..." - Shortcut = ^S - End - Begin VB.Menu mnuSaveAs - Caption = "Save &As..." - End - Begin VB.Menu mnuSep15 - Caption = "-" - End - Begin VB.Menu mnuCompile - Caption = "&Compile to pms" - End - Begin VB.Menu mnuCompileAs - Caption = "Compile to &pms As..." - Shortcut = {F9} - End - Begin VB.Menu mnuSep10 - Caption = "-" - End - Begin VB.Menu mnuExport - Caption = "&Export..." - End - Begin VB.Menu mnuImport - Caption = "&Import..." - End - Begin VB.Menu mnuSep18 - Caption = "-" - End - Begin VB.Menu mnuRunSoldat - Caption = "&Run Soldat" - Shortcut = {F8} - End - Begin VB.Menu mnuSep1 - Caption = "-" - End - Begin VB.Menu mnuExit - Caption = "E&xit" - End - End - Begin VB.Menu mnuMenu - Caption = "Edit" - Index = 1 - Visible = 0 'False - Begin VB.Menu mnuUndo - Caption = "Undo" - Shortcut = ^Z - End - Begin VB.Menu mnuRedo - Caption = "Redo" - Shortcut = ^Y - End - Begin VB.Menu mnuSep8 - Caption = "-" - End - Begin VB.Menu mnuDuplicate - Caption = "Duplicate" - End - Begin VB.Menu mnuCopy - Caption = "Copy" - Shortcut = ^C - End - Begin VB.Menu mnuPaste - Caption = "Paste" - Shortcut = ^V - End - Begin VB.Menu mnuClear - Caption = "Clear" - Shortcut = {DEL} - End - Begin VB.Menu mnuSep32 - Caption = "-" - End - Begin VB.Menu mnuSelectAll - Caption = "Select All" - Shortcut = ^A - End - Begin VB.Menu mnuInvertSel - Caption = "Invert Selection" - Shortcut = ^I - End - Begin VB.Menu mnuDeselect - Caption = "Deselect" - Shortcut = ^D - End - Begin VB.Menu mnuSelColor - Caption = "Select by Color" - Shortcut = ^B - End - Begin VB.Menu mnuSep5 - Caption = "-" - End - Begin VB.Menu mnuArrange - Caption = "Arrange" - Begin VB.Menu mnuBringToFront - Caption = "Bring to Front" - End - Begin VB.Menu mnuBringForward - Caption = "Bring Forward" - End - Begin VB.Menu mnuSendBackward - Caption = "Send Backward" - End - Begin VB.Menu mnuSendToBack - Caption = "Send to Back" - End - End - Begin VB.Menu mnuSep12 - Caption = "-" - End - Begin VB.Menu mnuSplit - Caption = "Split at Vertex" - Shortcut = ^L - End - Begin VB.Menu mnuJoinVertices - Caption = "Join Vertices" - Shortcut = ^J - End - Begin VB.Menu mnuSnapSelected - Caption = "Snap Selected Vertices" - End - Begin VB.Menu mnuCreate - Caption = "Create with Selected" - Shortcut = ^E - End - Begin VB.Menu mnuTransform - Caption = "Transform" - Begin VB.Menu mnuRotate - Caption = "Rotate 180°" - Index = 0 - End - Begin VB.Menu mnuRotate - Caption = "Rotate 90° CW" - Index = 1 - End - Begin VB.Menu mnuRotate - Caption = "Rotate 90° CCW" - Index = 2 - End - Begin VB.Menu mnuSep6 - Caption = "-" - End - Begin VB.Menu mnuFlip - Caption = "Flip Horizontal" - Index = 0 - End - Begin VB.Menu mnuFlip - Caption = "Flip Vertical" - Index = 1 - End - End - Begin VB.Menu mnuSep20 - Caption = "-" - End - Begin VB.Menu mnuSever - Caption = "Sever Connections" - End - Begin VB.Menu mnuSep16 - Caption = "-" - End - Begin VB.Menu mnuClrSketch - Caption = "Clear sketch" - End - Begin VB.Menu mnuSep30 - Caption = "-" - End - Begin VB.Menu mnuMap - Caption = "Map Settings..." - Shortcut = ^M - End - Begin VB.Menu mnuSep21 - Caption = "-" - End - Begin VB.Menu mnuPreferences - Caption = "Preferences..." - Shortcut = ^P - End - End - Begin VB.Menu mnuMenu - Caption = "Texture" - Index = 2 - Visible = 0 'False - Begin VB.Menu mnuFixTexture - Caption = "Fix Texture" - Shortcut = ^F - End - Begin VB.Menu mnuUntexture - Caption = "Untexture" - Shortcut = ^U - End - Begin VB.Menu mnuTransformTexture - Caption = "Transform Texture" - Begin VB.Menu mnuRotateTexture - Caption = "Rotate 180°" - Index = 0 - End - Begin VB.Menu mnuRotateTexture - Caption = "Rotate 90° CW" - Index = 1 - End - Begin VB.Menu mnuRotateTexture - Caption = "Rotate 90° CCW" - Index = 2 - End - Begin VB.Menu mnuSep31 - Caption = "-" - End - Begin VB.Menu mnuFlipTexture - Caption = "Flip Horizontal" - Index = 0 - End - Begin VB.Menu mnuFlipTexture - Caption = "Flip Vertical" - Index = 1 - End - End - Begin VB.Menu mnuSep9 - Caption = "-" - End - Begin VB.Menu mnuAverage - Caption = "Average Vertex Colors" - Shortcut = ^G - End - Begin VB.Menu mnuApplyLight - Caption = "Apply Light to Vertices" - End - Begin VB.Menu mnuSep17 - Caption = "-" - End - Begin VB.Menu mnuFixedTexture - Caption = "Fixed Texture" - End - Begin VB.Menu mnuCustomX - Caption = "User Defined X" - End - Begin VB.Menu mnuCustomY - Caption = "User Defined Y" - End - End - Begin VB.Menu mnuMenu - Caption = "View" - Index = 3 - Visible = 0 'False - Begin VB.Menu mnuZoomIn - Caption = "Zoom In" - End - Begin VB.Menu mnuZoomOut - Caption = "Zoom Out" - End - Begin VB.Menu mnuFitOnScreen - Caption = "Fit on Screen" - End - Begin VB.Menu mnuActualPixels - Caption = "Actual Size" - End - Begin VB.Menu mnuResetView - Caption = "Reset View" - End - Begin VB.Menu mnuSep11 - Caption = "-" - End - Begin VB.Menu mnuGrid - Caption = "Show Grid" - End - Begin VB.Menu mnuSnapToGrid - Caption = "Snap to Grid" - Checked = -1 'True - End - Begin VB.Menu mnuSnapToVerts - Caption = "Snap to Vertices" - Checked = -1 'True - End - Begin VB.Menu mnuSep13 - Caption = "-" - End - Begin VB.Menu mnuBlendWireframe - Caption = "Blend Wireframe" - End - Begin VB.Menu mnuBlendPolys - Caption = "Blend Polys" - End - Begin VB.Menu mnuShowSceneryLayers - Caption = "Show Scenery Layers" - Begin VB.Menu mnuShowSceneryLayer - Caption = "Back" - Checked = -1 'True - Index = 0 - End - Begin VB.Menu mnuShowSceneryLayer - Caption = "Middle" - Checked = -1 'True - Index = 1 - End - Begin VB.Menu mnuShowSceneryLayer - Caption = "Front" - Checked = -1 'True - Index = 2 - End - End - Begin VB.Menu mnuSep14 - Caption = "-" - End - Begin VB.Menu mnuRefreshBG - Caption = "Refresh" - Shortcut = {F5} - End - End - Begin VB.Menu mnuMenu - Caption = "Window" - Index = 4 - Visible = 0 'False - Begin VB.Menu mnuWorkspace - Caption = "Workspace" - Begin VB.Menu mnuLoadSpace - Caption = "Load Workspace..." - End - Begin VB.Menu mnuSaveSpace - Caption = "Save Workspace..." - End - Begin VB.Menu mnuResetWindows - Caption = "Reset Window Locations" - End - End - Begin VB.Menu mnuShowAll - Caption = "Show All" - End - Begin VB.Menu mnuHideAll - Caption = "Hide All" - End - Begin VB.Menu mnuSep2 - Caption = "-" - End - Begin VB.Menu mnuTools - Caption = "Tools" - End - Begin VB.Menu mnuDisplay - Caption = "Display" - End - Begin VB.Menu mnuPalette - Caption = "Palette" - End - Begin VB.Menu mnuWaypoints - Caption = "Waypoints" - End - Begin VB.Menu mnuScenery - Caption = "Scenery" - End - Begin VB.Menu mnuInfo - Caption = "Properties" - End - Begin VB.Menu mnuTexture - Caption = "Texture" - End - End - Begin VB.Menu mnuObjects - Caption = "Objects" - Visible = 0 'False - Begin VB.Menu mnuSpawn - Caption = "Player Spawn" - Index = 0 - End - Begin VB.Menu mnuSpawn - Caption = "Alpha Team" - Index = 1 - End - Begin VB.Menu mnuSpawn - Caption = "Bravo Team" - Index = 2 - End - Begin VB.Menu mnuSpawn - Caption = "Charlie Team" - Index = 3 - End - Begin VB.Menu mnuSpawn - Caption = "Delta Team" - Index = 4 - End - Begin VB.Menu mnuSpawn - Caption = "Alpha Flag" - Index = 5 - End - Begin VB.Menu mnuSpawn - Caption = "Bravo Flag" - Index = 6 - End - Begin VB.Menu mnuSpawn - Caption = "Grenade Kit" - Index = 7 - End - Begin VB.Menu mnuSpawn - Caption = "Medikit" - Index = 8 - End - Begin VB.Menu mnuSpawn - Caption = "Cluster Grenades" - Index = 9 - End - Begin VB.Menu mnuSpawn - Caption = "Vest" - Index = 10 - End - Begin VB.Menu mnuSpawn - Caption = "Flame" - Index = 11 - End - Begin VB.Menu mnuSpawn - Caption = "Berserker" - Index = 12 - End - Begin VB.Menu mnuSpawn - Caption = "Predator" - Index = 13 - End - Begin VB.Menu mnuSpawn - Caption = "Point Match Flag" - Index = 14 - End - Begin VB.Menu mnuSpawn - Caption = "Rambo Bow" - Index = 15 - End - Begin VB.Menu mnuSpawn - Caption = "Stat Gun" - Index = 16 - End - Begin VB.Menu mnuSepObj - Caption = "-" - End - Begin VB.Menu mnuCollider - Caption = "Collider" - End - Begin VB.Menu mnuSepObj2 - Caption = "-" - End - Begin VB.Menu mnuGostek - Caption = "Gostek" - End - End - Begin VB.Menu mnuPolyTypes - Caption = "Polygon Types" - Visible = 0 'False - Begin VB.Menu mnuPolyType - Caption = "Normal" - Checked = -1 'True - Index = 0 - End - Begin VB.Menu mnuPolyType - Caption = "Only Bullets Collide" - Index = 1 - End - Begin VB.Menu mnuPolyType - Caption = "Only Player Collides" - Index = 2 - End - Begin VB.Menu mnuPolyType - Caption = "Doesn't Collide" - Index = 3 - End - Begin VB.Menu mnuPolyType - Caption = "Ice" - Index = 4 - End - Begin VB.Menu mnuPolyType - Caption = "Deadly" - Index = 5 - End - Begin VB.Menu mnuPolyType - Caption = "Bloody Deadly" - Index = 6 - End - Begin VB.Menu mnuPolyType - Caption = "Hurts" - Index = 7 - End - Begin VB.Menu mnuPolyType - Caption = "Regenerates" - Index = 8 - End - Begin VB.Menu mnuPolyType - Caption = "Lava" - Index = 9 - End - Begin VB.Menu mnuPolyType - Caption = "Red Bullets Collides" - Index = 10 - End - Begin VB.Menu mnuPolyType - Caption = "Red Players Collide" - Index = 11 - End - Begin VB.Menu mnuPolyType - Caption = "Blue Bullets Collides" - Index = 12 - End - Begin VB.Menu mnuPolyType - Caption = "Blue Players Collide" - Index = 13 - End - Begin VB.Menu mnuPolyType - Caption = "Yellow Bullets Collides" - Index = 14 - End - Begin VB.Menu mnuPolyType - Caption = "Yellow Players Collide" - Index = 15 - End - Begin VB.Menu mnuPolyType - Caption = "Green Bullets Collides" - Index = 16 - End - Begin VB.Menu mnuPolyType - Caption = "Green Players Collide" - Index = 17 - End - Begin VB.Menu mnuPolyType - Caption = "Bouncy" - Index = 18 - End - Begin VB.Menu mnuPolyType - Caption = "Explosive" - Index = 19 - End - Begin VB.Menu mnuPolyType - Caption = "Hurts Flaggers" - Index = 20 - End - Begin VB.Menu mnuPolyType - Caption = "Flagger Collides" - Index = 21 - End - Begin VB.Menu mnuPolyType - Caption = "Non-Flagger Collides" - Index = 22 - End - Begin VB.Menu mnuPolyType - Caption = "Flag Collides" - Index = 23 - End - Begin VB.Menu mnuPolyType - Caption = "Background" - Index = 24 - End - Begin VB.Menu mnuPolyType - Caption = "Background Transition" - Index = 25 - End - Begin VB.Menu mnuSep19 - Caption = "-" - End - Begin VB.Menu mnuQuad - Caption = "Textured Quad" - End - End - Begin VB.Menu mnuMove - Caption = "Move" - Visible = 0 'False - Begin VB.Menu mnuSetRCenter - Caption = "Set Reference Point" - End - Begin VB.Menu mnuCenterRCenter - Caption = "Center Reference Point" - End - Begin VB.Menu mnuFixedRCenter - Caption = "Fixed Reference Point" - Checked = -1 'True - End - End - Begin VB.Menu mnuWaypoint - Caption = "Waypoint" - Visible = 0 'False - Begin VB.Menu mnuWayType - Caption = "Left" - Index = 0 - End - Begin VB.Menu mnuWayType - Caption = "Right" - Index = 1 - End - Begin VB.Menu mnuWayType - Caption = "Up" - Index = 2 - End - Begin VB.Menu mnuWayType - Caption = "Down" - Index = 3 - End - Begin VB.Menu mnuWayType - Caption = "Fly" - Index = 4 - End - End - Begin VB.Menu mnuScen - Caption = "Scenery" - Visible = 0 'False - Begin VB.Menu mnuScenTrans - Caption = "Rotate" - Index = 0 - End - Begin VB.Menu mnuScenTrans - Caption = "Scale" - Index = 1 - End - Begin VB.Menu mnuScenSep - Caption = "-" - End - Begin VB.Menu mnuScenLevel - Caption = "Back" - Checked = -1 'True - Index = 0 - End - Begin VB.Menu mnuScenLevel - Caption = "Middle" - Index = 1 - End - Begin VB.Menu mnuScenLevel - Caption = "Front" - Index = 2 - End - End - Begin VB.Menu mnuScenTree - Caption = "Scenery Tree" - Visible = 0 'False - Begin VB.Menu mnuScenList - Caption = "" - End - Begin VB.Menu mnuScenRemove - Caption = "Remove from List" - End - End - Begin VB.Menu mnuVertexSelect - Caption = "VertexSelect" - Visible = 0 'False - Begin VB.Menu mnuVSelDuplicate - Caption = "Duplicate" - End - Begin VB.Menu mnuVSelCopy - Caption = "Copy" - End - Begin VB.Menu mnuVSelPaste - Caption = "Paste" - End - Begin VB.Menu mnuVSelClear - Caption = "Clear" - End - Begin VB.Menu mnuVSel0 - Caption = "-" - End - Begin VB.Menu mnuVSelArrange - Caption = "Arrange" - Begin VB.Menu mnuVSelBringToFront - Caption = "Bring To Front" - End - Begin VB.Menu mnuVSelBringForward - Caption = "Bring Forward" - End - Begin VB.Menu mnuVSelSendBackward - Caption = "Send Backward" - End - Begin VB.Menu mnuVSelSendToBack - Caption = "Send To Back" - End - End - Begin VB.Menu mnuVSelTransform - Caption = "Transform" - Begin VB.Menu mnuVSelRotate - Caption = "Rotate 180°" - Index = 0 - End - Begin VB.Menu mnuVSelRotate - Caption = "Rotate 90° CW" - Index = 1 - End - Begin VB.Menu mnuVSelRotate - Caption = "Rotate 90° CCW" - Index = 2 - End - Begin VB.Menu mnuVSelSep1 - Caption = "-" - End - Begin VB.Menu mnuVSelFlip - Caption = "Flip Horizontal" - Index = 0 - End - Begin VB.Menu mnuVSelFlip - Caption = "Flip Vertical" - Index = 1 - End - End - End -End -Attribute VB_Name = "frmSoldatMapEditor" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Dim DX As DirectX8 -Dim D3D As Direct3D8 -Dim D3DDevice As Direct3DDevice8 -Dim DI As DirectInput8 -Dim DIDevice As DirectInputDevice8 -Dim DIState As DIKEYBOARDSTATE - -Const BufferSize As Long = 10 - -Dim hEvent As Long -Implements DirectXEvent8 - -Dim D3DX As D3DX8 -Dim mapTexture As Direct3DTexture8 -Dim particleTexture As Direct3DTexture8 -Dim patternTexture As Direct3DTexture8 -Dim objectsTexture As Direct3DTexture8 -Dim lineTexture As Direct3DTexture8 -Dim pathTexture As Direct3DTexture8 -Dim rCenterTexture As Direct3DTexture8 -Dim sketchTexture As Direct3DTexture8 - -Dim renderTarget As Direct3DTexture8 -Dim renderSurface As Direct3DSurface8 -Dim backBuffer As Direct3DSurface8 - -Dim scenerySprite As D3DXSprite - -Const ColorKey As Long = &HFF00FF00 - -Const FVF As Long = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE -Const FVF2 As Long = D3DFVF_XYZ - - -'types - -Private Type TImageInfo - Width As Integer - miplevels As Integer - Height As Integer - depth As Integer -End Type - -Private Type TColor - red As Byte - green As Byte - blue As Byte -End Type - -Private Type TVertexData - vertex(1 To 3) As Byte - polyType As Byte - color(1 To 3) As TColor -End Type - -Private Type TTriangle - vertex(1 To 3) As D3DVECTOR2 -End Type - -Private Type TLightSource - selected As Byte - color As TColor - intensity As Single - range As Integer - X As Single - Y As Single - z As Single -End Type - - -'map types - -Private Type TCustomVertex - X As Single - Y As Single - z As Single - rhw As Single - Color As Long - tu As Single - tv As Single -End Type -Private Type TSketchVertex - X As Single - Y As Single - z As Single -End Type -Private Type TSketchLine - vertex(1 To 2) As TSketchVertex -End Type -Private Type TVertexHit - X As Single 'sin of angle - Y As Single 'cos of angle - z As Single '0 -End Type -Private Type TPolyHit - vertex(1 To 3) As TVertexHit -End Type -Private Type TPolygon - vertex(1 To 3) As TCustomVertex - Perp As TPolyHit -End Type -Private Type TLine - vertex(1 To 2) As TCustomVertex -End Type - -Private Type TProp - active As Boolean - Style As Integer - Width As Long - Height As Long - X As Single - Y As Single - rotation As Single - ScaleX As Single - ScaleY As Single - alpha As Long - Color As Long - level As Long -End Type - -Private Type TScenery - Style As Integer - Translation As D3DVECTOR2 - rotation As Single - Scaling As D3DVECTOR2 - alpha As Byte - Color As Long - level As Byte - selected As Byte - screenTr As D3DVECTOR2 -End Type - -Private Type TSpawnPoint - active As Long 'Boolean - X As Single - Y As Single - Team As Long -End Type - -Private Type TSaveSpawnPoint - active As Long 'Boolean - X As Long - Y As Long - Team As Long -End Type - -Private Type TCollider - active As Long 'Boolean - X As Single - Y As Single - radius As Single -End Type - -Private Type TOptions - mapName(0 To 38) As Byte 'String * 39 - textureName(0 To 24) As Byte 'String * 25 - BackgroundColor As Long - BackgroundColor2 As Long - StartJet As Long - GrenadePacks As Byte - Medikits As Byte - Weather As Byte - Steps As Byte - MapRandomID As Long 'Integer -End Type - -Private Type TMapFile_Polygon - Poly As TPolygon - polyType As Byte -End Type - -Private Type TMapFile_Scenery - sceneryName(0 To 50) As Byte - Date As Long -End Type - -Private Type TextureData - Width As Integer - Height As Integer - reScale As D3DVECTOR2 - Texture As Direct3DTexture8 -End Type - -Private Type TNewWaypoint - active As Long - id As Long - X As Long - Y As Long - left As Byte - right As Byte - up As Byte - down As Byte - m2 As Byte - pathNum As Byte - special As Byte - crap(1 To 5) As Byte - connectionsNum As Long - Connections(1 To 20) As Long -End Type - -Private Type TWaypoint - tempIndex As Integer - selected As Boolean - X As Single - Y As Single - wayType(0 To 4) As Boolean - special As Byte - pathNum As Byte - numConnections As Byte -End Type - -Private Type TConnection - point1 As Integer - point2 As Integer -End Type - - -Dim Version As Long -Dim Polys() As TPolygon -Dim PolyCoords() As TTriangle - -Dim Scenery() As TScenery -Dim SceneryTextures() As TextureData - -Dim Spawns() As TSpawnPoint -Dim Colliders() As TCollider -Dim Waypoints() As TWaypoint -Dim Connections() As TConnection - -Dim Lights() As TLightSource - -Dim Options As TOptions -Dim polyCount As Long - -Dim sceneryCount As Long, sceneryElements As Long -Dim spawnPoints As Long, colliderCount As Long -Dim waypointCount As Long, conCount As Integer -Dim lightCount As Integer - -Public mapTitle As String, textureFile As String -Dim maxX As Single, maxY As Single, minX As Single, minY As Single - -Dim bgPolys(1 To 4) As TCustomVertex -Dim bgPolyCoords(1 To 4) As D3DVECTOR2 -Dim bgColors(1 To 2) As TColor - -Const MAX_POLYS As Integer = 4000 -Const MAX_ZOOM As Single = 16 -Const MIN_ZOOM As Single = 0.03125 - -Const TOOL_MOVE As Byte = 0 -Const TOOL_CREATE As Byte = 1 -Const TOOL_VSELECT As Byte = 2 -Const TOOL_PSELECT As Byte = 3 -Const TOOL_VCOLOR As Byte = 4 -Const TOOL_PCOLOR As Byte = 5 -Const TOOL_TEXTURE As Byte = 6 -Const TOOL_SCENERY As Byte = 7 -Const TOOL_WAYPOINT As Byte = 8 -Const TOOL_OBJECTS As Byte = 9 -Const TOOL_CLRPICKER As Byte = 10 -Const TOOL_SKETCH As Byte = 11 -Const TOOL_LIGHTS As Byte = 12 -Const TOOL_DEPTHMAP As Byte = 13 - -Const TOOL_HAND As Byte = 14 -Const TOOL_VSELADD As Byte = 15 -Const TOOL_VSELSUB As Byte = 16 -Const TOOL_PSELADD As Byte = 17 -Const TOOL_PSELSUB As Byte = 18 -Const TOOL_SCALE As Byte = 19 -Const TOOL_ROTATE As Byte = 20 -Const TOOL_CONNECT As Byte = 21 -Const TOOL_QUAD As Byte = 22 -Const TOOL_PIXPICKER As Byte = 23 -Const TOOL_LITPICKER As Byte = 24 -Const TOOL_ERASER As Byte = 25 -Const TOOL_SMUDGE As Byte = 26 -Const TOOL_NULL As Byte = 255 - -Const KEY_SHIFT As Byte = 1 -Const KEY_CTRL As Byte = 2 -Const KEY_ALT As Byte = 4 - - -Dim sketch() As TSketchLine -Dim sketchLines As Integer -Dim selectedSketch(1 To 2) As Integer - -Dim circleOn As Boolean -Dim leftMouseDown As Boolean - -Dim initialized As Boolean, initialized2 As Boolean -Dim acquired As Boolean -Dim selectionChanged As Boolean - -Dim clrPolys As Boolean, clrWireframe As Boolean -Dim sslBack As Boolean, sslMid As Boolean, sslFront As Boolean -Public backClr As Long, pointClr As Long, selectionClr As Long, gridClr As Long, gridClr2 As Long -Public polyBlendSrc As Long, polyBlendDest As Long, wireBlendSrc As Long, wireBlendDest As Long -Public soldatDir As String, uncompDir As String, prefabDir As String -Public gridSpacing As Integer, gridDivisions As Integer -Public gridOp1 As Byte, gridOp2 As Byte -Dim noRedraw As Boolean - -Public sceneryVerts As Boolean, topmost As Boolean - -Public formHeight As Integer, formWidth As Integer, formLeft As Integer, formTop As Integer - -Dim polyClr As TColor -Dim opacity As Single -Dim blendMode As Integer - -Dim scrollCoords(1 To 2) As D3DVECTOR2 'coordinates for scrolling -Dim mouseCoords As D3DVECTOR2 'coordinates of mouse -Dim moveCoords(1 To 2) As D3DVECTOR2 'coordinates for moving vertices -Dim selectedCoords(1 To 2) As D3DVECTOR2 'coordinates of selected area -Dim selectedPolys() As Integer 'list of selected polys and verts -Dim vertexList() As TVertexData 'list of polys with selected verts -Dim numVerts As Integer 'number of current vertex being created -Dim numCorners As Integer 'number of corner of scenery being created - -Dim numSelectedPolys As Integer -Dim numSelectedScenery As Integer 'number of currently selected scenery -Dim numSelColliders As Integer -Dim numSelSpawns As Integer -Dim numSelWaypoints As Integer -Dim numSelLights As Integer - -Public xTexture As Integer, yTexture As Integer -Dim creatingQuad As Boolean - -Dim currentFileName As String -Dim prompt As Boolean - -Dim toolAction As Boolean -Dim spaceDown As Boolean - -Dim currentScenery As String - -Dim zoomFactor As Single -Dim pointRadius As Integer -Dim snapRadius As Integer, clrRadius As Integer -Dim ohSnap As Boolean, snapToGrid As Boolean, fixedTexture As Boolean -Dim showBG As Boolean, showPolys As Boolean, showTexture As Boolean, showWireframe As Boolean -Dim showPoints As Boolean, showScenery As Boolean, showObjects As Boolean, showGrid As Boolean -Dim showWaypoints As Boolean, showPath1 As Boolean, showPath2 As Boolean -Dim showSketch As Boolean, showLights As Boolean -Dim currentTool As Byte, currentFunction As Byte -Dim particleSize As Single -Dim colorMode As Byte -Dim eraseCircle As Boolean, eraseLines As Boolean - -Dim polyType As Byte -Dim PolyTypeClrs(0 To 25) As Long - -Public shiftDown As Boolean, ctrlDown As Boolean, altDown As Boolean - -Dim rCenter As D3DVECTOR2 -Dim selRect(3) As D3DVECTOR2 'RECT - -Dim xGridLines() As TLine -Dim yGridLines() As TLine -Dim inc As Single - -Dim scaleDiff As D3DVECTOR2 -Dim rDiff As Single - -Dim gostek As D3DVECTOR2 - -Dim imageInfo As TImageInfo -Dim textureDesc As D3DSURFACE_DESC - -Dim noneSelected As Boolean - -Dim currentUndo As Integer, numUndo As Integer, numRedo As Integer -Dim max_undo As Integer -Dim lastCompiled As String - -Dim currentWaypoint As Integer - -Dim objTexSize As D3DVECTOR2 - -Private Sub Form_Load() - - On Error GoTo ErrorHandler - - Dim i As Integer - Dim temp As String - Dim err As String - - initialized = False - - loadINI - loadWorkspace - loadColors - - err = "Error setting colors" - Me.SetColors - Me.Show - - err = "Error setting directories" - If Len(Dir$(uncompDir)) = 0 Or uncompDir = "" Then - uncompDir = appPath & "\Maps\" - End If - - If Len(Dir$(prefabDir)) = 0 Or prefabDir = "" Then - prefabDir = appPath & "\Prefabs\" - End If - - 'if given directory doesn't exist, change to default - If Len(Dir$(soldatDir & "Textures\")) = 0 Or soldatDir = "" Then - temp = GetSoldatDir - If temp <> "" Then - soldatDir = temp - temp = "" - End If - End If - - frmTools.initTool currentTool - - initGfx - - err = "Error loading cursors" - loadCursors - - err = "Error initializing values" - - 'init values - scrollCoords(2).X = -Me.ScaleWidth / 2 - scrollCoords(2).Y = -Me.ScaleHeight / 2 - pointRadius = 4 - particleSize = pointRadius * 2 - zoomFactor = 1 - scaleDiff.X = 1 - scaleDiff.Y = 1 - sslBack = True - sslMid = True - sslFront = True - - PolyTypeClrs(0) = selectionClr - - ReDim Scenery(0) - ReDim Preserve SceneryTextures(0) - ReDim Spawns(0) - ReDim Colliders(0) - - ReDim sketch(0) - - sketch(0).vertex(1).z = 1 - sketch(0).vertex(2).z = 1 - - Colliders(0).radius = clrRadius - - err = "Error initializing color picker" - - frmColor.picClr.Cls - frmColor.InitClr polyClr.red, polyClr.green, polyClr.blue - - err = "Error setting current tool icon (" & currentTool & ")" - - currentFunction = currentTool - - err = "Error initializing grid" - initGrid - - err = "Error initializing D3D" - initialized2 = False - Init - err = "Error initializing DInput" - InitDInput - - err = "Error setting up palette windows" - - 'show windows - frmTaskBar.Show - frmTools.Show 0, frmSoldatMapEditor - frmPalette.Show 0, frmSoldatMapEditor - frmDisplay.Show 0, frmSoldatMapEditor - frmWaypoints.Show 0, frmSoldatMapEditor - frmScenery.Show 0, frmSoldatMapEditor - frmInfo.Show 0, frmSoldatMapEditor - frmTexture.Show 0, frmSoldatMapEditor - - 'set window settings - frmDisplay.Visible = mnuDisplay.Checked - frmWaypoints.Visible = mnuWaypoints.Checked - frmPalette.Visible = mnuPalette.Checked - frmTools.Visible = mnuTools.Checked - frmScenery.Visible = mnuScenery.Checked - frmInfo.Visible = mnuInfo.Checked - frmTexture.Visible = mnuTexture.Checked - - frmPalette.refreshPalette clrRadius, opacity, blendMode, colorMode - frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue - frmDisplay.setLayer 0, showBG - frmDisplay.setLayer 1, showPolys - frmDisplay.setLayer 2, showTexture - frmDisplay.setLayer 3, showWireframe - frmDisplay.setLayer 4, showPoints - frmDisplay.setLayer 5, showScenery - frmDisplay.setLayer 6, showObjects - frmDisplay.setLayer 7, showWaypoints - frmDisplay.setLayer 8, showGrid - frmDisplay.setLayer 9, showLights - frmDisplay.setLayer 10, showSketch - - mnuFixedTexture.Checked = fixedTexture - mnuSnapToGrid.Checked = snapToGrid - mnuSnapToVerts.Checked = ohSnap - - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - - frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" - commonDialog.Flags = cdlOFNOverwritePrompt Or cdlOFNPathMustExist Or cdlOFNFileMustExist - - err = "Error parsing command line args" - - temp = Command$ - If right(temp, 1) = """" Then - temp = left(temp, Len(temp) - 1) - temp = right(temp, Len(temp) - 1) - End If - - newMap - If LCase$(right(temp, 4)) = ".pms" Then - If Dir$(temp) <> "" Then - LoadFile temp - ElseIf Dir$(appPath & "\Maps\" & temp) <> "" Then - LoadFile appPath & "\Maps\" & temp - ElseIf Dir$(soldatDir & "Maps\" & temp) <> "" Then - LoadFile soldatDir & "Maps\" & temp - End If - End If - - err = "Error acquiring input device" - - Me.SetFocus - DIDevice.Acquire - acquired = True - - Exit Sub - -ErrorHandler: - - MsgBox "Error loading" & vbNewLine & err & vbNewLine & Error$ - -End Sub - -Private Sub SetCursor(Index As Integer) - - On Error GoTo ErrorHandler - - Me.MouseIcon = frmSoldatMapEditor.ImageList.ListImages(Index).Picture - - Exit Sub - -ErrorHandler: - - MsgBox "Error setting cursor" & vbNewLine & Error$ - -End Sub - -Public Sub loadCursors() - - On Error GoTo ErrorHandler - - ImageList.ListImages.Clear - - 'load cursors - ImageList.ListImages.Add TOOL_MOVE + 1, "move", LoadPicture(appPath & "\" & gfxDir & "\cursors\move.cur") - ImageList.ListImages.Add TOOL_CREATE + 1, "create", LoadPicture(appPath & "\" & gfxDir & "\cursors\create.cur") - ImageList.ListImages.Add TOOL_VSELECT + 1, "vselect", LoadPicture(appPath & "\" & gfxDir & "\cursors\vselect.cur") - ImageList.ListImages.Add TOOL_PSELECT + 1, "pselect", LoadPicture(appPath & "\" & gfxDir & "\cursors\pselect.cur") - ImageList.ListImages.Add TOOL_VCOLOR + 1, "vcolor", LoadPicture(appPath & "\" & gfxDir & "\cursors\vcolor.cur") - ImageList.ListImages.Add TOOL_PCOLOR + 1, "pcolor", LoadPicture(appPath & "\" & gfxDir & "\cursors\pcolor.cur") - ImageList.ListImages.Add TOOL_TEXTURE + 1, "texture", LoadPicture(appPath & "\" & gfxDir & "\cursors\texture.cur") - ImageList.ListImages.Add TOOL_SCENERY + 1, "scenery", LoadPicture(appPath & "\" & gfxDir & "\cursors\scenery.cur") - ImageList.ListImages.Add TOOL_WAYPOINT + 1, "waypoint", LoadPicture(appPath & "\" & gfxDir & "\cursors\waypoint.cur") - ImageList.ListImages.Add TOOL_OBJECTS + 1, "objects", LoadPicture(appPath & "\" & gfxDir & "\cursors\objects.cur") - ImageList.ListImages.Add TOOL_CLRPICKER + 1, "clrpicker", LoadPicture(appPath & "\" & gfxDir & "\cursors\clrpicker.cur") - ImageList.ListImages.Add TOOL_SKETCH + 1, "sketch", LoadPicture(appPath & "\" & gfxDir & "\cursors\sketch.cur") - ImageList.ListImages.Add TOOL_LIGHTS + 1, "lights", LoadPicture(appPath & "\" & gfxDir & "\cursors\light.cur") - ImageList.ListImages.Add TOOL_DEPTHMAP + 1, "depthmap", LoadPicture(appPath & "\" & gfxDir & "\cursors\depthmap.cur") - - ImageList.ListImages.Add TOOL_HAND + 1, "hand", LoadPicture(appPath & "\" & gfxDir & "\cursors\hand.cur") - ImageList.ListImages.Add TOOL_VSELADD + 1, "vseladd", LoadPicture(appPath & "\" & gfxDir & "\cursors\vseladd.cur") - ImageList.ListImages.Add TOOL_VSELSUB + 1, "vselsub", LoadPicture(appPath & "\" & gfxDir & "\cursors\vselsub.cur") - ImageList.ListImages.Add TOOL_PSELADD + 1, "pseladd", LoadPicture(appPath & "\" & gfxDir & "\cursors\pseladd.cur") - ImageList.ListImages.Add TOOL_PSELSUB + 1, "pselsub", LoadPicture(appPath & "\" & gfxDir & "\cursors\pselsub.cur") - ImageList.ListImages.Add TOOL_SCALE + 1, "scale", LoadPicture(appPath & "\" & gfxDir & "\cursors\scale.cur") - ImageList.ListImages.Add TOOL_ROTATE + 1, "rotate", LoadPicture(appPath & "\" & gfxDir & "\cursors\rotate.cur") - ImageList.ListImages.Add TOOL_CONNECT + 1, "connect", LoadPicture(appPath & "\" & gfxDir & "\cursors\connect.cur") - ImageList.ListImages.Add TOOL_QUAD + 1, "quad", LoadPicture(appPath & "\" & gfxDir & "\cursors\quad.cur") - ImageList.ListImages.Add TOOL_PIXPICKER + 1, "pixpicker", LoadPicture(appPath & "\" & gfxDir & "\cursors\pixpicker.cur") - ImageList.ListImages.Add TOOL_LITPICKER + 1, "litpicker", LoadPicture(appPath & "\" & gfxDir & "\cursors\litpicker.cur") - ImageList.ListImages.Add TOOL_ERASER + 1, "eraser", LoadPicture(appPath & "\" & gfxDir & "\cursors\eraser.cur") - ImageList.ListImages.Add TOOL_SMUDGE + 1, "smudge", LoadPicture(appPath & "\" & gfxDir & "\cursors\smudge.cur") - - ImageList.ListImages.Item(TOOL_MOVE + 1).Tag = "Move Selection" - ImageList.ListImages.Item(TOOL_CREATE + 1).Tag = "Create Polygons" - ImageList.ListImages.Item(TOOL_VSELECT + 1).Tag = "Select Vertices" - ImageList.ListImages.Item(TOOL_PSELECT + 1).Tag = "Select Polygons" - ImageList.ListImages.Item(TOOL_VCOLOR + 1).Tag = "Color Vertices" - ImageList.ListImages.Item(TOOL_PCOLOR + 1).Tag = "Color Polygons" - ImageList.ListImages.Item(TOOL_TEXTURE + 1).Tag = "Transform Texture" - ImageList.ListImages.Item(TOOL_SCENERY + 1).Tag = "Create Scenery" - ImageList.ListImages.Item(TOOL_WAYPOINT + 1).Tag = "Create Waypoints" - ImageList.ListImages.Item(TOOL_OBJECTS + 1).Tag = "Place Spawn Points or Colliders" - ImageList.ListImages.Item(TOOL_CLRPICKER + 1).Tag = "Pick a Vertex Color" - ImageList.ListImages.Item(TOOL_SKETCH + 1).Tag = "Sketch" - ImageList.ListImages.Item(TOOL_LIGHTS + 1).Tag = "Create Lights" - ImageList.ListImages.Item(TOOL_DEPTHMAP + 1).Tag = "Edit Depth Map" - - ImageList.ListImages.Item(TOOL_HAND + 1).Tag = "Scroll Map" - ImageList.ListImages.Item(TOOL_VSELADD + 1).Tag = "Add to Selection" - ImageList.ListImages.Item(TOOL_VSELSUB + 1).Tag = "Subtract from Selection" - ImageList.ListImages.Item(TOOL_PSELADD + 1).Tag = "Add to Selection" - ImageList.ListImages.Item(TOOL_PSELSUB + 1).Tag = "Subtract from Selection" - ImageList.ListImages.Item(TOOL_SCALE + 1).Tag = "Scale Selection" - ImageList.ListImages.Item(TOOL_ROTATE + 1).Tag = "Rotate Selection" - ImageList.ListImages.Item(TOOL_CONNECT + 1).Tag = "Connect Waypoints" - ImageList.ListImages.Item(TOOL_QUAD + 1).Tag = "Create Quad" - ImageList.ListImages.Item(TOOL_PIXPICKER + 1).Tag = "Pick a pixel color" - ImageList.ListImages.Item(TOOL_LITPICKER + 1).Tag = "Pick a Lit Vertex Color" - ImageList.ListImages.Item(TOOL_ERASER + 1).Tag = "Erase Lines" - ImageList.ListImages.Item(TOOL_SMUDGE + 1).Tag = "Move Lines" - - Exit Sub - -ErrorHandler: - - MsgBox "Error loading cursors" & vbNewLine & Error$ - -End Sub - -Public Sub initGfx() - - Dim i As Integer - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_main.bmp") - - picGfx.Picture = LoadPicture(appPath & "\" & gfxDir & "\tool_gfx.bmp") - picButtonGfx.Picture = LoadPicture(appPath & "\" & gfxDir & "\button_gfx.bmp") - - 'draw control box buttons - mouseEvent2 picExit, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picMaximize, 0, 0, BUTTON_SMALL, (Me.WindowState = 0), BUTTON_UP - mouseEvent2 picMinimize, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - mouseEvent2 picHelp, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - - 'draw menu buttons - For i = 0 To 4 - mouseEvent2 picMenu(i), 0, 0, BUTTON_MENU, 0, BUTTON_UP - Next - -End Sub - -Private Sub centerView() - - Dim i As Integer - - If polyCount > 0 Then - For i = 1 To polyCount - Polys(i).vertex(1).X = (PolyCoords(i).vertex(1).X - scrollCoords(2).X) * zoomFactor - Polys(i).vertex(1).Y = (PolyCoords(i).vertex(1).Y - scrollCoords(2).Y) * zoomFactor - Polys(i).vertex(2).X = (PolyCoords(i).vertex(2).X - scrollCoords(2).X) * zoomFactor - Polys(i).vertex(2).Y = (PolyCoords(i).vertex(2).Y - scrollCoords(2).Y) * zoomFactor - Polys(i).vertex(3).X = (PolyCoords(i).vertex(3).X - scrollCoords(2).X) * zoomFactor - Polys(i).vertex(3).Y = (PolyCoords(i).vertex(3).Y - scrollCoords(2).Y) * zoomFactor - Next - End If - - For i = 1 To 4 - bgPolys(i).X = bgPolyCoords(i).X - scrollCoords(2).X * zoomFactor - bgPolys(i).Y = bgPolyCoords(i).Y - scrollCoords(2).Y * zoomFactor - Next - -End Sub - -Public Sub Init() - - On Error GoTo ErrorHandler - - initialized = False - noRedraw = False - selectionChanged = False - - Dim DispMode As D3DDISPLAYMODE - Dim D3DWindow As D3DPRESENT_PARAMETERS - Dim debugVal As String - - debugVal = "Error creating Direct3D objects" - - If Not initialized2 Then - Set D3DX = New D3DX8 - Set DX = New DirectX8 - Set D3D = DX.Direct3DCreate() - initialized2 = True - End If - - debugVal = "Error getting display mode" - - D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode - D3DWindow.Windowed = 1 - D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY - D3DWindow.BackBufferFormat = D3DFMT_A8R8G8B8 - - debugVal = "Error creating D3D device" - - Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3DWindow) 'Main screen turn on. - - debugVal = "Error setting render states" - - D3DDevice.SetVertexShader FVF - D3DDevice.SetRenderState D3DRS_LIGHTING, False - - D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE 'polys that are ccw - - D3DDevice.SetRenderState D3DRS_POINTSPRITE_ENABLE, 1 - D3DDevice.SetRenderState D3DRS_POINTSCALE_ENABLE, 1 - D3DDevice.SetRenderState D3DRS_POINTSIZE, FtoDW(particleSize) - - D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE - D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TEXTURE - D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAARG2, D3DTA_DIFFUSE - - Set renderTarget = D3DX.CreateTexture(D3DDevice, 256, 256, D3DX_DEFAULT, D3DUSAGE_RENDERTARGET, D3DFMT_A8R8G8B8, D3DPOOL_DEFAULT) - Set renderSurface = renderTarget.GetSurfaceLevel(0) - Set backBuffer = D3DDevice.GetBackBuffer(0, D3DBACKBUFFER_TYPE_MONO) - - debugVal = "Error creating pattern texture" - - Set patternTexture = D3DX.CreateTextureFromFile(D3DDevice, appPath & "\" & gfxDir & "\pattern.bmp") - - debugVal = "Error creating objects texture" - - '---- - Set objectsTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\objects.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, _ - D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) - - objectsTexture.GetLevelDesc 0, textureDesc - - objTexSize.X = textureDesc.Width - objTexSize.Y = textureDesc.Height - - '---- - - debugVal = "Error creating scenery not found texture" - - Set SceneryTextures(0).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) - - SceneryTextures(0).Texture.GetLevelDesc 0, textureDesc - - SceneryTextures(0).Width = imageInfo.Width - SceneryTextures(0).Height = imageInfo.Height - - SceneryTextures(0).reScale.X = SceneryTextures(0).Width / textureDesc.Width - SceneryTextures(0).reScale.Y = SceneryTextures(0).Height / textureDesc.Height - - If SceneryTextures(0).reScale.X = 0 Or SceneryTextures(0).reScale.Y = 0 Then - SceneryTextures(0).reScale.X = 1 - SceneryTextures(0).reScale.Y = 1 - End If - - debugVal = "Error creating line texture" - - Set lineTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\lines.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) - - debugVal = "Error creating path texture" - - Set pathTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\path.png", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) - - debugVal = "Error creating rotation center texture" - - Set rCenterTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\rcenter.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) - - debugVal = "Error creating sketch texture" - - Set sketchTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\sketch.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) - - debugVal = "Error creating scenery sprite" - - Set scenerySprite = D3DX.CreateSprite(D3DDevice) - - debugVal = "Error creating particle texture" - - Set particleTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\vertex8x8.bmp", 8, 8, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) - - initialized = True - - Exit Sub - -ErrorHandler: - - If D3DX Is Nothing Then - MsgBox "Direct3D initialization failed" & vbNewLine & debugVal & vbNewLine & Error$ - Else - MsgBox "Direct3D initialization failed" & vbNewLine & D3DX.GetErrorString(err.Number) & vbNewLine & debugVal - End If - -End Sub - -Private Sub InitDInput() - - On Error GoTo ErrorHandler - - Dim tehValue As String - - Dim i As Long - Dim DevProp As DIPROPLONG - Dim DevInfo As DirectInputDeviceInstance8 - Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA - - tehValue = "Error creating DI device" - - Set DI = DX.DirectInputCreate - Set DIDevice = DI.CreateDevice("GUID_SysKeyboard") - - tehValue = "Error setting DI device" - - DIDevice.SetCommonDataFormat DIFORMAT_KEYBOARD - DIDevice.SetCooperativeLevel Me.hWnd, DISCL_NONEXCLUSIVE Or DISCL_FOREGROUND - - tehValue = "Error setting DI properties" - - DevProp.lHow = DIPH_DEVICE - DevProp.lData = BufferSize - DIDevice.SetProperty DIPROP_BUFFERSIZE, DevProp - - tehValue = "Error setting DI device notification" - - hEvent = DX.CreateEvent(Me) - DIDevice.SetEventNotification hEvent - - tehValue = "Error getting device info" - - Set DevInfo = DIDevice.GetDeviceInfo() - - tehValue = "Error acquiring device" - - Me.SetFocus - DIDevice.Acquire - acquired = True - - Exit Sub - -ErrorHandler: - - If tehValue <> "Error acquiring device" Then - MsgBox "DirectInput initialization failed" & vbNewLine & D3DX.GetErrorString(err.Number) & vbNewLine & tehValue - End If - -End Sub - -Public Sub resetDevice() - - On Error GoTo ErrorHandler - - Dim DispMode As D3DDISPLAYMODE - Dim D3DWindow As D3DPRESENT_PARAMETERS - Dim i As Integer - - D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode - - D3DWindow.Windowed = 1 - D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY - D3DWindow.BackBufferFormat = D3DFMT_A8R8G8B8 - - noRedraw = True - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - SaveUndo - mnuSelectAll_Click - deletePolys - - Set mapTexture = Nothing - Set particleTexture = Nothing - Set patternTexture = Nothing - Set sketchTexture = Nothing - Set lineTexture = Nothing - Set pathTexture = Nothing - Set rCenterTexture = Nothing - Set D3DDevice = Nothing - Init - For i = 1 To frmScenery.lstScenery.ListCount - RefreshSceneryTextures i - Next - - setMapTexture textureFile - - D3DDevice.SetVertexShader FVF - D3DDevice.SetRenderState D3DRS_LIGHTING, False - D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE 'polys that are ccwise - - D3DDevice.SetRenderState D3DRS_POINTSPRITE_ENABLE, 1 - D3DDevice.SetRenderState D3DRS_POINTSCALE_ENABLE, 1 - D3DDevice.SetRenderState D3DRS_POINTSIZE, FtoDW(particleSize) - - D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE - D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TEXTURE - D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAARG2, D3DTA_DIFFUSE - - initGrid - - initialized = True - - loadUndo False - loadUndo False - - noRedraw = False - - Render - - Exit Sub - -ErrorHandler: - - MsgBox "Error resetting device" & vbNewLine & D3DX.GetErrorString(err.Number) - -End Sub - -Public Sub RegainFocus() - - On Error Resume Next - - Me.SetFocus - DIDevice.Acquire - acquired = True - ctrlDown = False - altDown = False - shiftDown = False - SetCursor currentFunction + 1 - -End Sub - -Public Sub newMap() - - Dim i As Integer - - On Error GoTo ErrorHandler - - prompt = False - - Version = 11 - - commonDialog.FileName = "" - - numVerts = 0 - toolAction = False - - mapTitle = "New Soldat Map" - - Options.BackgroundColor = ARGB(255, RGB(224, 224, 224)) - Options.BackgroundColor2 = ARGB(255, RGB(32, 32, 32)) - - Options.textureName(0) = 0 - Options.MapRandomID = 0 - Options.GrenadePacks = 5 - Options.Medikits = 5 - Options.StartJet = 190 - Options.Steps = 0 - Options.Weather = 0 - - numSelectedPolys = 0 - ReDim selectedPolys(0) - ReDim vertexList(0) - - polyCount = 0 - ReDim Polys(0) - ReDim vertexList(0) - ReDim PolyCoords(0) - - sceneryCount = 0 - ReDim Scenery(0) - sceneryElements = 0 - ReDim Preserve SceneryTextures(0) - frmScenery.lstScenery.Clear - setCurrentScenery 0 - tvwScenery.Nodes.Remove "In Use" - tvwScenery.Nodes.Add "Master List", tvwFirst, "In Use", "In Use" - - spawnPoints = 0 - colliderCount = 0 - ReDim Spawns(0) - ReDim Colliders(0) - Colliders(0).radius = clrRadius - - waypointCount = 0 - ReDim Waypoints(0) - conCount = 0 - ReDim Connections(0) - - lightCount = 0 - ReDim Lights(0) - - sketchLines = 0 - ReDim Preserve sketch(0) - - bgColors(1) = makeColor(224, 224, 224) - bgColors(2) = makeColor(32, 32, 32) - - maxX = 0 - maxY = 0 - minX = 0 - minY = 0 - - bgPolys(1) = CreateCustomVertex(-640, -640, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 0, 0) - bgPolys(2) = CreateCustomVertex(-640, 640, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 0, 0) - bgPolys(3) = CreateCustomVertex(640, -640, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 0, 0) - bgPolys(4) = CreateCustomVertex(640, 640, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 0, 0) - - For i = 1 To 4 - bgPolyCoords(i).X = bgPolys(i).X - bgPolyCoords(i).Y = bgPolys(i).Y - Next - - scrollCoords(1).X = 0 - scrollCoords(1).Y = 0 - scrollCoords(2).X = -Me.ScaleWidth / 2 - 1 - scrollCoords(2).Y = -Me.ScaleHeight / 2 - 1 - zoomFactor = 1 - - setMapData - - txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" - - If Len(Dir(soldatDir & "Textures\" & textureFile)) <> 0 Then - setMapTexture textureFile - frmTexture.setTexture textureFile - Else - Set mapTexture = Nothing - End If - - currentFileName = "Untitled.pms" - lblFileName.Caption = "Untitled.pms" - - centerView - - numUndo = 0 - numRedo = 0 - currentUndo = 0 - SaveUndo - - Render - - Exit Sub - -ErrorHandler: - - MsgBox "error creating new file" & vbNewLine & Error$ - -End Sub - -Public Sub LoadFile(FileName As String) - - On Error GoTo ErrorHandler - - Dim errorVal As String - Dim fileOpen As Boolean - - Dim i As Integer, j As Integer, k As Integer - Dim temp As Long, tempString As String - - Dim polyIndex As Integer - Dim polysInSector As Integer - - Const SECTOR_NUM As Long = 25 - - Dim Scenery_New As TMapFile_Scenery - Dim newWaypoint As TNewWaypoint - Dim Prop As TProp - Dim spawn As TSaveSpawnPoint - - Dim toTGARes As Long - - prompt = False - - scrollCoords(1).X = 0 - scrollCoords(1).Y = 0 - scrollCoords(2).X = -Me.ScaleWidth / 2 - scrollCoords(2).Y = -Me.ScaleHeight / 2 - zoomFactor = 1 - toolAction = False - numVerts = 0 - - sceneryCount = 0 - sceneryElements = 0 - frmScenery.lstScenery.Clear - tvwScenery.Nodes.Remove "In Use" - tvwScenery.Nodes.Add "Master List", tvwFirst, "In Use", "In Use" - numSelectedPolys = 0 - ReDim selectedPolys(numSelectedPolys) - - currentFileName = "" - For i = 0 To Len(FileName) - 1 - If mid(FileName, Len(FileName) - i, 1) <> "\" Then - currentFileName = mid(FileName, Len(FileName) - i, 1) + currentFileName - Else - Exit For - End If - Next - - lblFileName.Caption = currentFileName - - Open FileName For Binary Access Read Lock Read As #1 - - fileOpen = True - errorVal = "Error loading polys" - - maxX = 0 - maxY = 0 - minX = 0 - minY = 0 - - Get #1, , Version - Get #1, , Options - Get #1, , polyCount - ReDim Polys(0 To polyCount) - ReDim PolyCoords(0 To polyCount) - ReDim vertexList(0 To polyCount) - - For i = 1 To polyCount - Get #1, , Polys(i) - Get #1, , vertexList(i).polyType - - For j = 1 To 3 - PolyCoords(i).vertex(j).X = Polys(i).vertex(j).X - PolyCoords(i).vertex(j).Y = Polys(i).vertex(j).Y - vertexList(i).color(j) = getRGB(Polys(i).vertex(j).Color) - If PolyCoords(i).vertex(j).X > maxX Then maxX = PolyCoords(i).vertex(j).X - If PolyCoords(i).vertex(j).X < minX Then minX = PolyCoords(i).vertex(j).X - If PolyCoords(i).vertex(j).Y > maxY Then maxY = PolyCoords(i).vertex(j).Y - If PolyCoords(i).vertex(j).Y < minY Then minY = PolyCoords(i).vertex(j).Y - Polys(i).Perp.vertex(j).z = Sqr(Polys(i).Perp.vertex(j).X ^ 2 + Polys(i).Perp.vertex(j).Y ^ 2) - Next - Next - - Get #1, , temp 'sectorsdivision - Get #1, , temp 'num sectors - - For i = -SECTOR_NUM To SECTOR_NUM - For j = -SECTOR_NUM To SECTOR_NUM - Get #1, , polysInSector 'number of polys in sector - For k = 1 To polysInSector 'for each poly in sector - Get #1, , polyIndex 'load and discard poly index - Next - Next - Next - - errorVal = "Error loading scenery" - - Get #1, , sceneryCount - - ReDim Scenery(sceneryCount) - - If sceneryCount > 0 Then - - Dim offset As Integer - offset = 0 - - For i = 1 To sceneryCount - Get #1, , Prop - - If Prop.X > 32766 Or Prop.X < -32766 Or Prop.Y > 32766 Or Prop.Y < -32766 Then - offset = offset + 1 - ElseIf Prop.Width < 0 Or Prop.Height < 0 Or Int(Prop.ScaleX * 1000) = 0 Or Int(Prop.ScaleY * 1000) = 0 Then - offset = offset + 1 - ElseIf Prop.ScaleX < -10000 Or Prop.ScaleX > 10000 Or Prop.ScaleY < -10000 Or Prop.ScaleY > 10000 Then - offset = offset + 1 - ElseIf Prop.Style < 1 Then - offset = offset + 1 - Else - Scenery(i - offset).Style = Prop.Style - Scenery(i - offset).Translation.X = Prop.X - Scenery(i - offset).Translation.Y = Prop.Y - Scenery(i - offset).screenTr.X = (Prop.X - scrollCoords(2).X) * zoomFactor - Scenery(i - offset).screenTr.Y = (Prop.Y - scrollCoords(2).Y) * zoomFactor - Scenery(i - offset).rotation = Prop.rotation - Scenery(i - offset).Scaling.X = Prop.ScaleX - Scenery(i - offset).Scaling.Y = Prop.ScaleY - If Prop.alpha < 1 Then - Scenery(i - offset).alpha = 255 - ElseIf Prop.alpha <= 255 Then - Scenery(i - offset).alpha = Prop.alpha - Else - Scenery(i - offset).alpha = 255 - End If - Scenery(i - offset).Color = Prop.Color - If Prop.level <= 255 And Prop.level >= 0 Then - Scenery(i - offset).level = Prop.level - Else - Scenery(i - offset).level = 0 - End If - Scenery(i - offset).Color = ARGB(Scenery(i - offset).alpha, Scenery(i - offset).Color) - End If - - Next - - sceneryCount = sceneryCount - offset - - End If - - ReDim Preserve Scenery(sceneryCount) - - errorVal = "Error loading scenery elements" - - offset = 0 - - Get #1, , sceneryElements - - ReDim Preserve SceneryTextures(sceneryElements) - - Dim scenIndex As Integer - Dim firstOccurence As Integer - - If sceneryElements > 0 And sceneryElements < 500 Then - - For i = 1 To sceneryElements - - tempString = "" - - Get #1, , Scenery_New - - For j = 1 To Scenery_New.sceneryName(0) - tempString = tempString & Chr$(Scenery_New.sceneryName(j)) - Next - - Dim loadName As String - - If tempString = "" Then - Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - frmScenery.lstScenery.AddItem tempString - tvwScenery.Nodes.Add "In Use", tvwChild, tempString, tempString - ElseIf checkLoaded(tempString) > -1 Then - - loadName = soldatDir & "Scenery-gfx\" & tempString - toTGARes = GifToBmp(loadName, appPath & "\Temp\gif.tga") - If right$(loadName, 4) = ".gif" Then - loadName = appPath & "\Temp\gif.tga" - End If - - If toTGARes = -1 Then - Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - Else - Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - End If - - frmScenery.lstScenery.AddItem tempString - tvwScenery.Nodes.Add "In Use", tvwChild, , tempString - ElseIf confirmExists(tempString) Then 'if scenery texture is in master list - - loadName = soldatDir & "Scenery-gfx\" & tempString - toTGARes = GifToBmp(loadName, appPath & "\Temp\gif.tga") - If right$(loadName, 4) = ".gif" Then - loadName = appPath & "\Temp\gif.tga" - End If - - If toTGARes = -1 Then - Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - Else - Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - End If - frmScenery.lstScenery.AddItem tempString - tvwScenery.Nodes.Add "In Use", tvwChild, tempString, tempString - Else - Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - frmScenery.lstScenery.AddItem tempString - tvwScenery.Nodes.Add "In Use", tvwChild, tempString, tempString - End If - - SceneryTextures(i).Texture.GetLevelDesc 0, textureDesc - - SceneryTextures(i).Width = imageInfo.Width - SceneryTextures(i).Height = imageInfo.Height - SceneryTextures(i).reScale.X = SceneryTextures(i).Width / textureDesc.Width - SceneryTextures(i).reScale.Y = SceneryTextures(i).Height / textureDesc.Height - - If SceneryTextures(i).reScale.X = 0 Or SceneryTextures(i).reScale.Y = 0 Then - SceneryTextures(i).reScale.X = 1 - SceneryTextures(i).reScale.Y = 1 - End If - - Next - - For i = 1 To sceneryCount - If Scenery(i).Style > sceneryElements Then - Scenery(i).Style = sceneryElements - ElseIf Scenery(i).Style < 1 Then - Scenery(i).Style = 1 - End If - Next - - ElseIf sceneryElements <> 0 Then - 'if we got to this point it means that scenery were loaded but scenery elements are borked - 'or scenery are borked too - - sceneryElements = 0 - For i = 1 To sceneryCount - Scenery(i).Style = 0 - Next - GoTo ErrorHandler - - End If - - errorVal = "Error loading colliders" - - Get #1, , colliderCount - - ReDim Colliders(colliderCount) - - For i = 1 To colliderCount - Get #1, , Colliders(i) - Colliders(i).active = 0 - Next - - errorVal = "Error loading spawn points" - - Get #1, , spawnPoints - ReDim Spawns(spawnPoints) - - For i = 1 To spawnPoints - Get #1, , spawn - Spawns(i).X = spawn.X - Spawns(i).Y = spawn.Y - Spawns(i).Team = spawn.Team - If Spawns(i).Team > 31 Then Spawns(i).Team = 31 - Spawns(i).active = 0 - Next - - errorVal = "Error loading waypoints" - - Get #1, , waypointCount - ReDim Waypoints(waypointCount) - conCount = 0 - ReDim Connections(conCount) - - For i = 1 To waypointCount - Get #1, , newWaypoint - Waypoints(i).tempIndex = i - Waypoints(i).pathNum = newWaypoint.pathNum - If newWaypoint.connectionsNum >= 0 Then - Waypoints(i).numConnections = newWaypoint.connectionsNum - Else - Waypoints(i).numConnections = 0 - End If - Waypoints(i).special = newWaypoint.special - Waypoints(i).X = newWaypoint.X - Waypoints(i).Y = newWaypoint.Y - Waypoints(i).wayType(0) = CBool(newWaypoint.left) - Waypoints(i).wayType(1) = CBool(newWaypoint.right) - Waypoints(i).wayType(2) = CBool(newWaypoint.up) - Waypoints(i).wayType(3) = CBool(newWaypoint.down) - Waypoints(i).wayType(4) = CBool(newWaypoint.m2) - If newWaypoint.connectionsNum > 0 And newWaypoint.connectionsNum <= 20 Then - conCount = conCount + newWaypoint.connectionsNum - ReDim Preserve Connections(conCount) - For j = 1 To newWaypoint.connectionsNum - Connections(conCount - newWaypoint.connectionsNum + j).point1 = i - Connections(conCount - newWaypoint.connectionsNum + j).point2 = newWaypoint.Connections(j) - Next - End If - Next - - If Options.MapRandomID < 0 Then - - Get #1, , lightCount - ReDim Lights(lightCount) - - For i = 1 To lightCount - Get #1, , Lights(i) - Next - - Get #1, , sketchLines - ReDim Preserve sketch(sketchLines) - - For i = 1 To sketchLines - Get #1, , sketch(i) - Next - - Else - lightCount = 0 - ReDim Lights(lightCount) - sketchLines = 0 - ReDim Preserve sketch(sketchLines) - End If - - Close #1 - - errorVal = "Error reloading scenery" - - fileOpen = False - - errorVal = "Error setting map data" - - setCurrentScenery 0 - If sceneryElements > 0 Then - frmScenery.lstScenery.ListIndex = 0 - End If - - 'get map title and texture - mapTitle = "" - For i = 1 To Options.mapName(0) - mapTitle = mapTitle + Chr$(Options.mapName(i)) - Next - textureFile = "" - For i = 1 To Options.textureName(0) - textureFile = textureFile + Chr$(Options.textureName(i)) - Next - - mapTitle = "" - For i = 1 To Options.mapName(0) - mapTitle = mapTitle + Chr$(Options.mapName(i)) - Next - - 'get background colors - bgColors(1) = getRGB(Options.BackgroundColor) - bgColors(2) = getRGB(Options.BackgroundColor2) - - 'set background poly colors - bgPolys(1) = CreateCustomVertex(-maxX - 640, -maxX - 640, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 0, 0) - bgPolys(2) = CreateCustomVertex(-maxX, maxX, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 0, 1) - bgPolys(3) = CreateCustomVertex(maxX, -maxX, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 1, 0) - bgPolys(4) = CreateCustomVertex(maxX, maxX, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 1, 1) - - If (maxX - minX) > (maxY - minY) Then - bgPolys(1).X = minX - 640 - bgPolys(1).Y = Midpoint(maxY, minY) - ((maxX - minX) / 2) - 640 - bgPolys(2).X = minX - 640 - bgPolys(2).Y = Midpoint(maxY, minY) + ((maxX - minX) / 2) + 640 - bgPolys(3).X = maxX + 640 - bgPolys(3).Y = Midpoint(maxY, minY) - ((maxX - minX) / 2) - 640 - bgPolys(4).X = maxX + 640 - bgPolys(4).Y = Midpoint(maxY, minY) + ((maxX - minX) / 2) + 640 - Else - bgPolys(1).X = Midpoint(maxX, minX) - ((maxY - minY) / 2) - 640 - bgPolys(1).Y = minY - 640 - bgPolys(2).X = Midpoint(maxX, minX) - ((maxY - minY) / 2) - 640 - bgPolys(2).Y = maxY + 640 - bgPolys(3).X = Midpoint(maxX, minX) + ((maxY - minY) / 2) + 640 - bgPolys(3).Y = minY - 640 - bgPolys(4).X = Midpoint(maxX, minX) + ((maxY - minY) / 2) + 640 - bgPolys(4).Y = maxY + 640 - End If - - For i = 1 To 4 - bgPolyCoords(i).X = bgPolys(i).X - bgPolyCoords(i).Y = bgPolys(i).Y - Next - - If Len(Dir$(soldatDir & "textures\" & textureFile)) <> 0 Then - setMapTexture textureFile - frmTexture.setTexture textureFile - End If - - Colliders(0).radius = clrRadius - - setMapData - txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" - - centerView - - numUndo = 0 - numRedo = 0 - currentUndo = 0 - - If lightCount > 0 Then - frmDisplay.setLayer 9, showLights - applyLights - End If - - SaveUndo - - Render - - Exit Sub - -ErrorHandler: - - MsgBox "error loading map" & vbNewLine & Error$ & vbNewLine & errorVal - If fileOpen Then Close #1 - noRedraw = False - -End Sub - -Private Function checkLoaded(sceneryName As String) As Integer - - Dim i As Integer - - On Error GoTo ErrorHandler - - checkLoaded = -1 - - For i = 0 To frmScenery.lstScenery.ListCount - 1 - If frmScenery.lstScenery.List(i) = sceneryName Then checkLoaded = i - Next - - Exit Function - -ErrorHandler: - - MsgBox "error checking loaded scenery" & vbNewLine & Error$ - -End Function - -Private Function getMapDimensions() As String - - getMapDimensions = Int(maxX - minX) & "x" & Int(maxY - minY) - -End Function - -Private Function getMapArea() As Long - - Dim i As Integer - Dim area As Double - Dim a As Single, b As Single - Dim c As Single - Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single - - For i = 1 To polyCount - If vertexList(i).polyType <> 3 Then - x1 = (PolyCoords(i).vertex(3).X - PolyCoords(i).vertex(2).X) - y1 = (PolyCoords(i).vertex(3).Y - PolyCoords(i).vertex(2).Y) - x2 = (PolyCoords(i).vertex(1).X - PolyCoords(i).vertex(3).X) - y2 = (PolyCoords(i).vertex(1).Y - PolyCoords(i).vertex(3).Y) - a = Sqr(x1 ^ 2 + y1 ^ 2) - b = Sqr(x2 ^ 2 + y2 ^ 2) - c = GetAngle(x1, y1) - GetAngle(x2, y2) - area = area + (a * b * Sin(c) / 2) - End If - Next - - MsgBox Int(area / ((maxX - minX) * (maxY - minY)) * 100 + 0.5) & "%" - -End Function - -Public Sub setMapData() - - frmInfo.lblCount(0).Caption = polyCount - frmInfo.lblCount(1).Caption = sceneryCount & "/500 (" & sceneryElements & ")" - frmInfo.lblCount(2).Caption = spawnPoints & "/128" - frmInfo.lblCount(3).Caption = colliderCount & "/128" - frmInfo.lblCount(4).Caption = waypointCount & "/500" - frmInfo.lblCount(5).Caption = conCount - frmInfo.lblCount(6).Caption = getMapDimensions - -End Sub - -Public Sub setCurrentScenery(Optional styleVal As Integer = -1, Optional sceneryName As String = "") - - On Error GoTo ErrorHandler - - If styleVal > -1 Then - Scenery(0).Style = styleVal - End If - - If sceneryName <> "" Then - currentScenery = sceneryName - End If - - Scenery(0).alpha = opacity * 255 - Scenery(0).Color = ARGB(opacity * 255, RGB(polyClr.blue, polyClr.green, polyClr.red)) - Scenery(0).level = frmScenery.level - Scenery(0).Scaling.X = 1 - Scenery(0).Scaling.Y = 1 - Scenery(0).screenTr.X = mouseCoords.X - Scenery(0).screenTr.Y = mouseCoords.Y - Scenery(0).rotation = 0 - - Exit Sub - -ErrorHandler: - - MsgBox "Error setting current scenery" & vbNewLine & Error$ - -End Sub - -Public Sub setCurrentTexture(sceneryName As String) - - On Error GoTo ErrorHandler - - Dim loadName As String - Dim toTGARes As Long - - loadName = soldatDir & "Scenery-gfx\" & sceneryName - toTGARes = GifToBmp(loadName, appPath & "\Temp\gif.tga") - If right$(loadName, 4) = ".gif" Then - loadName = appPath & "\Temp\gif.tga" - End If - - If toTGARes = -1 Then - Set SceneryTextures(0).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - Else - Set SceneryTextures(0).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - End If - - SceneryTextures(0).Texture.GetLevelDesc 0, textureDesc - - SceneryTextures(0).Width = imageInfo.Width - SceneryTextures(0).Height = imageInfo.Height - - SceneryTextures(0).reScale.X = SceneryTextures(0).Width / textureDesc.Width - SceneryTextures(0).reScale.Y = SceneryTextures(0).Height / textureDesc.Height - - If SceneryTextures(0).reScale.X = 0 Or SceneryTextures(0).reScale.Y = 0 Then - SceneryTextures(0).reScale.X = 1 - SceneryTextures(0).reScale.Y = 1 - End If - - setCurrentScenery 0 - Scenery(0).Style = 0 - - Exit Sub - -ErrorHandler: - - MsgBox "Error creating current scenery texture" & vbNewLine & Error$ - -End Sub - -Public Sub setSceneryLevel(ByVal level As Byte) - - Scenery(0).level = level - -End Sub - -Public Sub CreateSceneryTexture(sceneryName As String) - - On Error GoTo ErrorHandler - - sceneryElements = sceneryElements + 1 - ReDim Preserve SceneryTextures(sceneryElements) - - Dim loadName As String - Dim toTGARes As Long - - loadName = soldatDir & "Scenery-gfx\" & sceneryName - toTGARes = GifToBmp(loadName, appPath & "\Temp\gif.tga") - If right$(loadName, 4) = ".gif" Then - loadName = appPath & "\Temp\gif.tga" - End If - - If toTGARes = -1 Then - Set SceneryTextures(sceneryElements).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - Else - Set SceneryTextures(sceneryElements).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - End If - - frmScenery.lstScenery.AddItem sceneryName - tvwScenery.Nodes.Add "In Use", tvwChild, sceneryName, sceneryName - - SceneryTextures(sceneryElements).Texture.GetLevelDesc 0, textureDesc - - SceneryTextures(sceneryElements).Width = imageInfo.Width - SceneryTextures(sceneryElements).Height = imageInfo.Height - - SceneryTextures(sceneryElements).reScale.X = SceneryTextures(sceneryElements).Width / textureDesc.Width - SceneryTextures(sceneryElements).reScale.Y = SceneryTextures(sceneryElements).Height / textureDesc.Height - - If SceneryTextures(sceneryElements).reScale.X = 0 Or SceneryTextures(sceneryElements).reScale.Y = 0 Then - SceneryTextures(sceneryElements).reScale.X = 1 - SceneryTextures(sceneryElements).reScale.Y = 1 - End If - - Exit Sub - -ErrorHandler: - - MsgBox "Error creating scenery texture: " & sceneryName & vbNewLine & Error$ - SceneryTextures(sceneryElements) = SceneryTextures(0) - -End Sub - -Public Sub RefreshSceneryTextures(Index As Integer) - - If frmScenery.lstScenery.ListCount = 0 Then Exit Sub - - Dim sceneryName As String - Dim scenNum As Integer - - sceneryName = frmScenery.lstScenery.List(Index - 1) - - Dim loadName As String - Dim toTGARes As Long - - loadName = soldatDir & "Scenery-gfx\" & sceneryName - toTGARes = GifToBmp(loadName, appPath & "\Temp\gif.tga") - If right$(loadName, 4) = ".gif" Then - loadName = appPath & "\Temp\gif.tga" - End If - - If toTGARes = -1 Then - Set SceneryTextures(Index).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - Else - Set SceneryTextures(Index).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ - D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) - End If - - SceneryTextures(Index).Texture.GetLevelDesc 0, textureDesc - - SceneryTextures(Index).Width = imageInfo.Width - SceneryTextures(Index).Height = imageInfo.Height - - SceneryTextures(Index).reScale.X = SceneryTextures(Index).Width / textureDesc.Width - SceneryTextures(Index).reScale.Y = SceneryTextures(Index).Height / textureDesc.Height - - If SceneryTextures(Index).reScale.X = 0 Or SceneryTextures(Index).reScale.Y = 0 Then - SceneryTextures(Index).reScale.X = 1 - SceneryTextures(Index).reScale.Y = 1 - End If - -End Sub - -Private Sub SaveFile(FileName As String) - - Dim i As Integer, j As Integer, k As Integer - Dim X As Integer, Y As Integer - - Dim xOffset As Integer, yOffset As Integer - - Dim xDiff As Single, yDiff As Single - Dim length As Single - Dim VertNum As Byte - Dim mapWidth As Long, mapHeight As Long - - Const SECTOR_NUM As Long = 25 - - Dim Polygon As TMapFile_Polygon - Dim sectorsDivision As Long - - Const zero As Integer = 0 - - Dim Scenery_New As TMapFile_Scenery - Dim newWaypoint As TNewWaypoint - Dim sceneryName As String - Dim Prop As TProp - Dim spawn As TSaveSpawnPoint - Dim tempClr As TColor - Dim connectedNum As Integer - - Dim fileOpen As Boolean - - Me.MousePointer = 11 - - 'refresh background - mnuRefreshBG_Click - - mapWidth = maxX - minX - mapHeight = maxY - minY - - Options.BackgroundColor = ARGB(255, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red)) - Options.BackgroundColor2 = ARGB(255, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red)) - 'set texture name - Options.textureName(0) = Len(textureFile) - For i = 1 To Len(textureFile) - Options.textureName(i) = Asc(mid(textureFile, i, 1)) - Next - 'set map name - Options.mapName(0) = Len(mapTitle) - If Options.mapName(0) > 38 Then Options.mapName(0) = 38 - For i = 1 To Options.mapName(0) - Options.mapName(i) = Asc(mid(mapTitle, i, 1)) - Next - - Options.MapRandomID = -1 - - If mapWidth > mapHeight Then - sectorsDivision = Int((mapWidth + 100) / 25) - Else - sectorsDivision = Int((mapHeight + 100) / 25) - End If - - Open FileName For Binary Access Write Lock Write As #1 - - fileOpen = True - - Put #1, , Version - Put #1, , Options - - 'save polys - Put #1, , polyCount - For i = 1 To polyCount - - Polygon.Poly = Polys(i) - - For j = 1 To 3 - - Polygon.Poly.vertex(j).X = PolyCoords(i).vertex(j).X - Polygon.Poly.vertex(j).Y = PolyCoords(i).vertex(j).Y - - Polygon.Poly.vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) - - VertNum = j + 1 - If VertNum > 3 Then VertNum = 1 - - xDiff = PolyCoords(i).vertex(VertNum).X - PolyCoords(i).vertex(j).X - yDiff = PolyCoords(i).vertex(j).Y - PolyCoords(i).vertex(VertNum).Y - If xDiff = 0 And yDiff = 0 Then - length = 1 - Else - length = Sqr(xDiff ^ 2 + yDiff ^ 2) - End If - Polygon.Poly.Perp.vertex(j).X = (yDiff / length) * Polygon.Poly.Perp.vertex(j).z - Polygon.Poly.Perp.vertex(j).Y = (xDiff / length) * Polygon.Poly.Perp.vertex(j).z - Polygon.Poly.Perp.vertex(j).z = 1 - - Next - - Polygon.polyType = vertexList(i).polyType - - Put #1, , Polygon - - Next - - Put #1, , sectorsDivision - Put #1, , SECTOR_NUM - - For i = -25 To 25 - For j = -25 To 25 - Put #1, , zero - Next - Next - - Put #1, , sceneryCount - - For i = 1 To sceneryCount - Prop.active = True - Prop.alpha = Scenery(i).alpha - tempClr = getRGB(Scenery(i).Color) - Prop.Color = ARGB(255, RGB(tempClr.blue, tempClr.green, tempClr.red)) - Prop.Width = SceneryTextures(Scenery(i).Style).Width - Prop.Height = SceneryTextures(Scenery(i).Style).Height - Prop.level = Scenery(i).level - Prop.rotation = Scenery(i).rotation - Prop.ScaleX = Scenery(i).Scaling.X - Prop.ScaleY = Scenery(i).Scaling.Y - Prop.X = Scenery(i).Translation.X - xOffset - Prop.Y = Scenery(i).Translation.Y - yOffset - Prop.Style = Scenery(i).Style - - Put #1, , Prop - Next - - Put #1, , sceneryElements - - For i = 1 To sceneryElements - sceneryName = frmScenery.lstScenery.List(i - 1) - Scenery_New.sceneryName(0) = Len(sceneryName) - For j = 1 To Scenery_New.sceneryName(0) - Scenery_New.sceneryName(j) = Asc(mid(sceneryName, j, 1)) - Next - Scenery_New.Date = getFileDate(sceneryName) - Put #1, , Scenery_New - Next - - Put #1, , colliderCount - - For i = 1 To colliderCount - Colliders(i).active = 1 - Put #1, , Colliders(i) - Colliders(i).active = 0 - Next - - Put #1, , spawnPoints - - For i = 1 To spawnPoints - spawn.active = 1 - spawn.X = Spawns(i).X - spawn.Y = Spawns(i).Y - spawn.Team = Spawns(i).Team - Put #1, , spawn - Spawns(i).active = 0 - Next - - Put #1, , waypointCount - - For i = 1 To waypointCount - newWaypoint.active = 1 - newWaypoint.X = Waypoints(i).X - newWaypoint.Y = Waypoints(i).Y - newWaypoint.connectionsNum = Waypoints(i).numConnections - If Waypoints(i).wayType(0) Then newWaypoint.left = 1 Else newWaypoint.left = 0 - If Waypoints(i).wayType(1) Then newWaypoint.right = 1 Else newWaypoint.right = 0 - If Waypoints(i).wayType(2) Then newWaypoint.up = 1 Else newWaypoint.up = 0 - If Waypoints(i).wayType(3) Then newWaypoint.down = 1 Else newWaypoint.down = 0 - If Waypoints(i).wayType(4) Then newWaypoint.m2 = 1 Else newWaypoint.m2 = 0 - newWaypoint.id = i - newWaypoint.pathNum = Waypoints(i).pathNum - newWaypoint.special = Waypoints(i).special - connectedNum = 0 - For j = 1 To conCount - If Connections(j).point1 = i And connectedNum < 20 Then - connectedNum = connectedNum + 1 - newWaypoint.Connections(connectedNum) = Connections(j).point2 - End If - Next - Waypoints(i).numConnections = connectedNum - newWaypoint.connectionsNum = connectedNum - Put #1, , newWaypoint - Next - - Put #1, , lightCount - - For i = 1 To lightCount - Put #1, , Lights(i) - Next - - Put #1, , sketchLines - - For i = 1 To sketchLines - Put #1, , sketch(i) - Next - - Close #1 - - fileOpen = False - - currentFileName = "" - For i = 0 To Len(FileName) - 1 - If mid(FileName, Len(FileName) - i, 1) <> "\" Then - currentFileName = mid(FileName, Len(FileName) - i, 1) + currentFileName - Else - Exit For - End If - Next - - lblFileName.Caption = currentFileName - - Me.MousePointer = 99 - - Exit Sub - -ErrorHandler: - - MsgBox "Error saving map" & vbNewLine & Error$ - If fileOpen Then - Close #1 - End If - -End Sub - -Public Sub SaveAndCompile(FileName As String) - - Dim i As Integer, j As Integer, k As Integer - Dim X As Integer, Y As Integer - - Dim xOffset As Integer, yOffset As Integer - - Dim xDiff As Single, yDiff As Single - Dim length As Single - Dim VertNum As Byte - Dim sector(1 To 256) As Integer - Dim xSecNum As Integer, ySecNum As Integer - Dim mapWidth As Integer, mapHeight As Integer - - Const SECTOR_NUM As Long = 25 - - Dim Polygon As TMapFile_Polygon - Dim sectorsDivision As Long - Dim polysInSector As Integer - - Dim Scenery_New As TMapFile_Scenery - Dim newWaypoint As TNewWaypoint - Dim sceneryName As String - Dim Prop As TProp - Dim tempClr As TColor - Dim connectedNum As Integer - - Dim newSpawnPoint As TSaveSpawnPoint - Dim newCollider As TCollider - - Dim zero As Integer - - Dim fileOpen As Boolean - - On Error GoTo ErrorHandler - - zero = 0 - - Me.MousePointer = 11 - - Randomize - - polysInSector = 0 - - newSpawnPoint.active = 1 - newCollider.active = 1 - - 'refresh background - mnuRefreshBG_Click - - 'find offsets to center map - xOffset = Int(Midpoint(maxX, minX)) - yOffset = Int(Midpoint(maxY, minY)) - - mapWidth = maxX - xOffset - mapHeight = maxY - yOffset - - Options.BackgroundColor = ARGB(255, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red)) - Options.BackgroundColor2 = ARGB(255, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red)) - 'set texture name - Options.textureName(0) = Len(textureFile) - If Options.textureName(0) > 24 Then Options.textureName(0) = 24 - For i = 1 To Options.textureName(0) - Options.textureName(i) = Asc(mid(textureFile, i, 1)) - Next - 'set map name - Options.mapName(0) = Len(mapTitle) - If Options.mapName(0) > 38 Then Options.mapName(0) = 38 - For i = 1 To Options.mapName(0) - Options.mapName(i) = Asc(mid(mapTitle, i, 1)) - Next - - 'set map random ID - Options.MapRandomID = (Rnd * 999999) + 10000 - - xSecNum = SECTOR_NUM - ySecNum = SECTOR_NUM - - If mapWidth > mapHeight Then - sectorsDivision = Int((mapWidth + 100) / 25) - ySecNum = (mapHeight + 100) / sectorsDivision - Else - sectorsDivision = Int((mapHeight + 100) / 25) - xSecNum = (mapWidth + 100) / sectorsDivision - End If - - Open FileName For Binary Access Write Lock Write As #1 - - fileOpen = True - - Put #1, , Version - Put #1, , Options - - 'save polys - Put #1, , polyCount - For i = 1 To polyCount - - Polygon.Poly = Polys(i) - Polygon.polyType = vertexList(i).polyType - - Polygon.Poly.vertex(1).X = PolyCoords(i).vertex(1).X - xOffset - Polygon.Poly.vertex(1).Y = PolyCoords(i).vertex(1).Y - yOffset - Polygon.Poly.vertex(2).X = PolyCoords(i).vertex(2).X - xOffset - Polygon.Poly.vertex(2).Y = PolyCoords(i).vertex(2).Y - yOffset - Polygon.Poly.vertex(3).X = PolyCoords(i).vertex(3).X - xOffset - Polygon.Poly.vertex(3).Y = PolyCoords(i).vertex(3).Y - yOffset - - For j = 1 To 3 - - VertNum = j + 1 - If VertNum > 3 Then VertNum = 1 - - xDiff = Polygon.Poly.vertex(VertNum).X - Polygon.Poly.vertex(j).X - yDiff = Polygon.Poly.vertex(j).Y - Polygon.Poly.vertex(VertNum).Y - If xDiff = 0 And yDiff = 0 Then - length = 1 - Else - length = Sqr(xDiff ^ 2 + yDiff ^ 2) - End If - If Polygon.polyType = 18 Then - If Polygon.Poly.Perp.vertex(j).z < 1 Then - Polygon.Poly.Perp.vertex(j).z = 1 - End If - Else - Polygon.Poly.Perp.vertex(j).z = 1 - End If - Polygon.Poly.Perp.vertex(j).X = (yDiff / length) * Polygon.Poly.Perp.vertex(j).z - Polygon.Poly.Perp.vertex(j).Y = (xDiff / length) * Polygon.Poly.Perp.vertex(j).z - Polygon.Poly.Perp.vertex(j).z = 1 - Polygon.Poly.vertex(j).z = 1 - - Next - - Put #1, , Polygon - - Next - - Put #1, , sectorsDivision - Put #1, , SECTOR_NUM - - 'generate sectors - For X = -SECTOR_NUM To SECTOR_NUM - For Y = -SECTOR_NUM To SECTOR_NUM - - polysInSector = 0 - - If X >= -xSecNum And X <= xSecNum And Y >= -ySecNum And Y <= ySecNum Then 'if sectors within range - - For i = 1 To polyCount - If vertexList(i).polyType <> 3 Then - If isInSector(i, sectorsDivision * (X - 0.5) + xOffset - 1, sectorsDivision * (Y - 0.5) + yOffset - 1, sectorsDivision + 2) Then - polysInSector = polysInSector + 1 - If polysInSector > 256 Then - polysInSector = 256 - Else - sector(polysInSector) = i - End If - End If - End If - Next - - If polysInSector > 256 Then polysInSector = 256 - - End If - - Put #1, , polysInSector - - If polysInSector > 0 Then - For k = 1 To polysInSector - Put #1, , sector(k) - Next - End If - - Next - picProgress.Line ((X + SECTOR_NUM) * 2, 0)-((X + SECTOR_NUM) * 2, 12), RGB(61, 75, 97) - picProgress.Line ((X + SECTOR_NUM) * 2 + 1, 0)-((X + SECTOR_NUM) * 2 + 1, 12), RGB(61, 75, 97) - picProgress.Refresh - Next - - picProgress.Cls - - Put #1, , sceneryCount - - For i = 1 To sceneryCount - Prop.active = True - Prop.alpha = Scenery(i).alpha - tempClr = getRGB(Scenery(i).Color) - Prop.Color = ARGB(255, RGB(tempClr.blue, tempClr.green, tempClr.red)) - Prop.Width = SceneryTextures(Scenery(i).Style).Width - Prop.Height = SceneryTextures(Scenery(i).Style).Height - Prop.level = Scenery(i).level - Prop.rotation = Scenery(i).rotation - Prop.ScaleX = Scenery(i).Scaling.X - Prop.ScaleY = Scenery(i).Scaling.Y - Prop.X = Scenery(i).Translation.X - xOffset - Prop.Y = Scenery(i).Translation.Y - yOffset - Prop.Style = Scenery(i).Style - - Put #1, , Prop - Next - - Put #1, , sceneryElements - - For i = 1 To sceneryElements - sceneryName = frmScenery.lstScenery.List(i - 1) - Scenery_New.sceneryName(0) = Len(sceneryName) - For j = 1 To Scenery_New.sceneryName(0) - Scenery_New.sceneryName(j) = Asc(mid(sceneryName, j, 1)) - Next - Scenery_New.Date = getFileDate(sceneryName) - Put #1, , Scenery_New - Next - - Put #1, , colliderCount - - For i = 1 To colliderCount - newCollider.radius = Colliders(i).radius - newCollider.X = Colliders(i).X - xOffset - newCollider.Y = Colliders(i).Y - yOffset - Put #1, , newCollider - Next - - Put #1, , spawnPoints - - For i = 1 To spawnPoints - newSpawnPoint.Team = Spawns(i).Team - newSpawnPoint.X = Spawns(i).X - xOffset - newSpawnPoint.Y = Spawns(i).Y - yOffset - Put #1, , newSpawnPoint - Next - - Put #1, , waypointCount - - For i = 1 To waypointCount - newWaypoint.active = 1 - newWaypoint.X = Waypoints(i).X - xOffset - newWaypoint.Y = Waypoints(i).Y - yOffset - newWaypoint.connectionsNum = Waypoints(i).numConnections - If Waypoints(i).wayType(0) Then newWaypoint.left = 1 Else newWaypoint.left = 0 - If Waypoints(i).wayType(1) Then newWaypoint.right = 1 Else newWaypoint.right = 0 - If Waypoints(i).wayType(2) Then newWaypoint.up = 1 Else newWaypoint.up = 0 - If Waypoints(i).wayType(3) Then newWaypoint.down = 1 Else newWaypoint.down = 0 - If Waypoints(i).wayType(4) Then newWaypoint.m2 = 1 Else newWaypoint.m2 = 0 - newWaypoint.id = i - newWaypoint.pathNum = Waypoints(i).pathNum - newWaypoint.special = Waypoints(i).special - connectedNum = 0 - For j = 1 To conCount - If Connections(j).point1 = i And connectedNum < 20 Then - connectedNum = connectedNum + 1 - newWaypoint.Connections(connectedNum) = Connections(j).point2 - End If - Next - Waypoints(i).numConnections = connectedNum - newWaypoint.connectionsNum = connectedNum - Put #1, , newWaypoint - Next - - Put #1, , zero - Put #1, , zero - Put #1, , zero - Put #1, , zero - - Close #1 - - fileOpen = False - - Me.MousePointer = 99 - SetCursor currentFunction + 1 - - Render - - Exit Sub - -ErrorHandler: - - MsgBox "Error saving/compiling map: " & Error$ - If fileOpen Then - Close #1 - End If - -End Sub - -Private Sub SaveUndo() - - On Error GoTo ErrorHandler - - Dim i As Integer, j As Integer - Dim Polygon As TPolygon - Dim FileName As String - - selectionChanged = False - - numRedo = 0 - numUndo = numUndo + 1 - If numUndo > max_undo Then - numUndo = max_undo - End If - currentUndo = currentUndo + 1 - If currentUndo > max_undo Then - currentUndo = 0 - End If - - FileName = appPath & "\undo\undo" & currentUndo & ".pwn" - - If Len(Dir(appPath & "\undo\")) = 0 Then - MkDir (appPath & "\undo\") - End If - - Open FileName For Binary Access Write Lock Write As #1 - - 'save polys - Put #1, , polyCount - For i = 1 To polyCount - Polygon = Polys(i) - For j = 1 To 3 - Polygon.vertex(j).X = PolyCoords(i).vertex(j).X - Polygon.vertex(j).Y = PolyCoords(i).vertex(j).Y - Next - Put #1, , Polygon - Put #1, , vertexList(i) - Next - - Put #1, , sceneryCount - For i = 1 To sceneryCount - Put #1, , Scenery(i) - Next - - Put #1, , colliderCount - For i = 1 To colliderCount - Put #1, , Colliders(i) - Next - - Put #1, , spawnPoints - For i = 1 To spawnPoints - Put #1, , Spawns(i) - Next - - Put #1, , lightCount - For i = 1 To lightCount - Put #1, , Lights(i) - Next - - Put #1, , waypointCount - For i = 1 To waypointCount - Put #1, , Waypoints(i) - Next - - Put #1, , conCount - For i = 1 To conCount - Put #1, , Connections(i) - Next - - Put #1, , numSelectedPolys - For i = 1 To numSelectedPolys - Put #1, , selectedPolys(i) - Next - - Put #1, , numSelectedScenery - Put #1, , numSelSpawns - Put #1, , numSelColliders - Put #1, , numSelWaypoints - - For i = 0 To 3 - Put #1, , selRect(i) - Next - - Close #1 - - Exit Sub - -ErrorHandler: - - MsgBox "Error saving undo" & vbNewLine & Error$ - -End Sub - -Private Sub loadUndo(redo As Boolean) - - Dim i As Integer, j As Integer - Dim FileName As String - Dim errorVal As String - - On Error GoTo ErrorHandler - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If toolAction = True And numVerts > 0 Then - toolAction = False - numVerts = 0 - Render - Exit Sub - End If - - currentWaypoint = 0 - - If redo Then - If numRedo < 1 Then Exit Sub - currentUndo = currentUndo + 1 - numUndo = numUndo + 1 - numRedo = numRedo - 1 - Else 'undo - If numUndo <= 1 Then Exit Sub - currentUndo = currentUndo - 1 - numUndo = numUndo - 1 - numRedo = numRedo + 1 - End If - If currentUndo < 0 Then - currentUndo = max_undo - ElseIf currentUndo > max_undo Then - currentUndo = 0 - End If - - numSelectedPolys = 0 - ReDim selectedPolys(0) - - FileName = appPath & "\undo\undo" & currentUndo & ".pwn" - - errorVal = "Error opening file" - - Open FileName For Binary Access Read Lock Read As #1 - - errorVal = "Error loading polygons" - - Get #1, , polyCount - ReDim Polys(0 To polyCount) - ReDim PolyCoords(0 To polyCount) - ReDim vertexList(0 To polyCount) - - For i = 1 To polyCount - Get #1, , Polys(i) - Get #1, , vertexList(i) - For j = 1 To 3 - PolyCoords(i).vertex(j).X = Polys(i).vertex(j).X - PolyCoords(i).vertex(j).Y = Polys(i).vertex(j).Y - Polys(i).vertex(j).X = (PolyCoords(i).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(i).vertex(j).Y = (PolyCoords(i).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - Next - Next - - errorVal = "Error loading scenery" - - Get #1, , sceneryCount - ReDim Preserve Scenery(sceneryCount) - If sceneryCount > 0 Then - For i = 1 To sceneryCount - Get #1, , Scenery(i) - Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor - Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor - Next - End If - - errorVal = "Error loading colliders" - - Get #1, , colliderCount - ReDim Preserve Colliders(colliderCount) - For i = 1 To colliderCount - Get #1, , Colliders(i) - Next - - errorVal = "Error loading spawnpoints" - - Get #1, , spawnPoints - ReDim Preserve Spawns(spawnPoints) - For i = 1 To spawnPoints - Get #1, , Spawns(i) - Next - - errorVal = "Error loading lights" - - Get #1, , lightCount - ReDim Preserve Lights(lightCount) - For i = 1 To lightCount - Get #1, , Lights(i) - Next - - errorVal = "Error loading waypoints" - - Get #1, , waypointCount - ReDim Waypoints(waypointCount) - For i = 1 To waypointCount - Get #1, , Waypoints(i) - Next - - errorVal = "Error loading connections" - - Get #1, , conCount - ReDim Connections(conCount) - For i = 1 To conCount - Get #1, , Connections(i) - Next - - errorVal = "Error loading selected polys" - - Get #1, , numSelectedPolys - ReDim selectedPolys(numSelectedPolys) - For i = 1 To numSelectedPolys - Get #1, , selectedPolys(i) - Next - - errorVal = "Error loading selected scenery" - - Get #1, , numSelectedScenery - Get #1, , numSelSpawns - Get #1, , numSelColliders - Get #1, , numSelWaypoints - - For i = 0 To 3 - Get #1, , selRect(i) - Next - - Close #1 - - errorVal = "Error loading undo state" - - setMapData - - getRCenter - - Render - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & errorVal - -End Sub - -Private Function isInSector(Index As Integer, X As Integer, Y As Integer, ByVal div As Long) As Boolean - - On Error GoTo ErrorHandler - - isInSector = False - - 'is poly outside of sector for sure - If (PolyCoords(Index).vertex(1).X < X) And (PolyCoords(Index).vertex(2).X < X) And (PolyCoords(Index).vertex(3).X < X) Then - Exit Function - ElseIf (PolyCoords(Index).vertex(1).X > X + div) And (PolyCoords(Index).vertex(2).X > X + div) And (PolyCoords(Index).vertex(3).X > X + div) Then - Exit Function - ElseIf (PolyCoords(Index).vertex(1).Y < Y) And (PolyCoords(Index).vertex(2).Y < Y) And (PolyCoords(Index).vertex(3).Y < Y) Then - Exit Function - ElseIf (PolyCoords(Index).vertex(1).Y > Y + div) And (PolyCoords(Index).vertex(2).Y > Y + div) And (PolyCoords(Index).vertex(3).Y > Y + div) Then - Exit Function - End If - - 'is vertex in sector - If isBetween(X, PolyCoords(Index).vertex(1).X, X + div) And isBetween(Y, PolyCoords(Index).vertex(1).Y, Y + div) Then - isInSector = True - Exit Function - ElseIf isBetween(X, PolyCoords(Index).vertex(2).X, X + div) And isBetween(Y, PolyCoords(Index).vertex(2).Y, Y + div) Then - isInSector = True - Exit Function - ElseIf isBetween(X, PolyCoords(Index).vertex(3).X, X + div) And isBetween(Y, PolyCoords(Index).vertex(3).Y, Y + div) Then - isInSector = True - Exit Function - End If - - 'check if sector corner is in poly - If Not isInSector Then - If pointInPoly(X, Y, Index) Then - isInSector = True - Exit Function - ElseIf pointInPoly(X + div, Y, Index) Then - isInSector = True - Exit Function - ElseIf pointInPoly(X, Y + div, Index) Then - isInSector = True - Exit Function - ElseIf pointInPoly(X + div, Y + div, Index) Then - isInSector = True - Exit Function - End If - End If - - Dim A1 As D3DVECTOR2 - Dim B1 As D3DVECTOR2 - Dim A2 As D3DVECTOR2 - Dim B2 As D3DVECTOR2 - - Dim indexA1 As Integer - Dim indexB1 As Integer - - For indexA1 = 1 To 3 - indexB1 = indexA1 + 1 - If indexB1 > 3 Then indexB1 = 1 - A1.X = PolyCoords(Index).vertex(indexA1).X - A1.Y = PolyCoords(Index).vertex(indexA1).Y - B1.X = PolyCoords(Index).vertex(indexB1).X - B1.Y = PolyCoords(Index).vertex(indexB1).Y - - A2.X = X - A2.Y = Y - B2.X = X + div - B2.Y = Y - If SegXSeg(A1, B1, A2, B2) Then 'top - isInSector = True - Exit Function - End If - A2.X = X - A2.Y = Y + div - B2.X = X + div - B2.Y = Y + div - If SegXSeg(A1, B1, A2, B2) Then 'bottom - isInSector = True - Exit Function - End If - A2.X = X - A2.Y = Y - B2.X = X - B2.Y = Y + div - If SegXSeg(A1, B1, A2, B2) Then 'left - isInSector = True - Exit Function - End If - A2.X = X + div - A2.Y = Y - B2.X = X + div - B2.Y = Y + div - If SegXSeg(A1, B1, A2, B2) Then 'right - isInSector = True - Exit Function - End If - Next - - Exit Function - -ErrorHandler: - - MsgBox "Sector error, " & Error$ - -End Function - -Private Function isInSector2(Index As Integer, X As Integer, Y As Integer, div As Long) As Integer - - Dim i As Integer, j As Integer - Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer - - Dim VertNum As Byte - - On Error GoTo ErrorHandler - - isInSector2 = False - - For j = 1 To 3 - - VertNum = j + 1 - If VertNum > 3 Then VertNum = 1 - x1 = PolyCoords(Index).vertex(j).X - x2 = PolyCoords(Index).vertex(VertNum).X - y1 = PolyCoords(Index).vertex(j).Y - y2 = PolyCoords(Index).vertex(VertNum).Y - - If segmentsIntersect(x1, y1, x2, y2, X, Y, X + div, Y) Then - isInSector2 = True - ElseIf segmentsIntersect(x1, y1, x2, y2, X, Y, X, Y + div) Then - isInSector2 = True - ElseIf segmentsIntersect(x1, y1, x2, y2, X + div, Y, X + div, Y + div) Then - isInSector2 = True - ElseIf segmentsIntersect(x1, y1, x2, y2, X, Y + div, X + div, Y + div) Then - isInSector2 = True - End If - - Next - - Exit Function - -ErrorHandler: - - MsgBox Error$ - -End Function - -Private Function SegXHorizSeg(ByRef A1 As D3DVECTOR2, ByRef B1 As D3DVECTOR2, _ - ByRef A2 As D3DVECTOR2, ByRef length As Long) As Boolean - - Dim U As D3DVECTOR2 - Dim VX As Integer - Dim D As Single - Dim epsilon As Single - - SegXHorizSeg = False - - U.X = B1.X - A1.X - U.Y = B1.Y - A1.Y - D = -U.Y * length - - If (D = 0) Then 'the poly line seg is also horizontal - Exit Function - End If - - Dim W As D3DVECTOR2 - Dim s As Single - Dim T As Single - - W.X = A1.X - A2.X - W.Y = A1.Y - A2.Y - - s = (length * W.Y) / D - If (s <= 0 Or s >= 1) Then - Exit Function - End If - - T = (U.X * W.Y - U.Y * W.X) / D - If (T <= 0 Or T >= 1) Then - Exit Function - End If - - SegXHorizSeg = True - -End Function - -Private Function SegXVertSeg(ByRef A1 As D3DVECTOR2, ByRef B1 As D3DVECTOR2, _ - ByRef A2 As D3DVECTOR2, ByRef length As Long) As Boolean - - Dim U As D3DVECTOR2 - Dim D As Single - - SegXVertSeg = False - - U.X = B1.X - A1.X 'length of poly seg x - U.Y = B1.Y - A1.Y 'y - D = U.X * length - - If (D = 0) Then 'the poly line seg is also vertical - Exit Function - End If - - Dim W As D3DVECTOR2 - Dim s As Single - Dim T As Single - - W.X = A1.X - A2.X - W.Y = A1.Y - A2.Y - - s = (-length * W.X) / D - If (s <= 0 Or s >= 1) Then - Exit Function - End If - - T = (U.X * W.Y - U.Y * W.X) / D - If (T <= 0 Or T >= 1) Then - Exit Function - End If - - SegXVertSeg = True - -End Function - -Private Function segmentsIntersect(ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer, _ - ByVal A1 As Integer, ByVal B1 As Integer, ByVal A2 As Integer, ByVal B2 As Integer) As Boolean - - On Error GoTo ErrorHandler - - Dim DX As Long - Dim dy As Long - Dim da As Long - Dim db As Long - Dim T As Single - Dim s As Single - - DX = x2 - x1 - dy = y2 - y1 - da = A2 - A1 - db = B2 - B1 - - If (da * dy - db * DX) = 0 Then - 'the segments are parallel - segmentsIntersect = False - Exit Function - End If - - s = (DX * (B1 - y1) + dy * (x1 - A1)) / (da * dy - db * DX) - T = (da * (y1 - B1) + db * (A1 - x1)) / (db * DX - da * dy) - segmentsIntersect = (s >= 0 And s <= 1 And T >= 0 And T <= 1) - - Exit Function - -ErrorHandler: - - MsgBox Error$ - -End Function - -Private Function SegXSeg(ByRef A1 As D3DVECTOR2, ByRef B1 As D3DVECTOR2, _ - ByRef A2 As D3DVECTOR2, ByRef B2 As D3DVECTOR2) As Boolean - - Dim U As D3DVECTOR2 - Dim V As D3DVECTOR2 - Dim D As Single - - SegXSeg = False - - U.X = B1.X - A1.X - U.Y = B1.Y - A1.Y - V.X = B2.X - A2.X - V.Y = B2.Y - A2.Y - D = U.X * V.Y - U.Y * V.X - - If (D = 0) Then 'the poly line seg is also horizontal - Exit Function - End If - - Dim W As D3DVECTOR2 - Dim s As Single - Dim T As Single - - W.X = A1.X - A2.X - W.Y = A1.Y - A2.Y - - s = (V.X * W.Y - V.Y * W.X) / D - If (s <= 0# Or s >= 1#) Then - Exit Function - End If - - T = (U.X * W.Y - U.Y * W.X) / D - If (T <= 0# Or T >= 1#) Then - Exit Function - End If - - SegXSeg = True - -End Function - -Private Function isBetween(p1, p2, p3) As Boolean - - isBetween = False - - If (p1 >= p2 And p2 >= p3) Or (p3 >= p2 And p2 >= p1) Then - isBetween = True - End If - -End Function - -Private Sub initGrid() - - On Error GoTo ErrorHandler - - Dim i As Integer - - Dim clrString As String - Dim clr1 As Long, clr2 As Long - - clr1 = ARGB(gridOp1, gridClr) - clr2 = ARGB(gridOp2, gridClr2) - - ReDim xGridLines(gridDivisions) - ReDim yGridLines(gridDivisions) - - xGridLines(1).vertex(1) = CreateCustomVertex(0, 0, 1, 1, clr1, 0, 0) - xGridLines(1).vertex(2) = CreateCustomVertex(Me.ScaleWidth, 0, 1, 1, clr1, 0, 0) - - yGridLines(1).vertex(1) = CreateCustomVertex(0, 0, 1, 1, clr1, 0, 0) - yGridLines(1).vertex(2) = CreateCustomVertex(0, Me.ScaleHeight, 1, 1, clr1, 0, 0) - - For i = 2 To gridDivisions - xGridLines(i).vertex(1) = CreateCustomVertex(0, 0, 1, 1, clr2, 0, 0) - xGridLines(i).vertex(2) = CreateCustomVertex(Me.ScaleWidth, 0, 1, 1, clr2, 0, 0) - yGridLines(i).vertex(1) = CreateCustomVertex(0, 0, 1, 1, clr2, 0, 0) - yGridLines(i).vertex(2) = CreateCustomVertex(0, Me.ScaleHeight, 1, 1, clr2, 0, 0) - Next - - inc = (gridSpacing / gridDivisions) - - Exit Sub - -ErrorHandler: - - MsgBox "Error initializing grid" - -End Sub - -Private Sub setGrid() - - Dim xGridOffset As Single, yGridOffset As Single - Dim i As Integer - - xGridOffset = (scrollCoords(2).X - (Int(scrollCoords(2).X / gridSpacing) * gridSpacing)) * zoomFactor - yGridOffset = (scrollCoords(2).Y - (Int(scrollCoords(2).Y / gridSpacing) * gridSpacing)) * zoomFactor - - xGridLines(1).vertex(1).Y = 0 - yGridOffset - xGridLines(1).vertex(2).Y = 0 - yGridOffset - - yGridLines(1).vertex(1).X = 0 - xGridOffset - yGridLines(1).vertex(2).X = 0 - xGridOffset - - For i = 2 To gridDivisions - xGridLines(i).vertex(1).Y = xGridLines(1).vertex(1).Y + (gridSpacing / gridDivisions) * zoomFactor * (i - 1) - xGridLines(i).vertex(2).Y = xGridLines(i).vertex(1).Y - yGridLines(i).vertex(1).X = yGridLines(1).vertex(1).X + (gridSpacing / gridDivisions) * zoomFactor * (i - 1) - yGridLines(i).vertex(2).X = yGridLines(i).vertex(1).X - Next - -End Sub - -Private Function CreateCustomVertex(ByVal X As Single, ByVal Y As Single, z As Single, rhw As Single, Color As Long, _ - tu As Single, tv As Single) As TCustomVertex - - CreateCustomVertex.X = X - CreateCustomVertex.Y = Y - CreateCustomVertex.z = z - CreateCustomVertex.rhw = rhw - CreateCustomVertex.Color = Color - CreateCustomVertex.tu = tu - CreateCustomVertex.tv = tv - -End Function - -Private Function ExModeActive() As Boolean - - Dim TestCoopRes As Long - - TestCoopRes = D3DDevice.TestCooperativeLevel - - If (TestCoopRes = D3D_OK) Then - ExModeActive = True - Else - ExModeActive = False - End If - -End Function - -Public Sub Render() - - If Not initialized Or noRedraw Then Exit Sub - - Dim i As Integer, j As Integer - Dim lineCoords(1 To 4) As TCustomVertex - Dim sceneryCoords(4) As TCustomVertex - Dim circleCoords(0 To 32) As TCustomVertex - Dim numPolys As Integer - Dim scenR As Single - Dim backtypePolys() As TPolygon - - Dim xVal As Single, yVal As Single - Dim theta As Single - Dim R As Single - - Dim srcRect As RECT - Dim rc As D3DVECTOR2 - Dim sc As D3DVECTOR2 - Dim tr As D3DVECTOR2 - Dim sVal As Integer - Dim objClr As Long - - - Dim matView As D3DMATRIX - Dim viewVector As D3DVECTOR - Dim upVector As D3DVECTOR - Dim atVector As D3DVECTOR - Dim matProj As D3DMATRIX - - upVector.Y = -1 - atVector.z = 1 - atVector.X = scrollCoords(2).X + Me.ScaleWidth / 2 / zoomFactor - atVector.Y = (scrollCoords(2).Y + Me.ScaleHeight / 2 / zoomFactor) - - viewVector.X = scrollCoords(2).X + Me.ScaleWidth / 2 / zoomFactor - viewVector.Y = (scrollCoords(2).Y + Me.ScaleHeight / 2 / zoomFactor) - viewVector.z = 0 - - D3DXMatrixLookAtLH matView, viewVector, atVector, upVector - D3DDevice.SetTransform D3DTS_VIEW, matView - - D3DXMatrixPerspectiveLH matProj, Me.ScaleWidth / zoomFactor, -Me.ScaleHeight / zoomFactor, -1, 0 - D3DDevice.SetTransform D3DTS_PROJECTION, matProj - - - rc.X = 0 - rc.Y = 0 - - srcRect.left = 0 - srcRect.Top = 0 - - For i = 1 To 4 - lineCoords(i).rhw = 1 - lineCoords(i).z = 1 - Next - - initialized = False - If ExModeActive Then 'check if in focus - initialized = True - Else - resetDevice ''''' - initialized = True - End If - - If numVerts > 0 And currentTool = TOOL_CREATE Then - numPolys = polyCount + 1 - Else - numPolys = polyCount - End If - - D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, backClr, 1#, 0 - - D3DDevice.BeginScene - '---- - - D3DDevice.setTexture 0, Nothing - - 'draw background - If showBG Then - D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, bgPolys(1), Len(bgPolys(1)) - End If - - 'Draw Polys - If showPolys And numPolys > 0 Then - If showTexture Then 'set texture - D3DDevice.setTexture 0, mapTexture - End If - - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 - D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA - D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA - D3DDevice.SetRenderState D3DRS_COLORWRITEENABLE, D3DCOLORWRITEENABLE_BLUE Or D3DCOLORWRITEENABLE_GREEN Or D3DCOLORWRITEENABLE_RED - D3DDevice.SetRenderState D3DRS_COLORWRITEENABLE, D3DCOLORWRITEENABLE_ALPHA Or D3DCOLORWRITEENABLE_BLUE Or D3DCOLORWRITEENABLE_GREEN Or D3DCOLORWRITEENABLE_RED - - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 - - If clrPolys Then - D3DDevice.SetRenderState D3DRS_SRCBLEND, polyBlendSrc - D3DDevice.SetRenderState D3DRS_DESTBLEND, polyBlendDest - End If - - For i = 1 To numPolys - If vertexList(i).polyType = 24 Or vertexList(i).polyType = 25 Then - D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(i).vertex(1), Len(Polys(1).vertex(1)) - End If - Next - - D3DDevice.SetRenderState D3DRS_SRCBLEND, polyBlendSrc - D3DDevice.SetRenderState D3DRS_DESTBLEND, polyBlendDest - - ElseIf showPolys = False And numPolys > 0 Then - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 - D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ZERO - D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE - For i = 1 To numPolys - If vertexList(i).polyType = 24 Or vertexList(i).polyType = 25 Then - D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(i).vertex(1), Len(Polys(1).vertex(1)) - End If - Next - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 0 - End If - - scenerySprite.Begin - If sceneryCount > 0 And showScenery And sslBack Then - For i = 1 To sceneryCount - If Scenery(i).level = 0 Then - sVal = Scenery(i).Style - If Scenery(i).selected = 1 Then - If scaleDiff.X <> 1 Or scaleDiff.Y <> 1 Then - xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X - yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y - theta = GetAngle(xVal, yVal) + Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - xVal = Cos(theta) * R * scaleDiff.X - yVal = -Sin(theta) * R * scaleDiff.Y - theta = GetAngle(xVal, yVal) - Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - sc.X = SceneryTextures(sVal).reScale.X * ((Cos(theta) * R) / (SceneryTextures(Scenery(i).Style).Width)) * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * (-(Sin(theta) * R) / (SceneryTextures(Scenery(i).Style).Height)) * zoomFactor - scenR = Scenery(i).rotation - rDiff - Else - sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor - scenR = Scenery(i).rotation - rDiff - End If - Else - sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor - scenR = Scenery(i).rotation - End If - srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X - srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y - scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).Color - End If - Next - End If - - If sceneryCount > 0 And showScenery And sslMid Then - For i = 1 To sceneryCount - If Scenery(i).level = 1 Then - sVal = Scenery(i).Style - If Scenery(i).selected = 1 Then - If scaleDiff.X <> 1 Or scaleDiff.Y <> 1 Then - xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X - yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y - theta = GetAngle(xVal, yVal) + Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - xVal = Cos(theta) * R * scaleDiff.X - yVal = -Sin(theta) * R * scaleDiff.Y - theta = GetAngle(xVal, yVal) - Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - sc.X = SceneryTextures(sVal).reScale.X * ((Cos(theta) * R) / (SceneryTextures(Scenery(i).Style).Width)) * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * (-(Sin(theta) * R) / (SceneryTextures(Scenery(i).Style).Height)) * zoomFactor - scenR = Scenery(i).rotation - rDiff - Else - sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor - scenR = Scenery(i).rotation - rDiff - End If - Else - sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor - scenR = Scenery(i).rotation - End If - srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X - srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y - scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).Color - End If - Next - End If - - If currentFunction = TOOL_SCENERY And Not (ctrlDown Or altDown) Then - If Scenery(0).level < 2 Then - sVal = Scenery(0).Style - sc.X = SceneryTextures(sVal).reScale.X * Scenery(0).Scaling.X * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(0).Scaling.Y * zoomFactor - srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X - srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y - scenerySprite.Draw SceneryTextures(sVal).Texture, srcRect, sc, rc, Scenery(0).rotation, Scenery(0).screenTr, Scenery(0).Color - End If - End If - - scenerySprite.End - - 'Draw Polys - If showPolys And numPolys > 0 Then - If showTexture Then 'set texture - D3DDevice.setTexture 0, mapTexture - End If - - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 - D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA - D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA - D3DDevice.SetRenderState D3DRS_COLORWRITEENABLE, D3DCOLORWRITEENABLE_BLUE Or D3DCOLORWRITEENABLE_GREEN Or D3DCOLORWRITEENABLE_RED - D3DDevice.SetRenderState D3DRS_COLORWRITEENABLE, D3DCOLORWRITEENABLE_ALPHA Or D3DCOLORWRITEENABLE_BLUE Or D3DCOLORWRITEENABLE_GREEN Or D3DCOLORWRITEENABLE_RED - - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 - - If clrPolys Then - D3DDevice.SetRenderState D3DRS_SRCBLEND, polyBlendSrc - D3DDevice.SetRenderState D3DRS_DESTBLEND, polyBlendDest - End If - - For i = 1 To numPolys - If Not (vertexList(i).polyType = 24 Or vertexList(i).polyType = 25) Then - D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(i).vertex(1), Len(Polys(1).vertex(1)) - End If - Next - - D3DDevice.SetRenderState D3DRS_SRCBLEND, polyBlendSrc - D3DDevice.SetRenderState D3DRS_DESTBLEND, polyBlendDest - - ElseIf showPolys = False And numPolys > 0 Then - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 - D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ZERO - D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE - For i = 1 To numPolys - If Not (vertexList(i).polyType = 24 Or vertexList(i).polyType = 25) Then - D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(i).vertex(1), Len(Polys(1).vertex(1)) - End If - Next - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 0 - End If - - 'draw selected polys - If numSelectedPolys > 0 And showPolys And Not (currentTool = TOOL_TEXTURE Or currentTool = TOOL_VCOLOR Or currentTool = TOOL_PCOLOR) Then - D3DDevice.setTexture 0, patternTexture - D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE - D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE - - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 - For i = 1 To numSelectedPolys - objClr = PolyTypeClrs(vertexList(selectedPolys(i)).polyType) - lineCoords(1) = Polys(selectedPolys(i)).vertex(1) - lineCoords(2) = Polys(selectedPolys(i)).vertex(2) - lineCoords(3) = Polys(selectedPolys(i)).vertex(3) - - lineCoords(1).tu = Polys(selectedPolys(i)).vertex(1).X / 128 - lineCoords(1).tv = Polys(selectedPolys(i)).vertex(1).Y / 128 - lineCoords(2).tu = Polys(selectedPolys(i)).vertex(2).X / 128 - lineCoords(2).tv = Polys(selectedPolys(i)).vertex(2).Y / 128 - lineCoords(3).tu = Polys(selectedPolys(i)).vertex(3).X / 128 - lineCoords(3).tv = Polys(selectedPolys(i)).vertex(3).Y / 128 - - lineCoords(1).Color = 0 - lineCoords(2).Color = 0 - lineCoords(3).Color = 0 - - lineCoords(1).z = 1 - lineCoords(2).z = 1 - lineCoords(3).z = 1 - lineCoords(1).rhw = 1 - lineCoords(2).rhw = 1 - lineCoords(3).rhw = 1 - If vertexList(selectedPolys(i)).vertex(1) = 1 Then lineCoords(1).Color = objClr - If vertexList(selectedPolys(i)).vertex(2) = 1 Then lineCoords(2).Color = objClr - If vertexList(selectedPolys(i)).vertex(3) = 1 Then lineCoords(3).Color = objClr - - D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, lineCoords(1), Len(lineCoords(1)) - Next - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 0 - End If - - 'draw depthmap - If showPolys And currentTool = TOOL_DEPTHMAP Then - - lineCoords(1).tu = 0 - lineCoords(1).tv = 0 - lineCoords(2).tu = 0 - lineCoords(2).tv = 0 - lineCoords(3).tu = 0 - lineCoords(3).tv = 0 - lineCoords(1).z = 1 - lineCoords(2).z = 1 - lineCoords(3).z = 1 - lineCoords(1).rhw = 1 - lineCoords(2).rhw = 1 - lineCoords(3).rhw = 1 - - D3DDevice.setTexture 0, Nothing - - For i = 1 To polyCount - - lineCoords(1) = Polys(i).vertex(1) - lineCoords(2) = Polys(i).vertex(2) - lineCoords(3) = Polys(i).vertex(3) - - If Polys(i).vertex(1).z >= 0 And Polys(i).vertex(2).z >= 0 And Polys(i).vertex(3).z >= 0 Then - lineCoords(1).Color = ARGB(255, RGB(Polys(i).vertex(1).z, Polys(i).vertex(1).z, Polys(i).vertex(1).z)) - lineCoords(2).Color = ARGB(255, RGB(Polys(i).vertex(2).z, Polys(i).vertex(2).z, Polys(i).vertex(2).z)) - lineCoords(3).Color = ARGB(255, RGB(Polys(i).vertex(3).z, Polys(i).vertex(3).z, Polys(i).vertex(3).z)) - End If - - D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, lineCoords(1), Len(lineCoords(1)) - Next - - End If - - 'draw scenery - scenerySprite.Begin - If sceneryCount > 0 And showScenery And sslFront Then - For i = 1 To sceneryCount - If Scenery(i).level = 2 Then - sVal = Scenery(i).Style - If Scenery(i).selected = 1 Then - If scaleDiff.X <> 1 Or scaleDiff.Y <> 1 Then - xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X - yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y - theta = GetAngle(xVal, yVal) + Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - xVal = Cos(theta) * R * scaleDiff.X - yVal = -Sin(theta) * R * scaleDiff.Y - theta = GetAngle(xVal, yVal) - Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - sc.X = SceneryTextures(sVal).reScale.X * ((Cos(theta) * R) / (SceneryTextures(Scenery(i).Style).Width)) * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * (-(Sin(theta) * R) / (SceneryTextures(Scenery(i).Style).Height)) * zoomFactor - scenR = Scenery(i).rotation - rDiff - Else - sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor - scenR = Scenery(i).rotation - rDiff - End If - Else - sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor - scenR = Scenery(i).rotation - End If - srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X - srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y - scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).Color - End If - Next - End If - - 'draw current scenery - If currentFunction = TOOL_SCENERY And Not (ctrlDown Or altDown) Then - If Scenery(0).level = 2 Then - sVal = Scenery(0).Style - sc.X = SceneryTextures(sVal).reScale.X * Scenery(0).Scaling.X * zoomFactor - sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(0).Scaling.Y * zoomFactor - srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X + 0 - srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y + 0 - scenerySprite.Draw SceneryTextures(sVal).Texture, srcRect, sc, rc, Scenery(0).rotation, Scenery(0).screenTr, Scenery(0).Color - End If - End If - - 'draw objects - objClr = ARGB(255, RGB(255, 255, 255)) - sc.X = 32 / (objTexSize.X / 8) - sc.Y = 32 / (objTexSize.Y / 4) - rc.X = (objTexSize.X / 8) / 2 - rc.Y = (objTexSize.Y / 4) / 2 - If showObjects Then - If spawnPoints > 0 Then - For i = 1 To spawnPoints - tr.X = Int((Spawns(i).X - scrollCoords(2).X) * zoomFactor - 15 + 0.5) - tr.Y = Int((Spawns(i).Y - scrollCoords(2).Y) * zoomFactor - 15 + 0.5) - srcRect.Top = Int(Spawns(i).Team / 8) * (objTexSize.Y / 4) - srcRect.left = (Spawns(i).Team - (Int(Spawns(i).Team / 8) * 8)) * (objTexSize.X / 8) - srcRect.right = srcRect.left + (objTexSize.X / 8) - srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) - If Spawns(i).active = 1 Then - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, ARGB(255, selectionClr) - Else - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr - End If - Next - End If - If colliderCount > 0 Then - objClr = ARGB(128, RGB(255, 255, 255)) - For i = 1 To colliderCount - sc.X = Colliders(i).radius / (objTexSize.X / 8) * zoomFactor - sc.Y = Colliders(i).radius / (objTexSize.Y / 4) * zoomFactor - tr.X = Int((Colliders(i).X - scrollCoords(2).X) * zoomFactor - (objTexSize.X / 8) / 2 * sc.X + 0.5) - tr.Y = Int((Colliders(i).Y - scrollCoords(2).Y) * zoomFactor - (objTexSize.Y / 4) / 2 * sc.Y + 0.5) - If Colliders(i).active = 1 Then - srcRect.left = 0 - srcRect.Top = (objTexSize.Y / 4) * 3 - srcRect.right = srcRect.left + (objTexSize.X / 8) - srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr - Else - srcRect.left = (objTexSize.X / 8) - srcRect.Top = (objTexSize.Y / 4) * 2 - srcRect.right = srcRect.left + (objTexSize.X / 8) - srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr - End If - Next - End If - End If - - If showLights Then - objClr = ARGB(255, RGB(255, 255, 255)) - sc.X = 32 / (objTexSize.X / 8) - sc.Y = 32 / (objTexSize.Y / 4) - rc.X = (objTexSize.X / 8) / 2 - rc.Y = (objTexSize.Y / 4) / 2 - If lightCount > 0 Then - srcRect.left = (objTexSize.X / 8) * 7 - srcRect.Top = (objTexSize.Y / 4) * 2 - srcRect.right = srcRect.left + (objTexSize.X / 8) - srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) - For i = 1 To lightCount - objClr = ARGB(255, RGB(Lights(i).color.blue, Lights(i).color.green, Lights(i).color.red)) - sc.X = 32 / (objTexSize.X / 8) - sc.Y = 32 / (objTexSize.Y / 4) - tr.X = Int((Lights(i).X - scrollCoords(2).X) * zoomFactor - 16 * sc.X + 0.5) - tr.Y = Int((Lights(i).Y - scrollCoords(2).Y) * zoomFactor - 16 * sc.Y + 0.5) - If Lights(i).selected = 1 Then - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, ARGB(255, selectionClr) - Else - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr - End If - Next - End If - End If - - 'draw current object - If currentTool = TOOL_OBJECTS And Not (ctrlDown Or altDown) Then - objClr = ARGB(128, RGB(255, 255, 255)) - If mnuGostek.Checked Then 'gostek - sc.X = 32 / (objTexSize.X / 8) * zoomFactor - sc.Y = 32 / (objTexSize.Y / 4) * zoomFactor - srcRect.left = (objTexSize.X / 8) * 2 + 1 - srcRect.Top = (objTexSize.Y / 4) * 2 - srcRect.right = srcRect.left + (objTexSize.X / 8) - 2 - srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) - tr.X = mouseCoords.X - 16 * zoomFactor - tr.Y = mouseCoords.Y - 16 * zoomFactor - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr - ElseIf mnuCollider.Checked = True Then 'collider - srcRect.left = (objTexSize.X / 8) - srcRect.Top = (objTexSize.Y / 4) * 2 - srcRect.right = srcRect.left + (objTexSize.X / 8) - srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) - sc.X = Colliders(0).radius / (objTexSize.X / 8) * zoomFactor - sc.Y = Colliders(0).radius / (objTexSize.Y / 4) * zoomFactor - tr.X = Colliders(0).X - (objTexSize.X / 8) / 2 * sc.X - tr.Y = Colliders(0).Y - (objTexSize.Y / 4) / 2 * sc.Y - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr - Else 'spawn - sc.X = 32 / (objTexSize.X / 8) - sc.Y = 32 / (objTexSize.Y / 4) - tr.X = Spawns(0).X - 15 - tr.Y = Spawns(0).Y - 15 - srcRect.Top = Int(Spawns(0).Team / 8) * (objTexSize.Y / 4) - srcRect.left = (Spawns(0).Team - (Int(Spawns(0).Team / 8) * 8)) * (objTexSize.X / 8) - srcRect.right = srcRect.left + (objTexSize.X / 8) - srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr - End If - End If - - 'draw gostek - If gostek.X <> 0 Or gostek.Y <> 0 Then - sc.X = 32 / (objTexSize.X / 8) * zoomFactor - sc.Y = 32 / (objTexSize.Y / 4) * zoomFactor - srcRect.left = ((objTexSize.X / 8) * 2) + 1 - srcRect.Top = (objTexSize.Y / 4) * 2 - srcRect.right = srcRect.left + (objTexSize.X / 8) - 2 - srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) - tr.X = (gostek.X - 16 - scrollCoords(2).X) * zoomFactor - tr.Y = (gostek.Y - 16 - scrollCoords(2).Y) * zoomFactor - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, ARGB(255, RGB(128, 128, 128)) - End If - - scenerySprite.End - - D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA - D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA - D3DDevice.setTexture 0, Nothing - - 'draw grid - If showGrid Then - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True - - setGrid - - For i = 0 To (Int((Me.ScaleWidth / gridSpacing) / zoomFactor) + 1) - If inc * zoomFactor >= 8 Then - D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, gridDivisions, xGridLines(1).vertex(1), Len(xGridLines(1).vertex(1)) - D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, gridDivisions, yGridLines(1).vertex(1), Len(yGridLines(1).vertex(1)) - ElseIf gridSpacing * zoomFactor >= 8 Then - D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, 1, xGridLines(1).vertex(1), Len(xGridLines(1).vertex(1)) - D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, 1, yGridLines(1).vertex(1), Len(yGridLines(1).vertex(1)) - End If - - For j = 1 To gridDivisions - xGridLines(j).vertex(1).Y = xGridLines(j).vertex(1).Y + gridSpacing * zoomFactor - xGridLines(j).vertex(2).Y = xGridLines(j).vertex(1).Y - yGridLines(j).vertex(1).X = yGridLines(j).vertex(1).X + gridSpacing * zoomFactor - yGridLines(j).vertex(2).X = yGridLines(j).vertex(1).X - Next - Next - End If - - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False - - If clrWireframe And (showWireframe Or showPoints) Then - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 - D3DDevice.SetRenderState D3DRS_SRCBLEND, wireBlendSrc - D3DDevice.SetRenderState D3DRS_DESTBLEND, wireBlendDest - End If - - 'draw wireframe - If showWireframe And polyCount > 0 Then - D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME - For i = 1 To polyCount - D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(i).vertex(1), Len(Polys(1).vertex(1)) - Next - D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID - End If - - 'draw scenery boxes - sc.X = 1 - sc.Y = 1 - srcRect.right = 8 - srcRect.bottom = 8 - If sceneryCount > 0 And showScenery Then - For i = 1 To sceneryCount - - sVal = Scenery(i).Style - - sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, ARGB(255, Scenery(i).Color), 0, 0) - If Scenery(i).selected = 1 Or Scenery(i).selected = 3 Then - sceneryCoords(0).Color = ARGB(255, pointClr) - End If - sceneryCoords(1) = sceneryCoords(0) - sceneryCoords(2) = sceneryCoords(0) - sceneryCoords(3) = sceneryCoords(0) - sceneryCoords(0).X = Scenery(i).screenTr.X - sceneryCoords(0).Y = Scenery(i).screenTr.Y - - If Scenery(i).selected = 1 And ctrlDown And (scaleDiff.X <> 1 Or scaleDiff.Y <> 1) Then - xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X - yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y - theta = GetAngle(xVal, yVal) + Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - xVal = Cos(theta) * R * scaleDiff.X - yVal = -Sin(theta) * R * scaleDiff.Y - theta = GetAngle(xVal, yVal) - Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - sc.X = (Cos(theta) * R) - sc.Y = -(Sin(theta) * R) - - sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(i).rotation) * sc.X * zoomFactor - sceneryCoords(1).Y = sceneryCoords(0).Y - Sin(Scenery(i).rotation) * sc.X * zoomFactor - sceneryCoords(3).X = sceneryCoords(0).X + Sin(Scenery(i).rotation) * sc.Y * zoomFactor - sceneryCoords(3).Y = sceneryCoords(0).Y + Cos(Scenery(i).rotation) * sc.Y * zoomFactor - ElseIf Scenery(i).selected = 1 And (rDiff <> 0 Or (scaleDiff.X <> 0 Or scaleDiff.Y <> 0)) Then - sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(i).rotation - rDiff) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor - sceneryCoords(1).Y = sceneryCoords(0).Y - Sin(Scenery(i).rotation - rDiff) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor - sceneryCoords(3).X = sceneryCoords(0).X + Sin(Scenery(i).rotation - rDiff) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor - sceneryCoords(3).Y = sceneryCoords(0).Y + Cos(Scenery(i).rotation - rDiff) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor - Else - sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(i).rotation) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor - sceneryCoords(1).Y = sceneryCoords(0).Y - Sin(Scenery(i).rotation) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor - sceneryCoords(3).X = sceneryCoords(0).X + Sin(Scenery(i).rotation) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor - sceneryCoords(3).Y = sceneryCoords(0).Y + Cos(Scenery(i).rotation) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor - End If - - sceneryCoords(2).X = sceneryCoords(3).X + sceneryCoords(1).X - sceneryCoords(0).X - sceneryCoords(2).Y = sceneryCoords(3).Y + sceneryCoords(1).Y - sceneryCoords(0).Y - sceneryCoords(4) = sceneryCoords(0) - - If showWireframe Or Scenery(i).selected = 1 Or Scenery(i).selected = 3 Then - D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 4, sceneryCoords(0), Len(sceneryCoords(0)) - End If - - If showPoints Or Scenery(i).selected = 1 Or Scenery(i).selected = 3 Then - If sceneryVerts Then - D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 4, sceneryCoords(0), Len(sceneryCoords(0)) - Else - D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 1, sceneryCoords(0), Len(sceneryCoords(0)) - End If - End If - - Next - If currentTool = TOOL_SCENERY And Scenery(0).Style > 0 And Not (ctrlDown Or altDown) Then - sVal = Scenery(0).Style - sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) - sceneryCoords(1) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) - sceneryCoords(2) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) - sceneryCoords(3) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) - sceneryCoords(0).X = Scenery(0).screenTr.X - sceneryCoords(0).Y = Scenery(0).screenTr.Y - sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(0).rotation) * (SceneryTextures(sVal).Width + 0) * Scenery(0).Scaling.X * zoomFactor - sceneryCoords(1).Y = sceneryCoords(0).Y - Sin(Scenery(0).rotation) * (SceneryTextures(sVal).Width + 0) * Scenery(0).Scaling.X * zoomFactor - sceneryCoords(3).X = sceneryCoords(0).X + Sin(Scenery(0).rotation) * (SceneryTextures(sVal).Height + 0) * Scenery(0).Scaling.Y * zoomFactor - sceneryCoords(3).Y = sceneryCoords(0).Y + Cos(Scenery(0).rotation) * (SceneryTextures(sVal).Height + 0) * Scenery(0).Scaling.Y * zoomFactor - sceneryCoords(2).X = sceneryCoords(3).X + sceneryCoords(1).X - sceneryCoords(0).X - sceneryCoords(2).Y = sceneryCoords(3).Y + sceneryCoords(1).Y - sceneryCoords(0).Y - sceneryCoords(4) = sceneryCoords(0) - - D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 4, sceneryCoords(0), Len(sceneryCoords(0)) - - End If - End If - - If numVerts > 0 And currentTool = TOOL_CREATE Then - D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME - D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(polyCount + 1).vertex(1), Len(Polys(polyCount + 1).vertex(1)) - D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID - End If - - D3DDevice.setTexture 0, particleTexture - - 'draw points - If showPoints And numPolys > 0 Then - D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_POINT - - For i = 1 To numPolys - lineCoords(1) = Polys(i).vertex(1) - lineCoords(2) = Polys(i).vertex(2) - lineCoords(3) = Polys(i).vertex(3) - - lineCoords(1).z = 1 - lineCoords(2).z = 1 - lineCoords(3).z = 1 - lineCoords(1).rhw = 1 - lineCoords(2).rhw = 1 - lineCoords(3).rhw = 1 - - D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 3, lineCoords(1), Len(lineCoords(1)) - Next - - D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID - End If - - If showPoints And showObjects And colliderCount > 0 Then - sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) - For i = 1 To colliderCount - sceneryCoords(0).X = (Colliders(i).X - scrollCoords(2).X) * zoomFactor - sceneryCoords(0).Y = (Colliders(i).Y - scrollCoords(2).Y) * zoomFactor - If Colliders(i).active = 1 Then - sceneryCoords(0).Color = selectionClr - Else - sceneryCoords(0).Color = ARGB(255, RGB(255, 255, 255)) - End If - D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 1, sceneryCoords(0), Len(sceneryCoords(0)) - Next - End If - - 'draw selected poly wireframes - D3DDevice.setTexture 0, Nothing - If numSelectedPolys > 0 Then - D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME - For i = 1 To numSelectedPolys - lineCoords(1) = Polys(selectedPolys(i)).vertex(1) - lineCoords(2) = Polys(selectedPolys(i)).vertex(2) - lineCoords(3) = Polys(selectedPolys(i)).vertex(3) - - lineCoords(1).z = 1: lineCoords(1).rhw = 1 - lineCoords(2).z = 1: lineCoords(2).rhw = 1 - lineCoords(3).z = 1: lineCoords(3).rhw = 1 - - If vertexList(selectedPolys(i)).vertex(1) = 1 Or vertexList(selectedPolys(i)).vertex(1) = 3 Then - lineCoords(1).Color = pointClr - End If - If vertexList(selectedPolys(i)).vertex(2) = 1 Or vertexList(selectedPolys(i)).vertex(2) = 3 Then - lineCoords(2).Color = pointClr - End If - If vertexList(selectedPolys(i)).vertex(3) = 1 Or vertexList(selectedPolys(i)).vertex(3) = 3 Then - lineCoords(3).Color = pointClr - End If - - D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, lineCoords(1), Len(lineCoords(1)) - - If showPoints Then - If vertexList(selectedPolys(i)).vertex(1) = 1 Then lineCoords(1).Color = pointClr - If vertexList(selectedPolys(i)).vertex(2) = 1 Then lineCoords(2).Color = pointClr - If vertexList(selectedPolys(i)).vertex(3) = 1 Then lineCoords(3).Color = pointClr - D3DDevice.setTexture 0, particleTexture - D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 3, lineCoords(1), Len(lineCoords(1)) - D3DDevice.setTexture 0, Nothing - End If - Next - D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID - End If - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 0 - - 'draw selection rect - If currentTool = TOOL_MOVE And (numSelectedPolys > 0 Or numSelectedScenery > 0) And noneSelected = False Then - - objClr = &H80FFFFFF - - D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA - D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True - - D3DDevice.setTexture 0, lineTexture - - sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, objClr, 0, 0) - sceneryCoords(1) = CreateCustomVertex(0, 0, 1, 1, objClr, 0, 0) - sceneryCoords(2) = CreateCustomVertex(0, 0, 1, 1, objClr, 0, 0) - sceneryCoords(3) = CreateCustomVertex(0, 0, 1, 1, objClr, 0, 0) - - If rDiff <> 0 Then - For i = 0 To 3 - xVal = (selRect(i).X - rCenter.X) - yVal = (selRect(i).Y - rCenter.Y) - R = Sqr(xVal ^ 2 + yVal ^ 2) - theta = GetAngle(xVal, yVal) - rDiff - sceneryCoords(i).X = (rCenter.X + R * Cos(theta) - scrollCoords(2).X) * zoomFactor - sceneryCoords(i).Y = (rCenter.Y + R * -Sin(theta) - scrollCoords(2).Y) * zoomFactor - Next - ElseIf scaleDiff.X <> 1 Or scaleDiff.Y <> 1 Then - For i = 0 To 3 - sceneryCoords(i).X = (rCenter.X + ((selRect(i).X - rCenter.X) * scaleDiff.X) - scrollCoords(2).X) * zoomFactor - sceneryCoords(i).Y = (rCenter.Y + ((selRect(i).Y - rCenter.Y) * scaleDiff.Y) - scrollCoords(2).Y) * zoomFactor - Next - Else - For i = 0 To 3 - sceneryCoords(i).X = (selRect(i).X - scrollCoords(2).X) * zoomFactor - sceneryCoords(i).Y = (selRect(i).Y - scrollCoords(2).Y) * zoomFactor - Next - End If - - sceneryCoords(0).tu = 0 - sceneryCoords(0).tv = 0 - sceneryCoords(1).tu = Sqr((sceneryCoords(1).X - sceneryCoords(0).X) ^ 2 + (sceneryCoords(1).Y - sceneryCoords(0).Y) ^ 2) / 64 - sceneryCoords(1).tv = 0 - sceneryCoords(2).tu = sceneryCoords(1).tu - sceneryCoords(2).tv = Sqr((sceneryCoords(2).X - sceneryCoords(1).X) ^ 2 + (sceneryCoords(2).Y - sceneryCoords(1).Y) ^ 2) / 64 - sceneryCoords(3).tu = 0 - sceneryCoords(3).tv = sceneryCoords(2).tv - - sceneryCoords(4) = sceneryCoords(0) - - D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 4, sceneryCoords(0), Len(sceneryCoords(0)) - D3DDevice.setTexture 0, Nothing - D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 4, sceneryCoords(0), Len(sceneryCoords(0)) - - For i = 0 To 3 - sceneryCoords(i).X = Midpoint(sceneryCoords(i).X, sceneryCoords(i + 1).X) - sceneryCoords(i).Y = Midpoint(sceneryCoords(i).Y, sceneryCoords(i + 1).Y) - Next - D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 4, sceneryCoords(0), Len(sceneryCoords(0)) - - If Not mnuFixedRCenter.Checked Then - sceneryCoords(0).X = (rCenter.X - scrollCoords(2).X) * zoomFactor - sceneryCoords(0).Y = (rCenter.Y - scrollCoords(2).Y) * zoomFactor - D3DDevice.setTexture 0, rCenterTexture - D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 1, sceneryCoords(0), Len(sceneryCoords(0)) - End If - - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False - - End If - - If showWaypoints Then - objClr = &HFFFFFFFF - For i = 1 To waypointCount - If (Waypoints(i).pathNum = 1 And frmWaypoints.showPaths <> 2) Or (Waypoints(i).pathNum = 2 And frmWaypoints.showPaths <> 1) Then - If Waypoints(i).selected = True Then - If Waypoints(i).pathNum = 1 Then - srcRect.left = (objTexSize.X / 8) * 5 - Else - srcRect.left = (objTexSize.X / 8) * 6 - End If - Else - If Waypoints(i).pathNum = 1 Then - srcRect.left = (objTexSize.X / 8) * 3 - Else - srcRect.left = (objTexSize.X / 8) * 4 - End If - End If - sc.X = 32 / (objTexSize.X / 8) - sc.Y = 32 / (objTexSize.Y / 4) - srcRect.Top = (objTexSize.Y / 4) * 2 - srcRect.right = srcRect.left + (objTexSize.X / 8) - srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) - tr.X = Int((Waypoints(i).X - scrollCoords(2).X) * zoomFactor - 15 + 0.5) - tr.Y = Int((Waypoints(i).Y - scrollCoords(2).Y) * zoomFactor - 15 + 0.5) - scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr - End If - Next - - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True - D3DDevice.setTexture 0, pathTexture - For i = 1 To conCount - If (Waypoints(Connections(i).point1).pathNum = 1 And frmWaypoints.showPaths <> 2) Or (Waypoints(Connections(i).point1).pathNum = 2 And frmWaypoints.showPaths <> 1) _ - Or (Waypoints(Connections(i).point2).pathNum = 1 And frmWaypoints.showPaths <> 2) Or (Waypoints(Connections(i).point2).pathNum = 2 And frmWaypoints.showPaths <> 1) Then - lineCoords(1).X = (Waypoints(Connections(i).point1).X - scrollCoords(2).X) * zoomFactor - lineCoords(1).Y = (Waypoints(Connections(i).point1).Y - scrollCoords(2).Y) * zoomFactor - lineCoords(2).X = (Waypoints(Connections(i).point2).X - scrollCoords(2).X) * zoomFactor - lineCoords(2).Y = (Waypoints(Connections(i).point2).Y - scrollCoords(2).Y) * zoomFactor - If Waypoints(Connections(i).point2).wayType(2) Then - lineCoords(1).Color = &HFFFFFF22 - lineCoords(2).Color = &HFFFFFF22 - ElseIf Waypoints(Connections(i).point2).wayType(3) Then - lineCoords(1).Color = &HFF22FFFF - lineCoords(2).Color = &HFF22FFFF - ElseIf Waypoints(Connections(i).point2).wayType(0) Then - lineCoords(1).Color = &HFF22FF22 - lineCoords(2).Color = &HFF22FF22 - ElseIf Waypoints(Connections(i).point2).wayType(1) Then - lineCoords(1).Color = &HFFFF2222 - lineCoords(2).Color = &HFFFF2222 - ElseIf Waypoints(Connections(i).point2).wayType(4) Then - lineCoords(1).Color = &HFFFFFFFF - lineCoords(2).Color = &HFFFFFFFF - Else - lineCoords(1).Color = &HFF000000 - lineCoords(2).Color = &HFF000000 - End If - lineCoords(1).tu = 0 - lineCoords(1).tv = 0 - lineCoords(2).tu = 1 - lineCoords(2).tv = 0 - - D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 1, lineCoords(1), Len(lineCoords(1)) - End If - Next - - If currentWaypoint > 0 Then - lineCoords(1).X = (Waypoints(currentWaypoint).X - scrollCoords(2).X) * zoomFactor - lineCoords(1).Y = (Waypoints(currentWaypoint).Y - scrollCoords(2).Y) * zoomFactor - lineCoords(2).X = mouseCoords.X - lineCoords(2).Y = mouseCoords.Y - If mnuWayType(2).Checked Then - lineCoords(1).Color = &HFFFFFF22 - lineCoords(2).Color = &HFFFFFF22 - ElseIf mnuWayType(3).Checked Then - lineCoords(1).Color = &HFF22FFFF - lineCoords(2).Color = &HFF22FFFF - ElseIf mnuWayType(0).Checked Then - lineCoords(1).Color = &HFF22FF22 - lineCoords(2).Color = &HFF22FF22 - ElseIf mnuWayType(1).Checked Then - lineCoords(1).Color = &HFFFF2222 - lineCoords(2).Color = &HFFFF2222 - ElseIf mnuWayType(4).Checked Then - lineCoords(1).Color = &HFFFFFFFF - lineCoords(2).Color = &HFFFFFFFF - Else - lineCoords(1).Color = &HFF000000 - lineCoords(2).Color = &HFF000000 - End If - lineCoords(1).tu = 0 - lineCoords(1).tv = 0 - lineCoords(2).tu = 1 - lineCoords(2).tv = 0 - - D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 1, lineCoords(1), Len(lineCoords(1)) - End If - - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False - End If - - If showSketch Then - D3DDevice.SetVertexShader FVF2 - D3DDevice.setTexture 0, sketchTexture - If sketchLines > 0 Then - D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, sketchLines, sketch(1).vertex(1), Len(sketch(1).vertex(1)) - End If - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False - If currentFunction = TOOL_SKETCH And shiftDown Then - D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, 1, sketch(0).vertex(1), Len(sketch(0).vertex(1)) - End If - D3DDevice.SetVertexShader FVF - End If - - D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_INVDESTCOLOR - D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True - - 'draw circle - If circleOn Then - For i = 0 To 32 - circleCoords(i).Color = ARGB(255, RGB(255, 255, 255)) - circleCoords(i).X = mouseCoords.X + zoomFactor * clrRadius * Math.Cos(pi * i / 16) - circleCoords(i).Y = mouseCoords.Y + zoomFactor * clrRadius * Math.Sin(pi * i / 16) - Next - D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 32, circleCoords(0), Len(circleCoords(0)) - End If - - 'vertex selection -------- - If currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB Then - If toolAction Then - circleCoords(0).Color = ARGB(255, RGB(255, 255, 255)) - circleCoords(1).Color = ARGB(255, RGB(255, 255, 255)) - circleCoords(2).Color = ARGB(255, RGB(255, 255, 255)) - circleCoords(3).Color = ARGB(255, RGB(255, 255, 255)) - circleCoords(4).Color = ARGB(255, RGB(255, 255, 255)) - circleCoords(0).X = selectedCoords(1).X - circleCoords(1).X = mouseCoords.X - circleCoords(2).X = mouseCoords.X - circleCoords(3).X = selectedCoords(1).X - circleCoords(4).X = selectedCoords(1).X - circleCoords(0).Y = selectedCoords(1).Y - circleCoords(1).Y = selectedCoords(1).Y - circleCoords(2).Y = mouseCoords.Y - circleCoords(3).Y = mouseCoords.Y - circleCoords(4).Y = selectedCoords(1).Y - D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 4, circleCoords(0), Len(circleCoords(0)) - End If - End If - - D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False - - - D3DDevice.EndScene - - D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0 - - eraseCircle = False - - Exit Sub - -ErrorHandler: - - MsgBox "Error Rendering with Direct3D" & vbNewLine & D3DX.GetErrorString(err.Number) - -End Sub - -Private Function getRGB(DecValue As Long) As TColor - - Dim hexValue As String - - hexValue = Hex$(Val(DecValue)) - - If Len(hexValue) < 6 Then - hexValue = String$(6 - Len(hexValue), "0") + hexValue - End If - - getRGB.blue = CLng("&H" + right$(hexValue, 2)) - hexValue = left$(hexValue, Len(hexValue) - 2) - getRGB.green = CLng("&H" + right$(hexValue, 2)) - hexValue = left$(hexValue, Len(hexValue) - 2) - getRGB.red = CLng("&H" + right$(hexValue, 2)) - -End Function - -Private Function getAlpha(tehColor As Long) As Byte - - Dim hexValue As String - - hexValue = Hex$(Val(tehColor)) - - If Len(hexValue) <= 6 Then - getAlpha = 0 - Else - If Len(hexValue) < 8 Then - hexValue = String$(8 - Len(hexValue), "0") + hexValue - End If - getAlpha = CLng("&H" + left$(hexValue, 2)) - End If - -End Function - -Private Function ARGB(ByVal alphaVal As Byte, clrVal As Long) As Long - - Dim clrString As String - - clrString = Hex$(clrVal) - If Len(clrString) < 6 Then - clrString = String$(6 - Len(clrString), "0") & clrString - ElseIf Len(clrString) > 6 Then - clrString = right$(clrString, 6) - End If - If Len(Hex$(alphaVal)) = 1 Then - clrString = "0" + Hex$(alphaVal) & clrString - ElseIf Len(Hex$(alphaVal)) = 2 Then - clrString = Hex$(alphaVal) & clrString - End If - ARGB = CLng("&H" & clrString) - -End Function - -Private Function makeColor(red As Byte, green As Byte, blue As Byte) As TColor - - makeColor.red = red - makeColor.green = green - makeColor.blue = blue - -End Function - -Function FtoDW(f As Single) As Long - - Dim buf As D3DXBuffer - Dim l As Long - Set buf = D3DX.CreateBuffer(4) - D3DX.BufferSetData buf, 0, 4, 1, f - D3DX.BufferGetData buf, 0, 4, 1, l - FtoDW = l - -End Function - -Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) - - Dim i As Long - Dim hotKeyPressed As Integer, wayptKeyPressed As Integer, layerKeyPressed As Integer - Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA - Static tempFunction As Byte - - On Error GoTo ErrorHandler - - If DIDevice Is Nothing Then Exit Sub - - If eventid = hEvent Then - - DIDevice.GetDeviceStateKeyboard DIState - DIDevice.GetDeviceData pBuffer, DIGDD_DEFAULT - - If tvwScenery.Visible = True Then Exit Sub - - If Screen.ActiveForm.hWnd <> Me.hWnd Or Me.ActiveControl = txtZoom Then Exit Sub - - If DIState.Key(DIK_SPACE) = 128 And Not spaceDown Then - circleOn = False - spaceDown = True - scrollCoords(1).X = mouseCoords.X - scrollCoords(1).Y = mouseCoords.Y - SetCursor TOOL_HAND + 1 - Exit Sub - ElseIf (DIState.Key(DIK_LSHIFT) = 128 Or DIState.Key(DIK_RSHIFT) = 128) And Not shiftDown Then - circleOn = False - shiftDown = True - Select Case currentTool - Case Is = TOOL_VSELECT 'add verts - currentFunction = TOOL_VSELADD - Case Is = TOOL_PSELECT 'add polys - currentFunction = TOOL_PSELADD - Case Is = TOOL_WAYPOINT - currentFunction = TOOL_CONNECT - Case Is = TOOL_CLRPICKER - currentFunction = TOOL_PIXPICKER - Case Is = TOOL_SKETCH - sketch(0).vertex(1).X = mouseCoords.X / zoomFactor + scrollCoords(2).X - sketch(0).vertex(1).Y = mouseCoords.Y / zoomFactor + scrollCoords(2).Y - End Select - SetCursor currentFunction + 1 - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - Exit Sub - ElseIf (DIState.Key(DIK_LCONTROL) = 128 Or DIState.Key(DIK_RCONTROL) = 128) And Not ctrlDown Then - circleOn = False - ctrlDown = True - Select Case currentTool - Case Is = TOOL_MOVE - currentFunction = TOOL_SCALE - If altDown Then - ApplyTransform True - End If - toolAction = False - Case Is = TOOL_SKETCH - currentFunction = TOOL_SMUDGE - circleOn = True - Case Is > TOOL_MOVE - currentFunction = TOOL_MOVE - If currentTool <> TOOL_CREATE Then - toolAction = False - End If - End Select - Render - SetCursor currentFunction + 1 - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - Exit Sub - ElseIf (DIState.Key(DIK_LALT) = 128 Or DIState.Key(DIK_RALT) = 128) And Not altDown Then - circleOn = False - altDown = True - Select Case currentTool - Case Is = TOOL_MOVE - currentFunction = TOOL_ROTATE - If toolAction Then - If ctrlDown Then - ApplyTransform False - End If - toolAction = False - End If - Case Is = TOOL_VSELECT 'subtract verts - currentFunction = TOOL_VSELSUB - Case Is = TOOL_PSELECT 'subtract polys - currentFunction = TOOL_PSELSUB - Case Is = TOOL_VCOLOR 'color picker - currentFunction = TOOL_CLRPICKER - Case Is = TOOL_PCOLOR 'color picker - currentFunction = TOOL_CLRPICKER - Case Is = TOOL_DEPTHMAP - currentFunction = TOOL_CLRPICKER - Case Is = TOOL_CLRPICKER - currentFunction = TOOL_LITPICKER - Case Is = TOOL_SKETCH - currentFunction = TOOL_ERASER - circleOn = True - Case Else - currentFunction = TOOL_VSELECT - End Select - If currentFunction = TOOL_TEXTURE Then toolAction = False - If currentFunction = TOOL_VCOLOR Or currentFunction = TOOL_DEPTHMAP Then circleOn = True - Render - SetCursor currentFunction + 1 - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - Exit Sub - End If - - hotKeyPressed = -1 - For i = 0 To 13 - If (DIState.Key(frmTools.getHotKey(i))) Then hotKeyPressed = i - Next - wayptKeyPressed = -1 - For i = 0 To 4 - If (DIState.Key(frmWaypoints.getWayptKey(i))) Then wayptKeyPressed = i - Next - layerKeyPressed = -1 - For i = 0 To 7 - If (DIState.Key(frmDisplay.getLayerKey(i))) Then layerKeyPressed = i - Next - - 'key up -------- - If (pBuffer(0).lData = 0) Then - - If ((pBuffer(0).lOfs = DIK_RSHIFT Or pBuffer(0).lOfs = DIK_LSHIFT) And shiftDown) Then - shiftDown = False - currentFunction = currentTool - If currentFunction = TOOL_SKETCH Then - toolAction = False - Render - ElseIf currentFunction = TOOL_MOVE Then - If altDown Then - currentFunction = TOOL_ROTATE - ElseIf ctrlDown Then - currentFunction = TOOL_SCALE - End If - End If - ElseIf ((pBuffer(0).lOfs = DIK_RCONTROL Or pBuffer(0).lOfs = DIK_LCONTROL) And ctrlDown) Then - ctrlDown = False - If currentTool = TOOL_VSELECT Then - toolAction = False - ElseIf currentTool = TOOL_MOVE Then - ApplyTransform False - ElseIf currentTool = TOOL_SCENERY Then - Scenery(0).screenTr.X = mouseCoords.X - Scenery(0).screenTr.Y = mouseCoords.Y - Scenery(0).Translation.X = mouseCoords.X - Scenery(0).Translation.Y = mouseCoords.Y - ElseIf currentTool = TOOL_OBJECTS Then - Spawns(0).X = mouseCoords.X - Spawns(0).Y = mouseCoords.Y - ElseIf currentTool = TOOL_DEPTHMAP Then - circleOn = True - ElseIf currentTool = TOOL_VCOLOR Then - circleOn = True - ElseIf currentTool = TOOL_SKETCH Then - circleOn = False - End If - Render - currentFunction = currentTool - ElseIf ((pBuffer(0).lOfs = DIK_RALT Or pBuffer(0).lOfs = DIK_LALT) And altDown) Then - altDown = False - If currentTool = TOOL_MOVE Then - ApplyTransform True - ElseIf currentTool = TOOL_SCENERY Then - Scenery(0).screenTr.X = mouseCoords.X - Scenery(0).screenTr.Y = mouseCoords.Y - Scenery(0).Translation.X = mouseCoords.X - Scenery(0).Translation.Y = mouseCoords.Y - ElseIf currentTool = TOOL_OBJECTS Then - Spawns(0).X = mouseCoords.X - Spawns(0).Y = mouseCoords.Y - ElseIf currentTool = TOOL_DEPTHMAP Then - circleOn = True - ElseIf currentTool = TOOL_VCOLOR Then - circleOn = True - ElseIf currentTool = TOOL_SKETCH Then - circleOn = False - End If - Render - currentFunction = currentTool - ElseIf (pBuffer(0).lOfs = DIK_SPACE And spaceDown) Then 'scrolling - spaceDown = False - End If - - SetCursor currentFunction + 1 - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - - End If - - If ctrlDown Then 'shortcut - - If DIState.Key(DIK_EQUALS) = 128 Then 'ctrl++ - Zoom getZoomDir(2) '2 - ElseIf DIState.Key(DIK_MINUS) = 128 Then 'ctrl+- - Zoom getZoomDir(0.5) '0.5 - ElseIf DIState.Key(DIK_0) = 128 Then 'ctrl+0 - zoomFactor = 1 - scrollCoords(2).X = -ScaleWidth / 2 - scrollCoords(2).Y = -ScaleHeight / 2 - Zoom 1 - ElseIf DIState.Key(MapVirtualKey(78, 0)) = 128 Then 'ctrl+n - mnuNew_Click - ElseIf DIState.Key(MapVirtualKey(79, 0)) = 128 Then 'ctrl+o - mnuOpen_Click - ElseIf DIState.Key(MapVirtualKey(83, 0)) = 128 And shiftDown Then 'ctrl+shift+s - mnuSaveAs_Click - ElseIf DIState.Key(MapVirtualKey(83, 0)) = 128 Then 'ctrl+s - mnuSave_Click - ElseIf DIState.Key(MapVirtualKey(69, 0)) = 128 Then 'ctrl+e - mnuCreate_Click - ElseIf DIState.Key(MapVirtualKey(86, 0)) = 128 Then 'ctrl+v - mnuPaste_Click - ElseIf DIState.Key(MapVirtualKey(67, 0)) = 128 Then 'ctrl+c - mnuCopy_Click - ElseIf DIState.Key(MapVirtualKey(90, 0)) = 128 Then 'ctrl+z - loadUndo False - ElseIf DIState.Key(MapVirtualKey(89, 0)) = 128 Then 'ctrl+y - loadUndo True - ElseIf DIState.Key(MapVirtualKey(65, 0)) = 128 Then 'ctrl+a - mnuSelectAll_Click - ElseIf DIState.Key(MapVirtualKey(68, 0)) = 128 Then 'ctrl+d - mnuDuplicate_Click - ElseIf DIState.Key(MapVirtualKey(73, 0)) = 128 Then 'ctrl+i - mnuInvertSel_Click - ElseIf DIState.Key(MapVirtualKey(66, 0)) = 128 Then 'ctrl+b - mnuSelColor_Click - ElseIf DIState.Key(MapVirtualKey(74, 0)) = 128 Then 'ctrl+j - mnuJoinVertices_Click - ElseIf DIState.Key(MapVirtualKey(85, 0)) = 128 Then 'ctrl+u - mnuUntexture_Click - ElseIf DIState.Key(MapVirtualKey(70, 0)) = 128 Then 'ctrl+f - mnuFixTexture_Click - ElseIf DIState.Key(MapVirtualKey(76, 0)) = 128 Then 'ctrl+l - mnuSplit_Click - ElseIf DIState.Key(MapVirtualKey(77, 0)) = 128 Then 'ctrl+m - mnuMap_Click - ElseIf DIState.Key(MapVirtualKey(80, 0)) = 128 Then 'ctrl+p - mnuPreferences_Click - ElseIf DIState.Key(MapVirtualKey(71, 0)) = 128 Then 'ctrl+g - AverageVertices - ElseIf DIState.Key(DIK_APOSTROPHE) = 128 Then 'ctrl+' - mnuGrid_Click - ElseIf DIState.Key(MapVirtualKey(84, 0)) = 128 Then 'ctrl+t - AutoTexture - End If - - Else - - If hotKeyPressed > -1 And Not (shiftDown Or ctrlDown Or altDown) Then 'hotkey - setCurrentTool hotKeyPressed - frmTools.picTools_MouseDown hotKeyPressed, 1, 0, 1, 1 - ElseIf wayptKeyPressed > -1 And Not (shiftDown Or ctrlDown Or altDown) Then 'waypoint key - frmWaypoints.picType_MouseUp wayptKeyPressed, 1, 0, 0, 0 - ElseIf layerKeyPressed > -1 And Not (shiftDown Or ctrlDown Or altDown) Then 'layer key - frmDisplay.picLayer_MouseUp layerKeyPressed, 1, 0, 0, 0 - ElseIf DIState.Key(DIK_NUMPADPLUS) = 128 Then '+ - Zoom getZoomDir(2) - ElseIf DIState.Key(DIK_NUMPADMINUS) = 128 Then '- - Zoom getZoomDir(0.5) - ElseIf DIState.Key(DIK_NUMPADSTAR) = 128 Then '* - Zoom 1 / zoomFactor - ElseIf DIState.Key(DIK_DELETE) = 128 Then 'delete - deletePolys - ElseIf DIState.Key(DIK_TAB) = 128 Then 'tab - TabPressed - ElseIf (DIState.Key(DIK_ESCAPE) = 128) Then 'esc - If numVerts > 0 Or numCorners > 0 Or currentWaypoint > 0 Then - numVerts = 0 - numCorners = 0 - currentWaypoint = 0 - toolAction = False - Render - Else - mnuDeselect_Click - End If - ElseIf (DIState.Key(DIK_BACKSPACE) = 128) Then 'backspace - mnuSever_Click - ElseIf (DIState.Key(DIK_INSERT) = 128 And shiftDown) Then 'shift+insert - mnuDuplicate_Click - ElseIf (DIState.Key(DIK_HOME) = 128) Then 'Home - mnuBringToFront_Click - ElseIf (DIState.Key(DIK_END) = 128) Then 'End - mnuSendToBack_Click - ElseIf (DIState.Key(DIK_PGUP) = 128) Then 'Page Up - mnuBringForward_Click - ElseIf (DIState.Key(DIK_PGDN) = 128) Then 'Page Down - mnuSendBackward_Click - ElseIf (DIState.Key(DIK_F1) = 128) Then 'F1 - RunHelp - ElseIf (DIState.Key(DIK_F5) = 128) Then 'F5 - mnuRefreshBG_Click - ElseIf (DIState.Key(DIK_F8) = 128) Then 'F8 - mnuRunSoldat_Click - ElseIf (DIState.Key(DIK_F9) = 128) Then 'F9 - mnuCompileAs_Click - ElseIf (DIState.Key(DIK_F4) = 128 And altDown) Then 'alt+F4 - mnuExit_Click - ElseIf (DIState.Key(DIK_LBRACKET) = 128) Then '[ - If currentTool = 0 Then - setCurrentTool TOOL_DEPTHMAP - Else - setCurrentTool currentTool - 1 - End If - frmTools.picTools_MouseDown CInt(currentTool), 1, 0, 1, 1 - ElseIf (DIState.Key(DIK_RBRACKET) = 128) Then '] - If currentTool = TOOL_DEPTHMAP Then - setCurrentTool TOOL_MOVE - Else - setCurrentTool currentTool + 1 - End If - frmTools.picTools_MouseDown CInt(currentTool), 1, 0, 1, 1 - ElseIf (DIState.Key(DIK_LEFT) = 128 Or DIState.Key(DIK_UP) = 128 Or DIState.Key(DIK_RIGHT) = 128 Or DIState.Key(DIK_DOWN) = 128) Then 'arrow keys - Dim n As Single - moveCoords(1).X = 0 - moveCoords(1).Y = 0 - If shiftDown Then - n = gridSpacing / gridDivisions * zoomFactor - Else - n = zoomFactor - End If - If currentTool = TOOL_TEXTURE And numSelectedPolys > 0 Then - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - If DIState.Key(DIK_LEFT) = 128 Then 'left - StretchingTexture -n, 0 - ElseIf DIState.Key(DIK_UP) = 128 Then 'up - StretchingTexture 0, -n - ElseIf DIState.Key(DIK_RIGHT) = 128 Then 'right - StretchingTexture n, 0 - ElseIf DIState.Key(DIK_DOWN) = 128 Then 'down - StretchingTexture 0, n - End If - SaveUndo - Else - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - If DIState.Key(DIK_LEFT) = 128 Then 'left - Moving -n, 0 - ElseIf DIState.Key(DIK_UP) = 128 Then 'up - Moving 0, -n - ElseIf DIState.Key(DIK_RIGHT) = 128 Then 'right - Moving n, 0 - ElseIf DIState.Key(DIK_DOWN) = 128 Then 'down - Moving 0, n - End If - SaveUndo - End If - End If - - End If - - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - - End If - - Exit Sub - -ErrorHandler: - - If err.Number = DIERR_INPUTLOST Then - acquired = False - ElseIf err.Number = DIERR_NOTACQUIRED Then - Else - MsgBox "DirectInput error" & vbNewLine & D3DX.GetErrorString(err.Number) - End If - -End Sub - -Private Sub TabPressed() - - Dim scenNum As Integer - Dim tempSel As Byte - Dim i As Integer - - If numSelectedPolys = 1 And numSelectedScenery = 0 Then - - If vertexList(selectedPolys(1)).vertex(1) + vertexList(selectedPolys(1)).vertex(2) + vertexList(selectedPolys(1)).vertex(3) = 3 Then - vertexList(selectedPolys(1)).vertex(1) = 0 - vertexList(selectedPolys(1)).vertex(2) = 0 - vertexList(selectedPolys(1)).vertex(3) = 0 - If Not shiftDown Then - If selectedPolys(1) = polyCount Then - selectedPolys(1) = 1 - Else - selectedPolys(1) = selectedPolys(1) + 1 - End If - Else - Beep - If selectedPolys(1) = 1 Then - selectedPolys(1) = polyCount - Else - selectedPolys(1) = selectedPolys(1) - 1 - End If - End If - vertexList(selectedPolys(1)).vertex(1) = 1 - vertexList(selectedPolys(1)).vertex(2) = 1 - vertexList(selectedPolys(1)).vertex(3) = 1 - Else - tempSel = vertexList(selectedPolys(1)).vertex(1) - vertexList(selectedPolys(1)).vertex(1) = vertexList(selectedPolys(1)).vertex(2) - vertexList(selectedPolys(1)).vertex(2) = vertexList(selectedPolys(1)).vertex(3) - vertexList(selectedPolys(1)).vertex(3) = tempSel - End If - - Render - - ElseIf numSelectedScenery = 1 And numSelectedPolys = 0 Then - - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - scenNum = i - End If - Next - Scenery(scenNum).selected = 0 - If Not shiftDown Then - If scenNum = sceneryCount Then - Scenery(1).selected = 1 - Else - Scenery(scenNum + 1).selected = 1 - End If - Else - If scenNum = 1 Then - Scenery(sceneryCount).selected = 1 - Else - Scenery(scenNum - 1).selected = 1 - End If - End If - - Render - - End If - - getInfo - -End Sub - -Private Sub findDragPoint(X As Single, Y As Single) - - Dim i As Integer, j As Integer, k As Integer - Dim midCoords As D3DVECTOR2 - - 'check if user moused down on corner drag point of sel rect - For i = 0 To 3 - j = i + 2 - If j > 3 Then - j = i - 2 - End If - If nearCoord((selRect(i).X - scrollCoords(2).X) * zoomFactor, moveCoords(1).X, 8) And _ - nearCoord((selRect(i).Y - scrollCoords(2).Y) * zoomFactor, moveCoords(1).Y, 8) Then - If mnuFixedRCenter.Checked Then - rCenter.X = selRect(j).X - rCenter.Y = selRect(j).Y - End If - moveCoords(1).X = (selRect(i).X - scrollCoords(2).X) * zoomFactor - moveCoords(1).Y = (selRect(i).Y - scrollCoords(2).Y) * zoomFactor - X = moveCoords(1).X - Y = moveCoords(1).Y - toolAction = True - End If - Next - - If toolAction = False Then - For i = 0 To 3 - j = i + 2 - If j > 3 Then - j = i - 2 - End If - k = i + 1 - If k > 3 Then - k = 0 - End If - midCoords.X = Midpoint(selRect(i).X, selRect(k).X) - midCoords.Y = Midpoint(selRect(i).Y, selRect(k).Y) - k = i - 1 - If k < 0 Then - k = 3 - End If - If nearCoord((midCoords.X - scrollCoords(2).X) * zoomFactor, moveCoords(1).X, 8) And _ - nearCoord((midCoords.Y - scrollCoords(2).Y) * zoomFactor, moveCoords(1).Y, 8) Then - If mnuFixedRCenter.Checked Then - rCenter.X = Midpoint(selRect(j).X, selRect(k).X) - rCenter.Y = Midpoint(selRect(j).Y, selRect(k).Y) - End If - moveCoords(1).X = (midCoords.X - scrollCoords(2).X) * zoomFactor - moveCoords(1).Y = (midCoords.Y - scrollCoords(2).Y) * zoomFactor - X = moveCoords(1).X - Y = moveCoords(1).Y - toolAction = True - End If - Next - Render - End If - - -End Sub - -Private Sub findDragPoint2(X As Single, Y As Single) - - Dim i As Integer, j As Integer, k As Integer - Dim midCoords As D3DVECTOR2 - - toolAction = checkDragPoint(selRect(0).X, selRect(0).Y, selRect(2).X, selRect(2).Y) - If Not toolAction Then toolAction = checkDragPoint(selRect(1).X, selRect(1).Y, selRect(3).X, selRect(3).Y) - If Not toolAction Then toolAction = checkDragPoint(selRect(2).X, selRect(2).Y, selRect(0).X, selRect(0).Y) - If Not toolAction Then toolAction = checkDragPoint(selRect(3).X, selRect(3).Y, selRect(1).X, selRect(1).Y) - - midCoords.X = Midpoint(selRect(0).X, selRect(1).X) - midCoords.Y = Midpoint(selRect(0).Y, selRect(1).Y) - If Not toolAction Then toolAction = checkDragPoint(midCoords.X, midCoords.Y, Midpoint(selRect(2).X, selRect(3).X), Midpoint(selRect(2).Y, selRect(3).Y)) - midCoords.X = Midpoint(selRect(1).X, selRect(2).X) - midCoords.Y = Midpoint(selRect(1).Y, selRect(2).Y) - If Not toolAction Then toolAction = checkDragPoint(midCoords.X, midCoords.Y, Midpoint(selRect(3).X, selRect(0).X), Midpoint(selRect(3).Y, selRect(0).Y)) - midCoords.X = Midpoint(selRect(2).X, selRect(3).X) - midCoords.Y = Midpoint(selRect(2).Y, selRect(3).Y) - If Not toolAction Then toolAction = checkDragPoint(midCoords.X, midCoords.Y, Midpoint(selRect(0).X, selRect(1).X), Midpoint(selRect(0).Y, selRect(1).Y)) - midCoords.X = Midpoint(selRect(3).X, selRect(0).X) - midCoords.Y = Midpoint(selRect(3).Y, selRect(0).Y) - If Not toolAction Then toolAction = checkDragPoint(midCoords.X, midCoords.Y, Midpoint(selRect(1).X, selRect(2).X), Midpoint(selRect(1).Y, selRect(2).Y)) - -End Sub - -Private Function checkDragPoint(x1 As Single, y1 As Single, x2 As Single, y2 As Single) As Boolean - - If nearCoord((x1 - scrollCoords(2).X) * zoomFactor, moveCoords(1).X, 8) And nearCoord((y1 - scrollCoords(2).Y) * zoomFactor, moveCoords(1).Y, 8) Then - If mnuFixedRCenter.Checked Then - rCenter.X = x2 - rCenter.Y = y2 - End If - moveCoords(1).X = (x1 - scrollCoords(2).X) * zoomFactor - moveCoords(1).Y = (y1 - scrollCoords(2).Y) * zoomFactor - checkDragPoint = True - End If - -End Function - -Private Sub Form_DblClick() - - If currentTool = TOOL_CREATE Then 'poly creation - - toolAction = True - - ElseIf currentTool = TOOL_VSELECT Then 'vertex selection - - toolAction = True - - selectedCoords(1).X = MouseHelper.CursorX - (Me.left / Screen.TwipsPerPixelX) - 1 - selectedCoords(1).Y = MouseHelper.CursorY - (Me.Top / Screen.TwipsPerPixelY) - 1 - selectedCoords(2).X = selectedCoords(1).X - selectedCoords(2).Y = selectedCoords(1).Y - - Render - - End If - -End Sub - -Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - Dim i As Integer, j As Integer, k As Integer - - On Error GoTo ErrorHandler - - If acquired = False Then - DIDevice.Acquire - acquired = True - End If - - If Button = 2 Then 'popup menus - If currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD Then - Me.PopupMenu mnuPolyTypes - ElseIf currentTool = TOOL_MOVE Then - mouseCoords.X = X - mouseCoords.Y = Y - Me.PopupMenu mnuMove - ElseIf currentTool = TOOL_PSELECT Or currentTool = TOOL_VSELECT Then - Me.PopupMenu mnuVertexSelect - ElseIf currentFunction = TOOL_SCENERY Then - If tvwScenery.Visible = False Then - If Me.WindowState = vbMaximized Then - tvwScenery.left = mouseCoords.X - If mouseCoords.Y + tvwScenery.Height > Me.ScaleHeight - 17 Then - tvwScenery.Top = Me.ScaleHeight - tvwScenery.Height - 17 - Else - tvwScenery.Top = mouseCoords.Y - End If - Else - tvwScenery.left = 0 - tvwScenery.Top = 41 - End If - End If - tvwScenery.Visible = Not tvwScenery.Visible - ElseIf currentFunction = TOOL_OBJECTS Then - Me.PopupMenu mnuObjects, , X, Y - Render - ElseIf currentFunction = TOOL_WAYPOINT Then - Me.PopupMenu mnuWaypoint, , X, Y - End If - ElseIf Button = 4 Then - scrollCoords(1).X = X - scrollCoords(1).Y = Y - SetCursor TOOL_HAND + 1 - Else - If tvwScenery.Visible Then tvwScenery.Visible = False - End If - - If Button <> 1 Then Exit Sub - - If spaceDown Then - - scrollCoords(1).X = X - scrollCoords(1).Y = Y - - ElseIf currentFunction = TOOL_MOVE Then 'move - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - toolAction = True - MouseDownMove X, Y - - ElseIf currentFunction = TOOL_ROTATE Or currentFunction = TOOL_SCALE Then 'scaling/rotation - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - moveCoords(1).X = X - moveCoords(1).Y = Y - moveCoords(2).X = X - moveCoords(2).Y = Y - - findDragPoint2 X, Y - - ElseIf (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) Then 'poly creation - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If Shift = 0 Then - If Not (showPolys Or showWireframe Or showPoints) Then - showPolys = True - frmDisplay.setLayer 1, True - End If - toolAction = True - ElseIf Shift = KEY_SHIFT Then 'constrained - If Not (showPolys Or showWireframe Or showPoints) Then - showPolys = True - End If - toolAction = True - End If - - ElseIf currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB Then 'vertex selection - - toolAction = True - selectedCoords(1).X = X - selectedCoords(1).Y = Y - selectedCoords(2).X = X - selectedCoords(2).Y = Y - - ElseIf currentFunction = TOOL_PSELECT Or currentFunction = TOOL_PSELADD Or currentFunction = TOOL_PSELSUB Then 'poly selection - - polySelection X, Y - - ElseIf currentFunction = TOOL_VCOLOR Then 'vertex color - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - toolAction = True - If colorMode > 0 Then - VertexColoring X, Y - Else - PrecisionColoring X, Y - End If - - ElseIf currentFunction = TOOL_PCOLOR Then 'poly color - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - ColorFill X, Y - - ElseIf currentFunction = TOOL_TEXTURE Then 'texture - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If Shift = 0 Then - toolAction = True - MouseDownMove X, Y - ElseIf Shift = KEY_SHIFT Then 'constrained - toolAction = True - moveCoords(2).X = X - moveCoords(2).Y = Y - moveCoords(1).X = X - moveCoords(1).Y = Y - End If - - ElseIf currentFunction = TOOL_SCENERY Then - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If Not showScenery Then - showScenery = True - frmDisplay.setLayer 5, showScenery - End If - toolAction = True - - ElseIf currentFunction = TOOL_CLRPICKER Then 'color picker - - If currentTool = TOOL_DEPTHMAP Then - depthPicker X, Y - ElseIf currentTool = TOOL_SCENERY Then - Else - ColorPicker X, Y - End If - - ElseIf currentFunction = TOOL_PIXPICKER Then - - Dim tempClr As TColor - tempClr = getRGB(GetPixel(Me.hDC, X, Y)) - If frmPalette.Enabled = False Then - frmColor.InitClr tempClr.blue, tempClr.green, tempClr.red - Else - polyClr.red = tempClr.blue - polyClr.green = tempClr.green - polyClr.blue = tempClr.red - Scenery(0).Color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) - frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue - End If - - ElseIf currentFunction = TOOL_LITPICKER Then - - lightPicker X, Y - - ElseIf currentFunction = TOOL_OBJECTS Then 'objects - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If Not showObjects And Not mnuGostek.Checked Then - showObjects = True - frmDisplay.setLayer 6, showObjects - End If - If mnuGostek.Checked Then - gostek.X = X / zoomFactor + scrollCoords(2).X - gostek.Y = Y / zoomFactor + scrollCoords(2).Y - ElseIf Not mnuCollider.Checked Then - spawnPoints = spawnPoints + 1 - ReDim Preserve Spawns(spawnPoints) - - Spawns(spawnPoints).Team = Spawns(0).Team - Spawns(spawnPoints).X = X / zoomFactor + scrollCoords(2).X - Spawns(spawnPoints).Y = Y / zoomFactor + scrollCoords(2).Y - - If showGrid And snapToGrid Then - Spawns(spawnPoints).X = Int((Spawns(spawnPoints).X + inc / 2) / inc) * inc - Spawns(spawnPoints).Y = Int((Spawns(spawnPoints).Y + inc / 2) / inc) * inc - End If - Else - colliderCount = colliderCount + 1 - ReDim Preserve Colliders(colliderCount) - - Colliders(colliderCount).radius = Colliders(0).radius - Colliders(colliderCount).X = X / zoomFactor + scrollCoords(2).X - Colliders(colliderCount).Y = Y / zoomFactor + scrollCoords(2).Y - - If showGrid And snapToGrid Then - Colliders(colliderCount).X = Int((Colliders(colliderCount).X + inc / 2) / inc) * inc - Colliders(colliderCount).Y = Int((Colliders(colliderCount).Y + inc / 2) / inc) * inc - End If - End If - Render - toolAction = True - - ElseIf currentFunction = TOOL_WAYPOINT Then 'waypoints - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If Not showWaypoints Then - showWaypoints = True - frmDisplay.setLayer 7, showWaypoints - End If - - If frmWaypoints.showPaths = 1 And frmWaypoints.wayptPath = 1 Or frmWaypoints.showPaths = 2 And frmWaypoints.wayptPath = 0 Then - frmWaypoints.picShow_MouseUp 0, 1, 0, 0, 0 - mouseEvent2 frmWaypoints.picShow(0), 0, 0, BUTTON_SMALL, True, BUTTON_UP - End If - - mnuDeselect_Click - - waypointCount = waypointCount + 1 - ReDim Preserve Waypoints(waypointCount) - - Waypoints(waypointCount).selected = True - numSelWaypoints = numSelWaypoints + 1 - - Waypoints(waypointCount).X = X / zoomFactor + scrollCoords(2).X - Waypoints(waypointCount).Y = Y / zoomFactor + scrollCoords(2).Y - - Waypoints(waypointCount).pathNum = frmWaypoints.wayptPath + 1 - - For i = 0 To 4 - Waypoints(waypointCount).wayType(i) = mnuWayType(i).Checked - Next - - If currentWaypoint > 0 Then 'connecting waypoints - conCount = conCount + 1 - ReDim Preserve Connections(conCount) - Connections(conCount).point1 = currentWaypoint - Connections(conCount).point2 = waypointCount - Waypoints(waypointCount).numConnections = Waypoints(waypointCount).numConnections + 1 - currentWaypoint = waypointCount - End If - getInfo - Render - toolAction = True - - ElseIf currentFunction = TOOL_CONNECT Then - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - toolAction = True - - ElseIf currentFunction = TOOL_DEPTHMAP Then - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - EditDepthMap X, Y - - toolAction = True - - ElseIf currentFunction = TOOL_LIGHTS Then - - CreateLight X, Y - - ElseIf currentFunction = TOOL_SKETCH Then - - If Shift = 0 Then 'freeform - startSketch X, Y - toolAction = True - ElseIf Shift = 1 Then - showSketch = True - frmDisplay.setLayer 10, showSketch - End If - - ElseIf currentFunction = TOOL_ERASER Then - - If eraseSketch(X / zoomFactor + scrollCoords(2).X, Y / zoomFactor + scrollCoords(2).Y) = 1 Then - Render - End If - toolAction = True - - ElseIf currentFunction = TOOL_SMUDGE Then - - moveCoords(2).X = X - moveCoords(2).Y = Y - moveCoords(1).X = X - moveCoords(1).Y = Y - toolAction = True - - End If - - Exit Sub - -ErrorHandler: - - MsgBox Error$ - -End Sub - -Private Sub CreateLight(X As Single, Y As Single) - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - showLights = True - frmDisplay.setLayer 9, showLights - - lightCount = lightCount + 1 - ReDim Preserve Lights(lightCount) - Lights(lightCount).X = X / zoomFactor + scrollCoords(2).X - Lights(lightCount).Y = Y / zoomFactor + scrollCoords(2).Y - Lights(lightCount).z = 255 - Lights(lightCount).color = polyClr - Lights(lightCount).intensity = opacity - Lights(lightCount).range = 0 - - If showGrid And snapToGrid Then - Lights(lightCount).X = Int((Lights(lightCount).X + inc / 2) / inc) * inc - Lights(lightCount).Y = Int((Lights(lightCount).Y + inc / 2) / inc) * inc - End If - - applyLights - SaveUndo - Render - -End Sub - -Private Sub applyLights(Optional toSel As Boolean = False) - - Dim i As Integer, j As Integer, k As Integer - - Dim lightDir As D3DVECTOR - Dim polyNormal As D3DVECTOR - Dim v1 As D3DVECTOR, v2 As D3DVECTOR - Dim mag As Single - Dim diffuseFactor As Single - Dim totalDiffuse As Single - - Dim clr As TColor - - Dim rVal As Integer, gVal As Integer, bVal As Integer - - If lightCount = 0 Then Exit Sub - - For i = 1 To polyCount - - 'get poly vectors - v1.X = PolyCoords(i).vertex(1).X - PolyCoords(i).vertex(2).X - v1.Y = PolyCoords(i).vertex(1).Y - PolyCoords(i).vertex(2).Y - v1.z = Polys(i).vertex(1).z - Polys(i).vertex(2).z - - v2.X = PolyCoords(i).vertex(1).X - PolyCoords(i).vertex(3).X - v2.Y = PolyCoords(i).vertex(1).Y - PolyCoords(i).vertex(3).Y - v2.z = Polys(i).vertex(1).z - Polys(i).vertex(3).z - - 'get poly normal - polyNormal.X = (v1.Y * v2.z) - (v1.z * v2.Y) - polyNormal.Y = (v1.z * v2.X) - (v1.X * v2.z) - polyNormal.z = (v1.X * v2.Y) - (v1.Y * v2.X) - - 'normalize poly normal - mag = Sqr(polyNormal.X ^ 2 + polyNormal.Y ^ 2 + polyNormal.z ^ 2) - If mag > 0 Then - polyNormal.X = polyNormal.X / mag - polyNormal.Y = polyNormal.Y / mag - polyNormal.z = polyNormal.z / mag - End If - - For j = 1 To 3 - - If (vertexList(i).vertex(j) = 1 And toSel) Or toSel = False Then - - For k = 1 To lightCount - - 'get light dir vector - lightDir.X = Lights(k).X - PolyCoords(i).vertex(j).X - lightDir.Y = Lights(k).Y - PolyCoords(i).vertex(j).Y - lightDir.z = Lights(k).z - Polys(i).vertex(j).z - 'normalize light dir - mag = Sqr(lightDir.X ^ 2 + lightDir.Y ^ 2 + lightDir.z ^ 2) - If mag > 0 Then - lightDir.X = lightDir.X / mag - lightDir.Y = lightDir.Y / mag - lightDir.z = lightDir.z / mag - End If - 'get angle between light dir and poly normal (dot product) - diffuseFactor = (polyNormal.X * lightDir.X) + (polyNormal.Y * lightDir.Y) + (polyNormal.z * lightDir.z) - If diffuseFactor < 0 Then diffuseFactor = 0 - - If Lights(k).range = 0 Then 'normal - mag = 1 - Else 'range > 0 - If mag > 0 Then - If mag <= Lights(k).range Then - mag = 1 - mag / Lights(k).range - Else 'vertex is out of range - mag = 0 - End If - Else - mag = 0 - End If - End If - - 'calculate final color components - rVal = rVal + (Lights(k).color.red * diffuseFactor) * mag - gVal = gVal + (Lights(k).color.green * diffuseFactor) * mag - bVal = bVal + (Lights(k).color.blue * diffuseFactor) * mag - - totalDiffuse = totalDiffuse + diffuseFactor - - Next - - totalDiffuse = totalDiffuse / lightCount - - clr = vertexList(i).color(j) - rVal = rVal + clr.red - gVal = gVal + clr.green - bVal = bVal + clr.blue - - If rVal > 255 Then rVal = 255 - If gVal > 255 Then gVal = 255 - If bVal > 255 Then bVal = 255 - - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(Int(bVal), Int(gVal), Int(rVal))) - - rVal = 0 - gVal = 0 - bVal = 0 - totalDiffuse = 0 - - End If - - Next - - Next - - Render - -End Sub - -Private Sub applyLightsToVert(pIndex As Integer, vIndex As Integer) - - On Error GoTo ErrorHandler - - If lightCount <= 0 Or Not showLights Then Exit Sub - - Dim k As Integer - Dim lightDir As D3DVECTOR - Dim polyNormal As D3DVECTOR - Dim v1 As D3DVECTOR, v2 As D3DVECTOR - Dim mag As Single - Dim diffuseFactor As Single - Dim totalDiffuse As Single - Dim clr As TColor - Dim rVal As Integer, gVal As Integer, bVal As Integer - - 'get poly vectors - v1.X = PolyCoords(pIndex).vertex(1).X - PolyCoords(pIndex).vertex(2).X - v1.Y = PolyCoords(pIndex).vertex(1).Y - PolyCoords(pIndex).vertex(2).Y - v1.z = Polys(pIndex).vertex(1).z - Polys(pIndex).vertex(2).z - - v2.X = PolyCoords(pIndex).vertex(1).X - PolyCoords(pIndex).vertex(3).X - v2.Y = PolyCoords(pIndex).vertex(1).Y - PolyCoords(pIndex).vertex(3).Y - v2.z = Polys(pIndex).vertex(1).z - Polys(pIndex).vertex(3).z - - 'get poly normal - polyNormal.X = (v1.Y * v2.z) - (v1.z * v2.Y) - polyNormal.Y = (v1.z * v2.X) - (v1.X * v2.z) - polyNormal.z = (v1.X * v2.Y) - (v1.Y * v2.X) - - 'normalize poly normal - mag = Sqr(polyNormal.X ^ 2 + polyNormal.Y ^ 2 + polyNormal.z ^ 2) - If mag > 0 Then - polyNormal.X = polyNormal.X / mag - polyNormal.Y = polyNormal.Y / mag - polyNormal.z = polyNormal.z / mag - End If - - For k = 1 To lightCount - - 'get light dir vector - lightDir.X = Lights(k).X - PolyCoords(pIndex).vertex(vIndex).X - lightDir.Y = Lights(k).Y - PolyCoords(pIndex).vertex(vIndex).Y - lightDir.z = Lights(k).z - Polys(pIndex).vertex(vIndex).z - 'normalize light dir - mag = Sqr(lightDir.X ^ 2 + lightDir.Y ^ 2 + lightDir.z ^ 2) - If mag > 0 Then - lightDir.X = lightDir.X / mag - lightDir.Y = lightDir.Y / mag - lightDir.z = lightDir.z / mag - End If - 'get angle between light dir and poly normal (dot product) - diffuseFactor = (polyNormal.X * lightDir.X) + (polyNormal.Y * lightDir.Y) + (polyNormal.z * lightDir.z) - If diffuseFactor < 0 Then diffuseFactor = 0 - - 'calculate final color components - rVal = rVal + (Lights(k).color.red * diffuseFactor) - gVal = gVal + (Lights(k).color.green * diffuseFactor) - bVal = bVal + (Lights(k).color.blue * diffuseFactor) - - totalDiffuse = totalDiffuse + diffuseFactor - - Next - - totalDiffuse = totalDiffuse / lightCount - - clr = vertexList(pIndex).color(vIndex) - rVal = rVal + clr.red - gVal = gVal + clr.green - bVal = bVal + clr.blue - - If rVal > 255 Then rVal = 255 - If gVal > 255 Then gVal = 255 - If bVal > 255 Then bVal = 255 - - Polys(pIndex).vertex(vIndex).Color = ARGB(getAlpha(Polys(pIndex).vertex(vIndex).Color), RGB(Int(bVal), Int(gVal), Int(rVal))) - - rVal = 0 - gVal = 0 - bVal = 0 - totalDiffuse = 0 - - Exit Sub - -ErrorHandler: - - MsgBox Error$ - -End Sub - -Private Sub SnapSelection() - - Dim i As Integer, j As Integer, k As Integer, l As Integer - Dim PolyNum As Integer - - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - Polys(PolyNum).vertex(j).X = GetVertSnapCoord(PolyNum, j, 1) - Polys(PolyNum).vertex(j).Y = GetVertSnapCoord(PolyNum, j, 0) - If snapToGrid And showGrid Then - Polys(PolyNum).vertex(j).X = snapVertexToGrid(Polys(PolyNum).vertex(j).X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) - Polys(PolyNum).vertex(j).Y = snapVertexToGrid(Polys(PolyNum).vertex(j).Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) - End If - PolyCoords(PolyNum).vertex(j).X = Polys(PolyNum).vertex(j).X / zoomFactor + scrollCoords(2).X - PolyCoords(PolyNum).vertex(j).Y = Polys(PolyNum).vertex(j).Y / zoomFactor + scrollCoords(2).Y - End If - Next - Next - -End Sub - -Private Function GetVertSnapCoord(PolyNum As Integer, VertNum As Integer, GetXVal As Boolean) As Integer - - Dim i As Integer, j As Integer, xVal As Integer, yVal As Integer - Dim nearPoly As Integer, nearVert As Integer - Dim minDiff As Long, thisDiff As Long, prevDiff As Long - - xVal = Polys(PolyNum).vertex(VertNum).X - yVal = Polys(PolyNum).vertex(VertNum).Y - If GetXVal Then - GetVertSnapCoord = xVal - Else - GetVertSnapCoord = yVal - End If - - If ohSnap Then - nearPoly = -1 - minDiff = snapRadius ^ 2 + 1 - For i = 1 To polyCount - For j = 1 To 3 - If nearPoly = -1 Then - prevDiff = (Polys(i).vertex(j).X - xVal) ^ 2 + (Polys(i).vertex(j).Y - yVal) ^ 2 - If prevDiff < minDiff Then - nearPoly = i - nearVert = j - End If - End If - Next - Next - - If Not nearPoly = -1 Then - If GetXVal Then - GetVertSnapCoord = Polys(nearPoly).vertex(nearVert).X - Else - GetVertSnapCoord = Polys(nearPoly).vertex(nearVert).Y - End If - End If - End If - -End Function - -Private Sub AverageVerts() - - Dim i As Integer, j As Integer - Dim finalR As Integer, finalG As Integer, finalB As Integer - Dim tehClr As TColor - - For i = 1 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then - tehClr = getRGB(Polys(selectedPolys(i)).vertex(j).Color) - finalR = finalR + tehClr.red - finalG = finalG + tehClr.green - finalB = finalB + tehClr.blue - End If - Next - Next - - finalR = finalR / numSelectedPolys - finalG = finalG / numSelectedPolys - finalB = finalB / numSelectedPolys - - For i = 1 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then - Polys(selectedPolys(i)).vertex(j).Color = ARGB(getAlpha(Polys(selectedPolys(i)).vertex(j).Color), RGB(finalR, finalG, finalB)) - End If - Next - Next - -End Sub - -Private Sub AverageVertices() - - Dim i As Integer, j As Integer - Dim P As Integer, V As Integer - Dim finalR As Integer, finalG As Integer, finalB As Integer - Dim tehClr As TColor, vertexClr As TColor - Dim numVertices As Integer - Dim xVal As Single, yVal As Single - Dim connectedPolys() As Integer - Dim numConnectedPolys As Integer - - On Error GoTo ErrorHandler - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - Me.MousePointer = 11 - - If numSelectedPolys = 0 Then - - For i = 1 To polyCount - For j = 1 To 3 - If vertexList(i).vertex(j) = 0 Then - xVal = PolyCoords(i).vertex(j).X - yVal = PolyCoords(i).vertex(j).Y - finalR = 0 - finalG = 0 - finalB = 0 - For P = 1 To polyCount - For V = 1 To 3 - If nearCoord(xVal, PolyCoords(P).vertex(V).X, 2) And nearCoord(yVal, PolyCoords(P).vertex(V).Y, 2) Then - vertexList(P).vertex(V) = 1 - tehClr.red = vertexList(P).color(V).red - tehClr.green = vertexList(P).color(V).green - tehClr.blue = vertexList(P).color(V).blue - finalR = finalR + tehClr.red - finalG = finalG + tehClr.green - finalB = finalB + tehClr.blue - numConnectedPolys = numConnectedPolys + 1 - ReDim Preserve connectedPolys(numConnectedPolys) - connectedPolys(numConnectedPolys) = P - End If - Next - Next - finalR = finalR / numConnectedPolys - finalG = finalG / numConnectedPolys - finalB = finalB / numConnectedPolys - - For P = 1 To numConnectedPolys - For V = 1 To 3 - If vertexList(connectedPolys(P)).vertex(V) = 1 Then - vertexList(connectedPolys(P)).vertex(V) = 2 - vertexList(connectedPolys(P)).color(V).red = finalR - vertexList(connectedPolys(P)).color(V).green = finalG - vertexList(connectedPolys(P)).color(V).blue = finalB - Polys(connectedPolys(P)).vertex(V).Color = ARGB(getAlpha(Polys(connectedPolys(P)).vertex(V).Color), RGB(finalB, finalG, finalR)) - End If - Next - Next - numConnectedPolys = 0 - ReDim connectedPolys(0) - End If - Next - Next - - For i = 1 To polyCount - vertexList(i).vertex(1) = 0 - vertexList(i).vertex(2) = 0 - vertexList(i).vertex(3) = 0 - Next - - applyLights - - Else - - For i = 1 To polyCount - For j = 1 To 3 - If vertexList(i).vertex(j) = 1 Then - xVal = PolyCoords(i).vertex(j).X - yVal = PolyCoords(i).vertex(j).Y - finalR = 0 - finalG = 0 - finalB = 0 - For P = 1 To polyCount - For V = 1 To 3 - If nearCoord(xVal, PolyCoords(P).vertex(V).X, 2) And nearCoord(yVal, PolyCoords(P).vertex(V).Y, 2) Then - If vertexList(P).vertex(V) = 1 Then - vertexList(P).vertex(V) = 2 - tehClr.red = vertexList(P).color(V).red - tehClr.green = vertexList(P).color(V).green - tehClr.blue = vertexList(P).color(V).blue - finalR = finalR + tehClr.red - finalG = finalG + tehClr.green - finalB = finalB + tehClr.blue - numConnectedPolys = numConnectedPolys + 1 - ReDim Preserve connectedPolys(numConnectedPolys) - connectedPolys(numConnectedPolys) = P - End If - End If - Next - Next - finalR = finalR / numConnectedPolys - finalG = finalG / numConnectedPolys - finalB = finalB / numConnectedPolys - For P = 1 To numConnectedPolys - For V = 1 To 3 - If vertexList(connectedPolys(P)).vertex(V) = 2 Then - vertexList(connectedPolys(P)).vertex(V) = 3 - vertexList(connectedPolys(P)).color(V).red = finalR - vertexList(connectedPolys(P)).color(V).green = finalG - vertexList(connectedPolys(P)).color(V).blue = finalB - Polys(connectedPolys(P)).vertex(V).Color = ARGB(getAlpha(Polys(connectedPolys(P)).vertex(V).Color), RGB(finalB, finalG, finalR)) - End If - Next - Next - numConnectedPolys = 0 - ReDim connectedPolys(0) - End If - Next - Next - - For i = 1 To polyCount - For j = 1 To 3 - If vertexList(i).vertex(j) > 1 Then - vertexList(i).vertex(j) = 1 - End If - Next - Next - - applyLights True - - End If - - Me.MousePointer = 99 - - ctrlDown = False - currentFunction = currentTool - SetCursor currentFunction + 1 - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - SaveUndo - Render - - Exit Sub - -ErrorHandler: - - MsgBox "Error averaging colors" & vbNewLine & Error$ - -End Sub - -Private Sub MouseDownMove(X As Single, Y As Single) - - If numSelectedPolys + numSelectedScenery + numSelSpawns + numSelColliders + numSelWaypoints + numSelLights = 0 Then - noneSelected = True - SelNearest X, Y - End If - If snapToGrid And showGrid Then - X = snapVertexToGrid(X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) - Y = snapVertexToGrid(Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) - End If - moveCoords(1).X = X - moveCoords(1).Y = Y - moveCoords(2).X = X - moveCoords(2).Y = Y - -End Sub - -Private Sub SelNearest(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim addPoly As Integer, addVert As Integer, notSel As Integer - Dim currentDist As Long, shortestDist As Long - Dim xVal As Single, yVal As Single - - xVal = X / zoomFactor + scrollCoords(2).X - yVal = Y / zoomFactor + scrollCoords(2).Y - - addPoly = 0 - shortestDist = 64 ^ 2 + 1 - If showPolys Then - For i = 1 To polyCount - For j = 1 To 3 - If nearCoord(X, Polys(i).vertex(j).X, 8) And nearCoord(Y, Polys(i).vertex(j).Y, 8) Then 'move by vertex - If addPoly <> i Then - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = i - End If - vertexList(i).vertex(j) = 1 - addPoly = i - End If - Next - If (pointInPoly(X, Y, i)) And addPoly = 0 Then - For j = 1 To 3 - If nearCoord(X, Polys(i).vertex(j).X, 64) And nearCoord(Y, Polys(i).vertex(j).Y, 64) Then 'move by region - currentDist = (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - addPoly = i - addVert = j - End If - End If - Next - End If - Next - End If - - If numSelectedPolys = 0 And addPoly > 0 Then - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = addPoly - vertexList(addPoly).vertex(addVert) = 1 - End If - - If numSelectedPolys = 0 And addPoly = 0 And showScenery Then 'select scenery - For i = 1 To sceneryCount - If PointInProp(X, Y, i) And addPoly = 0 Then - Scenery(i).selected = 1 - numSelectedScenery = numSelectedScenery + 1 - addPoly = 1 - End If - Next - End If - - If addPoly = 0 And showObjects Then - notSel = 0 - shortestDist = (8 ^ 2 + 1) - For i = 1 To spawnPoints - Spawns(i).active = 0 - If nearCoord(xVal, Spawns(i).X, 8 / zoomFactor) And nearCoord(yVal, Spawns(i).Y, 8 / zoomFactor) Then - currentDist = (Spawns(i).X - xVal) ^ 2 + (Spawns(i).Y - yVal) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - notSel = i - End If - End If - Next - If notSel > 0 Then - Spawns(notSel).active = 1 - numSelSpawns = numSelSpawns + 1 - addPoly = notSel - End If - End If - - If addPoly = 0 And showObjects Then - notSel = 0 - shortestDist = 64 ^ 2 + 1 - For i = 1 To colliderCount - Colliders(i).active = 0 - If nearCoord(xVal, Colliders(i).X, Colliders(i).radius / 2) And nearCoord(yVal, Colliders(i).Y, Colliders(i).radius / 2) Then - currentDist = (Colliders(i).X - xVal) ^ 2 + (Colliders(i).Y - yVal) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - notSel = i - End If - End If - Next - If notSel > 0 Then - Colliders(notSel).active = 1 - numSelColliders = numSelColliders + 1 - addPoly = notSel - End If - - End If - - If addPoly = 0 And showWaypoints Then - - notSel = 0 - shortestDist = (8 ^ 2 + 1) - For i = 1 To waypointCount - Waypoints(i).selected = False - If nearCoord(xVal, Waypoints(i).X, 8 / zoomFactor) And nearCoord(yVal, Waypoints(i).Y, 8 / zoomFactor) Then - currentDist = (Waypoints(i).X - xVal) ^ 2 + (Waypoints(i).Y - yVal) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - notSel = i - End If - End If - Next - If notSel > 0 Then - Waypoints(notSel).selected = True - numSelWaypoints = numSelWaypoints + 1 - End If - - End If - - Render - -End Sub - -Private Sub CreatingPoly(Shift As Integer, X As Single, Y As Single) - - Dim xVal As Integer, yVal As Integer - Dim rtheta As D3DVECTOR2 - - xVal = X - yVal = Y - - If Shift = KEY_SHIFT Then - rtheta = ConstrainAngle(X - Polys(polyCount + 1).vertex(numVerts).X, Y - Polys(polyCount + 1).vertex(numVerts).Y) - xVal = Polys(polyCount + 1).vertex(numVerts).X + rtheta.X * Cos(rtheta.Y) - yVal = Polys(polyCount + 1).vertex(numVerts).Y + rtheta.X * Sin(rtheta.Y) - End If - - If snapToGrid And showGrid Then - xVal = snapVertexToGrid(xVal, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) - yVal = snapVertexToGrid(yVal, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) - End If - - Polys(polyCount + 1).vertex(numVerts + 1).X = xVal - Polys(polyCount + 1).vertex(numVerts + 1).Y = yVal - - PolyCoords(polyCount + 1).vertex(numVerts + 1).X = xVal / zoomFactor + scrollCoords(2).X - PolyCoords(polyCount + 1).vertex(numVerts + 1).Y = yVal / zoomFactor + scrollCoords(2).Y - - If mnuCustomX.Checked And mnuQuad.Checked Then - If creatingQuad Then - Polys(polyCount + 1).vertex(numVerts + 1).tu = (frmTexture.x1tex * 2 + 0.5) / xTexture - Else - If numVerts = 1 Or numVerts = 2 Then - Polys(polyCount + 1).vertex(numVerts + 1).tu = (frmTexture.x2tex * 2 - 0.5) / xTexture - Else - Polys(polyCount + 1).vertex(numVerts + 1).tu = (frmTexture.x1tex * 2 + 0.5) / xTexture - End If - End If - Else - Polys(polyCount + 1).vertex(numVerts + 1).tu = (xVal / zoomFactor + scrollCoords(2).X) / xTexture - End If - - If mnuCustomY.Checked And mnuQuad.Checked Then - If creatingQuad Then - Polys(polyCount + 1).vertex(numVerts + 1).tv = (frmTexture.y2tex * 2 - 0.5) / yTexture - Else - If numVerts > 1 Then - Polys(polyCount + 1).vertex(numVerts + 1).tv = (frmTexture.y2tex * 2 - 0.5) / yTexture - Else - Polys(polyCount + 1).vertex(numVerts + 1).tv = (frmTexture.y1tex * 2 + 0.5) / yTexture - End If - End If - Else - Polys(polyCount + 1).vertex(numVerts + 1).tv = (yVal / zoomFactor + scrollCoords(2).Y) / yTexture - End If - - Polys(polyCount + 1).vertex(numVerts + 1).Color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) - - Render - -End Sub - -Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - On Error GoTo ErrorHandler - - 'if not in focus and not properties in focus and not text in focus - If Screen.ActiveForm.hWnd <> Me.hWnd And Screen.ActiveForm.hWnd <> frmInfo.hWnd Then - If Not (Screen.ActiveForm.hWnd = frmPalette.hWnd And frmPalette.textControl) Then - RegainFocus - End If - End If - - mouseCoords.X = X - mouseCoords.Y = Y - - lblMousePosition.Caption = "Position: " & Round(X / zoomFactor + scrollCoords(2).X) & ", " & Round(Y / zoomFactor + scrollCoords(2).Y) - - 'draw circle - If circleOn Then - Render - End If - - If Button = 4 Or Button = 5 Then 'scrolling - Scrolling X, Y - End If - - If (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) And toolAction Then - If (Shift = 0 Or Shift = KEY_SHIFT) And numVerts > 0 Then 'poly creation - CreatingPoly Shift, X, Y - End If - ElseIf Button = 0 And currentFunction = TOOL_SCENERY Then - CreatingScenery Shift, X, Y - ElseIf Button = 0 And currentFunction = TOOL_OBJECTS And Shift < 2 Then - Spawns(0).X = X - Spawns(0).Y = Y - Colliders(0).X = X - Colliders(0).Y = Y - Render - ElseIf Button = 0 And (currentFunction = TOOL_WAYPOINT Or currentFunction = TOOL_CONNECT) And currentWaypoint > 0 Then - Render - ElseIf Button = 0 And currentFunction = TOOL_SKETCH And toolAction Then - sketch(0).vertex(2).X = X / zoomFactor + scrollCoords(2).X - sketch(0).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y - Render - End If - - If Button <> 1 Then Exit Sub - - - If spaceDown Then 'scrolling - - If currentFunction = TOOL_SCENERY And numCorners = 0 Then - Scenery(0).screenTr.X = X - Scenery(0).screenTr.Y = Y - ElseIf currentFunction = TOOL_OBJECTS Then - If Not mnuCollider.Checked Then - Spawns(0).X = X - Spawns(0).Y = Y - ElseIf mnuCollider.Checked Then - Colliders(0).X = X - Colliders(0).Y = Y - End If - End If - - Scrolling X, Y - - If Button = 5 Then - moveCoords(1).X = X - moveCoords(1).Y = Y - End If - - ElseIf currentFunction = TOOL_MOVE And toolAction Then 'moving - - If Shift = KEY_SHIFT Then 'constrained - If Abs(X - moveCoords(2).X) > Abs(Y - moveCoords(2).Y) Then - Y = moveCoords(2).Y - Else - X = moveCoords(2).X - End If - End If - Moving X, Y - - ElseIf currentFunction = TOOL_SCALE And toolAction Then 'scaling - - If Shift = KEY_CTRL Then - Scaling X, Y, False - ElseIf Shift = KEY_SHIFT + KEY_CTRL Then 'constrained scaling - Scaling X, Y, True - End If - - ElseIf currentFunction = TOOL_ROTATE And toolAction Then 'rotating - - If Shift = KEY_ALT Then - Rotating X, Y, False - ElseIf Shift = KEY_SHIFT + KEY_ALT Then 'constrained rotating - Rotating X, Y, True - End If - - ElseIf (currentFunction = TOOL_CREATE Or currentFunction = TOOL_CREATE) And toolAction Then 'poly creation -------- - - ElseIf currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB Then 'vertex selection -------- - - If toolAction Then - Render - selectedCoords(2).X = X - selectedCoords(2).Y = Y - End If - - ElseIf currentFunction = TOOL_PSELECT And toolAction Then 'poly selection - - ElseIf currentFunction = TOOL_VCOLOR And toolAction Then ' vertex coloring - - If colorMode > 0 Then - VertexColoring X, Y - End If - - ElseIf currentFunction = TOOL_PCOLOR Then 'poly coloring - - ElseIf currentFunction = TOOL_TEXTURE And toolAction Then 'texture - - If Shift = 0 Then - StretchingTexture X, Y - ElseIf Shift = KEY_SHIFT Then - If Abs(X - moveCoords(2).X) > Abs(Y - moveCoords(2).Y) Then - Y = moveCoords(2).Y - Else - X = moveCoords(2).X - End If - StretchingTexture X, Y - End If - - ElseIf currentFunction = TOOL_SCENERY Then 'scenery - - ElseIf currentFunction = TOOL_CLRPICKER Then 'color picker - - If currentTool = TOOL_DEPTHMAP Then - depthPicker X, Y - ElseIf currentTool = TOOL_SCENERY Then - - Else - ColorPicker X, Y - End If - - ElseIf currentFunction = TOOL_PIXPICKER Then 'pixel picker - - Dim tempClr As TColor - tempClr = getRGB(GetPixel(Me.hDC, X, Y)) - If frmPalette.Enabled = False Then - frmColor.InitClr tempClr.blue, tempClr.green, tempClr.red - Else - polyClr.red = tempClr.blue - polyClr.green = tempClr.green - polyClr.blue = tempClr.red - Scenery(0).Color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) - frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue - End If - - Render - - ElseIf currentFunction = TOOL_LITPICKER Then 'light picker - - ElseIf currentFunction = TOOL_OBJECTS Then 'objects - - Spawns(0).X = X - Spawns(0).Y = Y - If mnuGostek.Checked Then - gostek.X = X / zoomFactor + scrollCoords(2).X - gostek.Y = Y / zoomFactor + scrollCoords(2).Y - Render - End If - - ElseIf currentFunction = TOOL_WAYPOINT And toolAction Then 'waypoints - - ElseIf currentFunction = TOOL_DEPTHMAP And toolAction Then 'depthmap - - EditDepthMap X, Y - - ElseIf currentFunction = TOOL_SKETCH And toolAction Then 'sketch - - If Shift = 0 Then 'freeform - linkSketch X, Y - sketch(sketchLines).vertex(2).X = X / zoomFactor + scrollCoords(2).X - sketch(sketchLines).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y - Render - ElseIf Shift = KEY_SHIFT Then 'lines - sketch(0).vertex(2).X = X / zoomFactor + scrollCoords(2).X - sketch(0).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y - Render - End If - - ElseIf currentFunction = TOOL_ERASER And toolAction Then - - If eraseSketch(X / zoomFactor + scrollCoords(2).X, Y / zoomFactor + scrollCoords(2).Y) = 1 Then - Render - End If - - ElseIf currentFunction = TOOL_SMUDGE And toolAction Then - - If moveLines(X / zoomFactor + scrollCoords(2).X, Y / zoomFactor + scrollCoords(2).Y, X - moveCoords(2).X, Y - moveCoords(2).Y) = 1 Then - Render - End If - moveCoords(2).X = X - moveCoords(2).Y = Y - - End If - - Exit Sub - -ErrorHandler: - - MsgBox "form_mousemove error" & vbNewLine & Error$ - -End Sub - -Private Sub CreatingScenery(Shift As Integer, X As Single, Y As Single) - - Dim xVal As Single, yVal As Single - Dim angle As Single - - xVal = X - yVal = Y - - If snapToGrid And showGrid Then - xVal = Int(snapVertexToGrid(X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + 0.5) - yVal = Int(snapVertexToGrid(Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + 0.5) - End If - - If numCorners = 0 Then - Scenery(0).screenTr.X = xVal - Scenery(0).screenTr.Y = yVal - End If - - xVal = xVal - Int(Scenery(0).screenTr.X + 0.5) - yVal = yVal - Int(Scenery(0).screenTr.Y + 0.5) - - angle = GetAngle(xVal, yVal) - - If numCorners = 1 And toolAction Then - - If Shift = 1 Then - angle = (Int((angle * 180 / pi + 0) / 15) * 15) / 180 * pi - End If - - Scenery(0).rotation = angle - - ElseIf numCorners = 2 And toolAction Then - - angle = angle - Scenery(0).rotation - - Scenery(0).Scaling.X = (Cos(angle) * Sqr(xVal ^ 2 + yVal ^ 2)) / (SceneryTextures(Scenery(0).Style).Width) / zoomFactor - Scenery(0).Scaling.Y = -(Sin(angle) * Sqr(xVal ^ 2 + yVal ^ 2)) / (SceneryTextures(Scenery(0).Style).Height) / zoomFactor - - If Shift = 1 Then - If Scenery(0).Scaling.X < 0 Then - Scenery(0).Scaling.X = -Sqr((xVal ^ 2 + yVal ^ 2) / (SceneryTextures(Scenery(0).Style).Width ^ 2 + SceneryTextures(Scenery(0).Style).Height ^ 2)) / zoomFactor - Else - Scenery(0).Scaling.X = Sqr((xVal ^ 2 + yVal ^ 2) / (SceneryTextures(Scenery(0).Style).Width ^ 2 + SceneryTextures(Scenery(0).Style).Height ^ 2)) / zoomFactor - End If - If Scenery(0).Scaling.Y * Scenery(0).Scaling.X < 0 Then - Scenery(0).Scaling.Y = -Scenery(0).Scaling.X - Else - Scenery(0).Scaling.Y = Scenery(0).Scaling.X - End If - End If - - End If - - Render - -End Sub - -Private Function ConstrainAngle(xDiff As Integer, yDiff As Integer) As D3DVECTOR2 - - Dim theta As Single - Dim R As Single - - R = Sqr(xDiff ^ 2 + yDiff ^ 2) - If xDiff = 0 Then - If yDiff > 0 Then - theta = pi / 2 - Else - theta = 3 * pi / 2 - End If - ElseIf xDiff > 0 Then - theta = Atn(yDiff / xDiff) - ElseIf xDiff < 0 Then - theta = pi + Atn(yDiff / xDiff) - End If - - theta = (Int((theta * 180 / pi + 7.5) / 15) * 15) / 180 * pi - - ConstrainAngle.X = R - ConstrainAngle.Y = theta - -End Function - -Private Sub Scrolling(X As Single, Y As Single) - - Dim i As Integer - - scrollCoords(2).X = scrollCoords(2).X - (X - scrollCoords(1).X) / zoomFactor - scrollCoords(2).Y = scrollCoords(2).Y - (Y - scrollCoords(1).Y) / zoomFactor - - For i = 1 To polyCount 'move polys - Polys(i).vertex(1).X = Polys(i).vertex(1).X + X - scrollCoords(1).X - Polys(i).vertex(1).Y = Polys(i).vertex(1).Y + Y - scrollCoords(1).Y - Polys(i).vertex(2).X = Polys(i).vertex(2).X + X - scrollCoords(1).X - Polys(i).vertex(2).Y = Polys(i).vertex(2).Y + Y - scrollCoords(1).Y - Polys(i).vertex(3).X = Polys(i).vertex(3).X + X - scrollCoords(1).X - Polys(i).vertex(3).Y = Polys(i).vertex(3).Y + Y - scrollCoords(1).Y - Next - - For i = 1 To 4 'move background - bgPolys(i).X = bgPolys(i).X + X - scrollCoords(1).X - bgPolys(i).Y = bgPolys(i).Y + Y - scrollCoords(1).Y - Next - - For i = 1 To sceneryCount - Scenery(i).screenTr.X = Scenery(i).screenTr.X + X - scrollCoords(1).X - Scenery(i).screenTr.Y = Scenery(i).screenTr.Y + Y - scrollCoords(1).Y - Next - - If numVerts > 0 Then 'move existing vertices of poly being created - For i = 1 To 3 - Polys(polyCount + 1).vertex(i).X = Polys(polyCount + 1).vertex(i).X + X - scrollCoords(1).X - Polys(polyCount + 1).vertex(i).Y = Polys(polyCount + 1).vertex(i).Y + Y - scrollCoords(1).Y - Next - End If - - If numCorners > 0 Then - Scenery(0).screenTr.X = Scenery(0).screenTr.X + X - scrollCoords(1).X - Scenery(0).screenTr.Y = Scenery(0).screenTr.Y + Y - scrollCoords(1).Y - ElseIf currentFunction = TOOL_SCENERY And numCorners = 0 Then - Scenery(0).screenTr.X = X - Scenery(0).screenTr.Y = Y - ElseIf currentFunction = TOOL_OBJECTS Then - Spawns(0).X = X - Spawns(0).Y = Y - Colliders(0).X = X - Colliders(0).Y = Y - End If - - If (currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB) And toolAction Then - selectedCoords(1).X = selectedCoords(1).X + X - scrollCoords(1).X - selectedCoords(1).Y = selectedCoords(1).Y + Y - scrollCoords(1).Y - selectedCoords(2).X = X - selectedCoords(2).Y = Y - End If - - scrollCoords(1).X = X - scrollCoords(1).Y = Y - - Render - - If (currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB) And toolAction Then - Render - End If - -End Sub - -Private Sub Moving(ByVal X As Single, ByVal Y As Single) - - Dim i As Integer, j As Integer - Dim PolyNum As Integer - Dim xDiff As Single, yDiff As Single - Dim xVal As Single, yVal As Single - - If snapToGrid And showGrid And toolAction Then - X = snapVertexToGrid(X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) - Y = snapVertexToGrid(Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) - End If - - xVal = X - moveCoords(1).X - yVal = Y - moveCoords(1).Y - - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - xDiff = Polys(PolyNum).vertex(j).tu - PolyCoords(PolyNum).vertex(j).X / xTexture - yDiff = Polys(PolyNum).vertex(j).tv - PolyCoords(PolyNum).vertex(j).Y / yTexture - PolyCoords(PolyNum).vertex(j).X = PolyCoords(PolyNum).vertex(j).X + xVal / zoomFactor - PolyCoords(PolyNum).vertex(j).Y = PolyCoords(PolyNum).vertex(j).Y + yVal / zoomFactor - 'switch - Polys(PolyNum).vertex(j).X = (PolyCoords(PolyNum).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(PolyNum).vertex(j).Y = (PolyCoords(PolyNum).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - - If fixedTexture Then - Polys(PolyNum).vertex(j).tu = (Polys(PolyNum).vertex(j).X / zoomFactor + scrollCoords(2).X) / xTexture + xDiff - Polys(PolyNum).vertex(j).tv = (Polys(PolyNum).vertex(j).Y / zoomFactor + scrollCoords(2).Y) / yTexture + yDiff - End If - End If - Next - Next - - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - Scenery(i).Translation.X = Scenery(i).Translation.X + xVal / zoomFactor - Scenery(i).Translation.Y = Scenery(i).Translation.Y + yVal / zoomFactor - Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor - Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor - End If - Next - - For i = 1 To spawnPoints - If Spawns(i).active = 1 Then - Spawns(i).X = Spawns(i).X + xVal / zoomFactor - Spawns(i).Y = Spawns(i).Y + yVal / zoomFactor - End If - Next - For i = 1 To colliderCount - If Colliders(i).active = 1 Then - Colliders(i).X = Colliders(i).X + xVal / zoomFactor - Colliders(i).Y = Colliders(i).Y + yVal / zoomFactor - End If - Next - - For i = 1 To lightCount - If Lights(i).selected = 1 Then - Lights(i).X = Lights(i).X + xVal / zoomFactor - Lights(i).Y = Lights(i).Y + yVal / zoomFactor - End If - Next - - For i = 1 To waypointCount - If Waypoints(i).selected = True Then - Waypoints(i).X = Waypoints(i).X + xVal / zoomFactor - Waypoints(i).Y = Waypoints(i).Y + yVal / zoomFactor - End If - Next - - rCenter.X = rCenter.X + xVal / zoomFactor - rCenter.Y = rCenter.Y + yVal / zoomFactor - - For i = 0 To 3 - selRect(i).X = selRect(i).X + xVal / zoomFactor - selRect(i).Y = selRect(i).Y + yVal / zoomFactor - Next - - moveCoords(1).X = X - moveCoords(1).Y = Y - - getInfo - - prompt = True - - Render - -End Sub - -Private Sub Scaling(ByVal X As Single, ByVal Y As Single, constrained As Boolean) - - Dim i As Integer, j As Integer - Dim xVal As Single, yVal As Single - Dim xCenter As Single, yCenter As Single - Dim PolyNum As Integer - Dim theta As Single - - xCenter = (rCenter.X - scrollCoords(2).X) * zoomFactor - yCenter = (rCenter.Y - scrollCoords(2).Y) * zoomFactor - - If snapToGrid And showGrid Then - X = snapVertexToGrid(X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) - Y = snapVertexToGrid(Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) - End If - - If Not constrained Then - If moveCoords(1).X = xCenter Then - scaleDiff.X = 1 - Else - scaleDiff.X = 1 + (X - moveCoords(1).X) / (moveCoords(1).X - xCenter) - End If - If moveCoords(1).Y = yCenter Then - scaleDiff.Y = 1 - Else - scaleDiff.Y = 1 + (Y - moveCoords(1).Y) / (moveCoords(1).Y - yCenter) - End If - Else - If (moveCoords(1).X - xCenter) * (moveCoords(1).Y - yCenter) > 0 Then - scaleDiff.X = (((X - xCenter) + (Y - yCenter)) / ((moveCoords(1).X - xCenter) + (moveCoords(1).Y - yCenter))) - scaleDiff.Y = scaleDiff.X - Else - scaleDiff.X = (((X - xCenter) - (Y - yCenter)) / ((moveCoords(1).X - xCenter) - (moveCoords(1).Y - yCenter))) - scaleDiff.Y = scaleDiff.X - End If - - End If - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - Polys(PolyNum).vertex(j).X = ((rCenter.X + (PolyCoords(PolyNum).vertex(j).X - rCenter.X) * scaleDiff.X) - scrollCoords(2).X) * zoomFactor - Polys(PolyNum).vertex(j).Y = ((rCenter.Y + (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) * scaleDiff.Y) - scrollCoords(2).Y) * zoomFactor - End If - Next - Next - End If - - If numSelectedScenery > 0 Then - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - Scenery(i).screenTr.X = (rCenter.X + (Scenery(i).Translation.X - rCenter.X) * scaleDiff.X - scrollCoords(2).X) * zoomFactor - Scenery(i).screenTr.Y = (rCenter.Y + (Scenery(i).Translation.Y - rCenter.Y) * scaleDiff.Y - scrollCoords(2).Y) * zoomFactor - End If - Next - End If - - moveCoords(2).X = X - moveCoords(2).Y = Y - - frmInfo.txtScale(0).Text = Int(scaleDiff.X * 1000) / 10 - frmInfo.txtScale(1).Text = Int(scaleDiff.Y * 1000) / 10 - - prompt = True - - Render - -End Sub - -Private Sub ApplyTransform(Rotating As Boolean) - - Dim i As Integer, j As Integer - Dim pNum As Integer - Dim temp As D3DVECTOR2 - Dim tempVertex As TCustomVertex - Dim vertSel As Byte - Dim xVal As Single, yVal As Single - Dim angle As Single, theta As Single - Dim R As Single - Dim tempClr As TColor - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - For i = 1 To numSelectedPolys - pNum = selectedPolys(i) - For j = 1 To 3 - - PolyCoords(pNum).vertex(j).X = Polys(pNum).vertex(j).X / zoomFactor + scrollCoords(2).X - PolyCoords(pNum).vertex(j).Y = Polys(pNum).vertex(j).Y / zoomFactor + scrollCoords(2).Y - - If (scaleDiff.X * scaleDiff.Y < 0) Then - 'make sure polys are cw - If Not isCW(pNum) Then 'switch to make cw - temp = PolyCoords(pNum).vertex(3) - PolyCoords(pNum).vertex(3) = PolyCoords(pNum).vertex(2) - PolyCoords(pNum).vertex(2) = temp - - tempVertex = Polys(pNum).vertex(3) - Polys(pNum).vertex(3) = Polys(pNum).vertex(2) - Polys(pNum).vertex(2) = tempVertex - - vertSel = vertexList(pNum).vertex(3) - vertexList(pNum).vertex(3) = vertexList(pNum).vertex(2) - vertexList(pNum).vertex(2) = vertSel - - tempClr = vertexList(pNum).color(3) - vertexList(pNum).color(3) = vertexList(pNum).color(2) - vertexList(pNum).color(2) = tempClr - End If - End If - Next - Next - - If numSelectedScenery > 0 Then - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - - Scenery(i).Translation.X = Scenery(i).screenTr.X / zoomFactor + scrollCoords(2).X - Scenery(i).Translation.Y = Scenery(i).screenTr.Y / zoomFactor + scrollCoords(2).Y - - If Not Rotating Then - - xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X - yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y - angle = GetAngle(xVal, yVal) + Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - xVal = Cos(angle) * R * scaleDiff.X - yVal = -Sin(angle) * R * scaleDiff.Y - angle = GetAngle(xVal, yVal) - Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - Scenery(i).Scaling.X = (Cos(angle) * R) / (SceneryTextures(Scenery(i).Style).Width) - Scenery(i).Scaling.Y = -(Sin(angle) * R) / (SceneryTextures(Scenery(i).Style).Height) - - End If - - If scaleDiff.X * scaleDiff.Y < 0 And Rotating Then - Scenery(i).rotation = -(Scenery(i).rotation - rDiff) - Else - Scenery(i).rotation = (Scenery(i).rotation - rDiff) - End If - End If - Next - End If - - If Not Rotating Then - For i = 0 To 3 - selRect(i).X = rCenter.X + (selRect(i).X - rCenter.X) * scaleDiff.X - selRect(i).Y = rCenter.Y + (selRect(i).Y - rCenter.Y) * scaleDiff.Y - Next - Else - For i = 0 To 3 - xVal = (selRect(i).X - rCenter.X) - yVal = (selRect(i).Y - rCenter.Y) - R = Sqr((xVal) ^ 2 + (yVal) ^ 2) 'distance of point from rotation center - angle = GetAngle(xVal, yVal) - rDiff - selRect(i).X = rCenter.X + R * Cos(angle) - selRect(i).Y = rCenter.Y + R * -Sin(angle) - Next - End If - - scaleDiff.X = 1 - scaleDiff.Y = 1 - - rDiff = 0 - - getRCenter - - SaveUndo - - getInfo - - Render - -End Sub - -Public Sub applyScale(tehXvalue As Single, tehYvalue As Single) - - Dim i As Integer, j As Integer - Dim PolyNum As Integer - Dim vertSel As Byte - Dim temp As D3DVECTOR2 - Dim tempVertex As TCustomVertex - Dim xVal As Single, yVal As Single - Dim R As Single, angle As Single - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - scaleDiff.X = tehXvalue - scaleDiff.Y = tehYvalue - - rCenter.X = Midpoint(selRect(0).X, selRect(2).X) - rCenter.Y = Midpoint(selRect(0).Y, selRect(2).Y) - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - PolyCoords(PolyNum).vertex(j).X = (rCenter.X + (PolyCoords(PolyNum).vertex(j).X - rCenter.X) * scaleDiff.X) - PolyCoords(PolyNum).vertex(j).Y = (rCenter.Y + (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) * scaleDiff.Y) - Polys(PolyNum).vertex(j).X = (PolyCoords(PolyNum).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(PolyNum).vertex(j).Y = (PolyCoords(PolyNum).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - End If - Next - - 'make sure polys are cw - If Not isCW(PolyNum) Then 'switch to make cw - temp = PolyCoords(PolyNum).vertex(3) - PolyCoords(PolyNum).vertex(3) = PolyCoords(PolyNum).vertex(2) - PolyCoords(PolyNum).vertex(2) = temp - - tempVertex = Polys(PolyNum).vertex(3) - Polys(PolyNum).vertex(3) = Polys(PolyNum).vertex(2) - Polys(PolyNum).vertex(2) = tempVertex - - vertSel = vertexList(PolyNum).vertex(3) - vertexList(PolyNum).vertex(3) = vertexList(PolyNum).vertex(2) - vertexList(PolyNum).vertex(2) = vertSel - End If - Next - End If - - If numSelectedScenery > 0 Then - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - - Scenery(i).Translation.X = rCenter.X + (Scenery(i).Translation.X - rCenter.X) * scaleDiff.X - Scenery(i).Translation.Y = rCenter.Y + (Scenery(i).Translation.Y - rCenter.Y) * scaleDiff.Y - - Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor - Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor - - xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X - yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y - angle = GetAngle(xVal, yVal) + Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - xVal = Cos(angle) * R * scaleDiff.X - yVal = -Sin(angle) * R * scaleDiff.Y - angle = GetAngle(xVal, yVal) - Scenery(i).rotation - R = Sqr(xVal ^ 2 + yVal ^ 2) - - Scenery(i).Scaling.X = (Cos(angle) * R) / (SceneryTextures(Scenery(i).Style).Width) - Scenery(i).Scaling.Y = -(Sin(angle) * R) / (SceneryTextures(Scenery(i).Style).Height) - End If - Next - End If - - 'MESS! - If numSelSpawns > 0 Then - For i = 1 To spawnPoints - If Spawns(i).active = 1 Then - Spawns(i).X = rCenter.X + (Spawns(i).X - rCenter.X) * scaleDiff.X - Spawns(i).Y = rCenter.Y + (Spawns(i).Y - rCenter.Y) * scaleDiff.Y - End If - Next - End If - - If numSelColliders > 0 Then - For i = 1 To colliderCount - If Colliders(i).active = 1 Then - Colliders(i).X = rCenter.X + (Colliders(i).X - rCenter.X) * scaleDiff.X - Colliders(i).Y = rCenter.Y + (Colliders(i).Y - rCenter.Y) * scaleDiff.Y - End If - Next - End If - - If numSelLights > 0 Then - For i = 1 To lightCount - If Lights(i).selected = 1 Then - Lights(i).X = rCenter.X + (Lights(i).X - rCenter.X) * scaleDiff.X - Lights(i).Y = rCenter.Y + (Lights(i).Y - rCenter.Y) * scaleDiff.Y - End If - Next - End If - - If numSelWaypoints > 0 Then - For i = 1 To waypointCount - If Waypoints(i).selected = True Then - Waypoints(i).X = rCenter.X + (Waypoints(i).X - rCenter.X) * scaleDiff.X - Waypoints(i).Y = rCenter.Y + (Waypoints(i).Y - rCenter.Y) * scaleDiff.Y - End If - Next - End If - - scaleDiff.X = 1 - scaleDiff.Y = 1 - - getRCenter - getInfo - SaveUndo - Render - -End Sub - -Public Sub applyRotate(tehValue As Single) - - Dim R As Single, theta As Single - Dim xDiff As Single, yDiff As Single - Dim i As Integer, j As Integer - Dim PolyNum As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - rDiff = tehValue - - rCenter.X = Midpoint(selRect(0).X, selRect(2).X) - rCenter.Y = Midpoint(selRect(0).Y, selRect(2).Y) - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - xDiff = (PolyCoords(PolyNum).vertex(j).X - rCenter.X) - yDiff = (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) - - theta = rDiff - - PolyCoords(PolyNum).vertex(j).X = (Cos(theta) * xDiff - Sin(theta) * yDiff) + rCenter.X - PolyCoords(PolyNum).vertex(j).Y = (Sin(theta) * xDiff + Cos(theta) * yDiff) + rCenter.Y - - Polys(PolyNum).vertex(j).X = (PolyCoords(PolyNum).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(PolyNum).vertex(j).Y = (PolyCoords(PolyNum).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - End If - Next - Next - End If - - If numSelectedScenery > 0 Then - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - xDiff = (Scenery(i).Translation.X - rCenter.X) - yDiff = (Scenery(i).Translation.Y - rCenter.Y) - - R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center - If xDiff = 0 Then - If yDiff > 0 Then - theta = pi / 2 - Else - theta = 3 * pi / 2 - End If - ElseIf xDiff > 0 Then - theta = Atn(yDiff / xDiff) - ElseIf xDiff < 0 Then - theta = pi + Atn(yDiff / xDiff) - End If - theta = theta + rDiff - - Scenery(i).Translation.X = rCenter.X + R * Cos(theta) - Scenery(i).Translation.Y = rCenter.Y + R * Sin(theta) - - Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor - Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor - - If scaleDiff.X * scaleDiff.Y < 0 Then - Scenery(i).rotation = -(Scenery(i).rotation - rDiff) - Else - Scenery(i).rotation = (Scenery(i).rotation - rDiff) - End If - End If - Next - End If - - 'MESS! - If numSelSpawns > 0 Then - For i = 1 To spawnPoints - If Spawns(i).active = 1 Then - xDiff = (Spawns(i).X - rCenter.X) - yDiff = (Spawns(i).Y - rCenter.Y) - theta = rDiff - Spawns(i).X = (Cos(theta) * xDiff - Sin(theta) * yDiff) + rCenter.X - Spawns(i).Y = (Sin(theta) * xDiff + Cos(theta) * yDiff) + rCenter.Y - End If - Next - End If - - If numSelColliders > 0 Then - For i = 1 To colliderCount - If Colliders(i).active = 1 Then - xDiff = (Colliders(i).X - rCenter.X) - yDiff = (Colliders(i).Y - rCenter.Y) - theta = rDiff - Colliders(i).X = (Cos(theta) * xDiff - Sin(theta) * yDiff) + rCenter.X - Colliders(i).Y = (Sin(theta) * xDiff + Cos(theta) * yDiff) + rCenter.Y - End If - Next - End If - - If numSelLights > 0 Then - For i = 1 To lightCount - If Lights(i).selected = 1 Then - xDiff = (Lights(i).X - rCenter.X) - yDiff = (Lights(i).Y - rCenter.Y) - theta = rDiff - Lights(i).X = (Cos(theta) * xDiff - Sin(theta) * yDiff) + rCenter.X - Lights(i).Y = (Sin(theta) * xDiff + Cos(theta) * yDiff) + rCenter.Y - End If - Next - End If - - If numSelWaypoints > 0 Then - For i = 1 To waypointCount - If Waypoints(i).selected = True Then - xDiff = (Waypoints(i).X - rCenter.X) - yDiff = (Waypoints(i).Y - rCenter.Y) - theta = rDiff - Waypoints(i).X = (Cos(theta) * xDiff - Sin(theta) * yDiff) + rCenter.X - Waypoints(i).Y = (Sin(theta) * xDiff + Cos(theta) * yDiff) + rCenter.Y - End If - Next - End If - - rCenter.X = selRect(0).X - rCenter.Y = selRect(0).Y - rDiff = 0 - - getRCenter - getInfo - SaveUndo - Render - -End Sub - - -Private Function GetAngle(ByVal xVal As Single, ByVal yVal As Single) As Single - - If xVal < 0 Then - GetAngle = pi - Atn(yVal / xVal) - ElseIf xVal > 0 Then - If Atn(yVal / xVal) > 0 Then - GetAngle = 2 * pi - Atn(yVal / xVal) - Else - GetAngle = -Atn(yVal / xVal) - End If - Else - If yVal > 0 Then - GetAngle = 3 * pi / 2 - Else - GetAngle = pi / 2 - End If - End If - -End Function - -Private Sub Rotating(X As Single, Y As Single, constrained As Boolean) - - Dim i As Integer, j As Integer - Dim angle As Single, oldAngle As Single - Dim xCenter As Single, yCenter As Single - Dim xDiff As Integer, yDiff As Integer - Dim PolyNum As Integer - Dim R As Single, theta As Single - - If snapToGrid And showGrid Then - X = snapVertexToGrid(X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) - Y = snapVertexToGrid(Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) - End If - - xCenter = (rCenter.X - scrollCoords(2).X) * zoomFactor - yCenter = (rCenter.Y - scrollCoords(2).Y) * zoomFactor - If xCenter = moveCoords(1).X Then - If moveCoords(1).Y - yCenter > 0 Then - oldAngle = pi / 2 - Else - oldAngle = 3 * pi / 2 - End If - ElseIf moveCoords(1).X - xCenter > 0 Then - oldAngle = Atn((moveCoords(1).Y - yCenter) / (moveCoords(1).X - xCenter)) - ElseIf moveCoords(1).X - xCenter < 0 Then - oldAngle = pi + Atn((moveCoords(1).Y - yCenter) / (moveCoords(1).X - xCenter)) - End If - - If xCenter = X Then - If Y - yCenter > 0 Then - angle = pi / 2 - Else - angle = 3 * pi / 2 - End If - ElseIf X - xCenter > 0 Then - angle = Atn((Y - yCenter) / (X - xCenter)) - ElseIf X - xCenter < 0 Then - angle = pi + Atn((Y - yCenter) / (X - xCenter)) - End If - - rDiff = angle - oldAngle - - If constrained Then - rDiff = (Int((rDiff * 180 / pi + 7.5) / 15) * 15) / 180 * pi - End If - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - xDiff = (PolyCoords(PolyNum).vertex(j).X - rCenter.X) * zoomFactor - yDiff = (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) * zoomFactor - - R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center - If xDiff = 0 Then - If yDiff > 0 Then - theta = pi / 2 + rDiff - Else - theta = 3 * pi / 2 + rDiff - End If - ElseIf xDiff > 0 Then - theta = Atn(yDiff / xDiff) + rDiff - ElseIf xDiff < 0 Then - theta = pi + Atn(yDiff / xDiff) + rDiff - End If - - Polys(PolyNum).vertex(j).X = xCenter + R * Cos(theta) - Polys(PolyNum).vertex(j).Y = yCenter + R * Sin(theta) - End If - Next - Next - End If - - If numSelectedScenery > 0 Then - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - xDiff = (Scenery(i).Translation.X - rCenter.X) * zoomFactor - yDiff = (Scenery(i).Translation.Y - rCenter.Y) * zoomFactor - - R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center - If xDiff = 0 Then - If yDiff > 0 Then - theta = pi / 2 + rDiff - Else - theta = 3 * pi / 2 + rDiff - End If - ElseIf xDiff > 0 Then - theta = Atn(yDiff / xDiff) + rDiff - ElseIf xDiff < 0 Then - theta = pi + Atn(yDiff / xDiff) + rDiff - End If - - Scenery(i).screenTr.X = xCenter + R * Cos(theta) - Scenery(i).screenTr.Y = yCenter + R * Sin(theta) - End If - Next - End If - - If numSelWaypoints Then - For i = 1 To waypointCount - If Waypoints(i).selected Then - xDiff = (Scenery(i).Translation.X - rCenter.X) * zoomFactor - yDiff = (Scenery(i).Translation.Y - rCenter.Y) * zoomFactor - - R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center - If xDiff = 0 Then - If yDiff > 0 Then - theta = pi / 2 + rDiff - Else - theta = 3 * pi / 2 + rDiff - End If - ElseIf xDiff > 0 Then - theta = Atn(yDiff / xDiff) + rDiff - ElseIf xDiff < 0 Then - theta = pi + Atn(yDiff / xDiff) + rDiff - End If - - Scenery(i).screenTr.X = xCenter + R * Cos(theta) - Scenery(i).screenTr.Y = yCenter + R * Sin(theta) - End If - Next - End If - - moveCoords(2).X = X - moveCoords(2).Y = Y - - frmInfo.txtRotate.Text = Int(rDiff / pi * 180 * 100) / 100 - - prompt = True - - Render - -End Sub - -Private Sub PrecisionColoring(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim closestPoly As Single, closestVert As Single - Dim currentDist As Long, shortestDist As Long - Dim PolyNum As Integer - Dim destClr As TColor - Dim R As Integer - - R = clrRadius * zoomFactor - - shortestDist = R ^ 2 + 1 - If numSelectedPolys > 0 Then - - For i = 1 To numSelectedPolys 'find closest - PolyNum = selectedPolys(i) - If pointInPoly(X, Y, i) Then - For j = 1 To 3 - If nearCoord(X, Polys(PolyNum).vertex(j).X, R) And nearCoord(Y, Polys(PolyNum).vertex(j).Y, R) Then - currentDist = (Polys(PolyNum).vertex(j).X - X) ^ 2 + (Polys(PolyNum).vertex(j).Y - Y) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - closestPoly = PolyNum - closestVert = j - End If - End If - Next - End If - Next - - If closestPoly > 0 And closestVert > 0 Then - destClr = getRGB(Polys(closestPoly).vertex(closestVert).Color) - destClr = applyBlend(destClr) - Polys(closestPoly).vertex(closestVert).Color = ARGB(getAlpha(Polys(closestPoly).vertex(closestVert).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(closestPoly).color(closestVert).red = destClr.red - vertexList(closestPoly).color(closestVert).green = destClr.green - vertexList(closestPoly).color(closestVert).blue = destClr.blue - End If - - Else - - For i = 1 To polyCount 'find closest - If pointInPoly(X, Y, i) Then - For j = 1 To 3 - If nearCoord(X, Polys(i).vertex(j).X, R) And nearCoord(Y, Polys(i).vertex(j).Y, R) Then - currentDist = (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - closestPoly = i - closestVert = j - End If - End If - Next - End If - Next - - If closestPoly > 0 And closestVert > 0 Then - destClr = getRGB(Polys(closestPoly).vertex(closestVert).Color) - destClr = applyBlend(destClr) - Polys(closestPoly).vertex(closestVert).Color = ARGB(getAlpha(Polys(closestPoly).vertex(closestVert).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(closestPoly).color(closestVert).red = destClr.red - vertexList(closestPoly).color(closestVert).green = destClr.green - vertexList(closestPoly).color(closestVert).blue = destClr.blue - End If - - End If - - prompt = True - - Render - -End Sub - -Private Sub VertexColoring(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim pNum As Integer - Dim destClr As TColor - Dim R As Integer - Dim colored As Boolean - - R = clrRadius * zoomFactor - - If numSelectedPolys > 0 And (showPolys Or showWireframe Or showPoints) Then - - For i = 1 To numSelectedPolys - pNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(pNum).vertex(j) = 1 Then - If nearCoord(X, Polys(pNum).vertex(j).X, R) And nearCoord(Y, Polys(pNum).vertex(j).Y, R) Then - If (Polys(pNum).vertex(j).X - X) ^ 2 + (Polys(pNum).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then - destClr = getRGB(Polys(pNum).vertex(j).Color) - destClr = applyBlend(destClr) - Polys(pNum).vertex(j).Color = ARGB(getAlpha(Polys(pNum).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(pNum).color(j).red = destClr.red - vertexList(pNum).color(j).green = destClr.green - vertexList(pNum).color(j).blue = destClr.blue - If lightCount > 0 Then applyLightsToVert pNum, j - If colorMode = 1 Then vertexList(pNum).vertex(j) = 3 - colored = True - End If - End If - End If - Next - Next - - ElseIf (showPolys Or showWireframe Or showPoints) And numSelectedScenery = 0 Then - - For i = 1 To polyCount - For j = 1 To 3 - If vertexList(i).vertex(j) = 0 Then - If nearCoord(X, Polys(i).vertex(j).X, R) And nearCoord(Y, Polys(i).vertex(j).Y, R) Then - If (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then - destClr = getRGB(Polys(i).vertex(j).Color) - destClr = applyBlend(destClr) - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(i).color(j).red = destClr.red - vertexList(i).color(j).green = destClr.green - vertexList(i).color(j).blue = destClr.blue - If lightCount > 0 Then applyLightsToVert i, j - If colorMode = 1 Then vertexList(i).vertex(j) = 2 - colored = True - End If - End If - End If - Next - Next - - End If - - If numSelectedScenery > 0 And showScenery Then - - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - If nearCoord(X, Scenery(i).screenTr.X, R) And nearCoord(Y, Scenery(i).screenTr.Y, R) Then - If (Scenery(i).screenTr.X - X) ^ 2 + (Scenery(i).screenTr.Y - Y) ^ 2 <= R ^ 2 Then - destClr = getRGB(Scenery(i).Color) - destClr = applyBlend(destClr) - Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) - If colorMode = 1 Then Scenery(i).selected = 3 - colored = True - End If - End If - End If - Next - - ElseIf showScenery And numSelectedPolys = 0 Then - - For i = 1 To sceneryCount - If Scenery(i).selected = 0 Then - If nearCoord(X, Scenery(i).screenTr.X, R) And nearCoord(Y, Scenery(i).screenTr.Y, R) Then - If (Scenery(i).screenTr.X - X) ^ 2 + (Scenery(i).screenTr.Y - Y) ^ 2 <= R ^ 2 Then - destClr = getRGB(Scenery(i).Color) - destClr = applyBlend(destClr) - Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) - If colorMode = 1 Then Scenery(i).selected = 2 - colored = True - End If - End If - End If - Next - - End If - - If colored Then - prompt = True - Render - End If - -End Sub - -Private Sub EditDepthMap(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim pNum As Integer - Dim destClr As TColor - Dim R As Integer - Dim edited As Boolean - - R = clrRadius * zoomFactor - - If numSelectedPolys > 0 And (showPolys Or showWireframe Or showPoints) Then - - For i = 1 To numSelectedPolys - pNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(pNum).vertex(j) = 1 Then - If nearCoord(X, Polys(pNum).vertex(j).X, R) And nearCoord(Y, Polys(pNum).vertex(j).Y, R) Then - If (Polys(pNum).vertex(j).X - X) ^ 2 + (Polys(pNum).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then - Polys(pNum).vertex(j).z = Polys(pNum).vertex(j).z * (1 - opacity) + polyClr.red * opacity - If colorMode = 1 Then vertexList(pNum).vertex(j) = 3 - edited = True - End If - End If - End If - Next - Next - - ElseIf (showPolys Or showWireframe Or showPoints) And numSelectedScenery = 0 Then - - For i = 1 To polyCount - For j = 1 To 3 - If vertexList(i).vertex(j) = 0 Then - If nearCoord(X, Polys(i).vertex(j).X, R) And nearCoord(Y, Polys(i).vertex(j).Y, R) Then - If (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then - Polys(i).vertex(j).z = Polys(i).vertex(j).z * (1 - opacity) + polyClr.red * opacity - If colorMode = 1 Then vertexList(i).vertex(j) = 2 - edited = True - End If - End If - End If - Next - Next - - End If - - If edited Then - prompt = True - Render - End If - -End Sub - -Private Sub ColorPicker(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim shortestDist As Integer, currentDist As Integer - Dim pNum As Integer, vNum As Integer - Dim tempClr As TColor - - If showPolys Or showWireframe Or showPoints Then - - shortestDist = 32 ^ 2 + 1 - For i = 1 To polyCount - If pointInPoly(X, Y, i) Then - For j = 1 To 3 - If nearCoord(X, Polys(i).vertex(j).X, 32) And nearCoord(Y, Polys(i).vertex(j).Y, 32) Then - currentDist = (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - pNum = i - vNum = j - End If - End If - Next - End If - Next - - End If - - If vNum > 0 Then 'poly color absorbed - tempClr = vertexList(pNum).color(vNum) - If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then - - ElseIf frmPalette.Enabled = False Then 'non modal - frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue - Else - polyClr = tempClr - Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) - frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue - frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue - End If - ElseIf showScenery Then 'no poly clrs absorbed, do scenery - For i = 1 To sceneryCount - If PointInProp(X, Y, i) And vNum = 0 Then - vNum = i - End If - Next - If vNum > 0 Then - tempClr = getRGB(Scenery(vNum).Color) - If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then - - ElseIf frmPalette.Enabled = False Then 'non modal - frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue - Else - polyClr = tempClr - Scenery(0).Color = ARGB(Scenery(0).alpha, Scenery(vNum).Color) - frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue - frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue - End If - End If - End If - -End Sub - -Private Sub depthPicker(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim shortestDist As Integer, currentDist As Integer - Dim pNum As Integer, vNum As Integer - - If showPolys Or showWireframe Or showPoints Then - - shortestDist = 32 ^ 2 + 1 - For i = 1 To polyCount - If pointInPoly(X, Y, i) Then - For j = 1 To 3 - If nearCoord(X, Polys(i).vertex(j).X, 32) And nearCoord(Y, Polys(i).vertex(j).Y, 32) Then - currentDist = (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - pNum = i - vNum = j - End If - End If - Next - End If - Next - - End If - - If vNum > 0 Then 'poly color absorbed - If Polys(pNum).vertex(vNum).z >= 0 And Polys(pNum).vertex(vNum).z <= 255 Then - polyClr.red = Polys(pNum).vertex(vNum).z - ElseIf Polys(pNum).vertex(vNum).z < 0 Then - polyClr.red = 0 - ElseIf Polys(pNum).vertex(vNum).z > 255 Then - polyClr.red = 255 - End If - polyClr.green = polyClr.red - polyClr.blue = polyClr.red - Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) - frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue - frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue - End If - -End Sub - -Private Sub lightPicker(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim shortestDist As Integer, currentDist As Integer - Dim pNum As Integer, vNum As Integer - Dim tempClr As TColor - - If showPolys Or showWireframe Or showPoints Then - - shortestDist = 32 ^ 2 + 1 - For i = 1 To polyCount - If pointInPoly(X, Y, i) Then - For j = 1 To 3 - If nearCoord(X, Polys(i).vertex(j).X, 32) And nearCoord(Y, Polys(i).vertex(j).Y, 32) Then - currentDist = (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - pNum = i - vNum = j - End If - End If - Next - End If - Next - - End If - - If vNum > 0 Then 'poly color absorbed - - tempClr = getRGB(Polys(pNum).vertex(vNum).Color) - If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then - - ElseIf frmPalette.Enabled = False Then 'non modal - frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue - Else - polyClr = tempClr - Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) - frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue - frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue - End If - - End If - -End Sub - -Private Sub StretchingTexture(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim PolyNum As Integer - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - Polys(PolyNum).vertex(j).tu = (Polys(PolyNum).vertex(j).tu - (X - moveCoords(1).X) / zoomFactor / xTexture) - Polys(PolyNum).vertex(j).tv = (Polys(PolyNum).vertex(j).tv - (Y - moveCoords(1).Y) / zoomFactor / yTexture) - End If - Next - Next - moveCoords(1).X = X - moveCoords(1).Y = Y - prompt = True - End If - - getInfo - - Render - -End Sub - -Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - Dim i As Integer, j As Integer - - If Button = 4 Then - SetCursor currentFunction + 1 - End If - - If Button <> 1 Then - Exit Sub - End If - - If spaceDown Then - - Render - - ElseIf currentFunction = TOOL_MOVE And toolAction Then 'snap selected vertex - - If Shift = KEY_SHIFT Then 'constrained, don't snap - Else - snapSelected X, Y - If noneSelected Then - mnuDeselect_Click - noneSelected = False - End If - End If - - If lightCount > 0 And showLights Then - If numSelLights > 0 Then - applyLights - Render - ElseIf numSelectedPolys > 0 Then - applyLights True - Render - End If - End If - - SaveUndo - - ElseIf currentFunction = TOOL_SCALE And toolAction Then 'apply scaling - - If Shift = KEY_CTRL Then - ApplyTransform False - ElseIf Shift = KEY_SHIFT + KEY_CTRL Then 'constrained scaling - ApplyTransform False - End If - - ElseIf currentFunction = TOOL_ROTATE And toolAction Then 'apply rotation - - If Shift = KEY_ALT Then - ApplyTransform True - ElseIf Shift = KEY_SHIFT + KEY_ALT Then 'constrained rotation - ApplyTransform True - End If - - ElseIf (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) And toolAction Then 'create polys - - If Shift = KEY_SHIFT And numVerts > 0 Then - X = Polys(polyCount + 1).vertex(numVerts + 1).X - Y = Polys(polyCount + 1).vertex(numVerts + 1).Y - End If - CreatePolys X, Y - - ElseIf currentFunction = TOOL_SCENERY And toolAction Then 'create scenery - - CreateScenery X, Y - - ElseIf currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB Then 'select vertices - - If toolAction Then - selectedCoords(2).X = X - selectedCoords(2).Y = Y - eraseLines = False - noRedraw = True - If selectedCoords(2).X = selectedCoords(1).X And selectedCoords(2).Y = selectedCoords(1).Y Then - regionSelection X, Y - Else - VertexSelection X, Y - End If - noRedraw = False - selectedCoords(1).X = X - selectedCoords(1).Y = Y - Render - If numSelectedPolys = 0 And numSelectedScenery = 0 And numSelLights = 0 And numSelSpawns = 0 And numSelWaypoints = 0 And numSelColliders = 1 Then - For i = 1 To colliderCount - If Colliders(i).active = 1 Then - frmPalette.txtRadius.Text = LTrim$(Str$(Colliders(i).radius)) - setRadius CInt(Colliders(i).radius) - End If - Next - End If - End If - - ElseIf currentFunction = TOOL_PSELECT And toolAction Then 'poly selection - - ElseIf currentFunction = TOOL_VCOLOR And toolAction Then 'vertex coloring - - toolAction = False - If colorMode = 1 Then - For i = 1 To polyCount - For j = 1 To 3 - If vertexList(i).vertex(j) > 1 Then - vertexList(i).vertex(j) = vertexList(i).vertex(j) - 2 - End If - Next - Next - For i = 1 To sceneryCount - If Scenery(i).selected > 1 Then - Scenery(i).selected = Scenery(i).selected - 2 - End If - Next - End If - SaveUndo - - ElseIf currentFunction = TOOL_PCOLOR And toolAction Then 'poly color - - ElseIf currentFunction = TOOL_TEXTURE And toolAction Then 'texture - - SaveUndo - - ElseIf currentFunction = TOOL_OBJECTS And toolAction Then 'objects - - SaveUndo - - ElseIf currentFunction = TOOL_WAYPOINT And toolAction Then 'waypoints - - SaveUndo - - ElseIf currentFunction = TOOL_CONNECT And toolAction Then - - CreateConnection X, Y - - ElseIf currentFunction = TOOL_SKETCH Then - - If Shift = 0 And toolAction Then 'freeform - endSketch X, Y - toolAction = False - ElseIf Shift = 1 Then 'lines - If toolAction Then - lineSketch X, Y - Else - toolAction = True - End If - sketch(0).vertex(1).X = X / zoomFactor + scrollCoords(2).X - sketch(0).vertex(1).Y = Y / zoomFactor + scrollCoords(2).Y - sketch(0).vertex(2).X = X / zoomFactor + scrollCoords(2).X - sketch(0).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y - End If - - deleteSmallLines - - ElseIf currentFunction = TOOL_ERASER Then - - toolAction = False - - ElseIf currentFunction = TOOL_DEPTHMAP Then - - toolAction = False - If colorMode = 1 Then - For i = 1 To polyCount - For j = 1 To 3 - If vertexList(i).vertex(j) > 1 Then - vertexList(i).vertex(j) = vertexList(i).vertex(j) - 2 - End If - Next - Next - End If - SaveUndo - - End If - - If currentFunction <> TOOL_CREATE And currentFunction <> TOOL_QUAD And currentFunction <> TOOL_SKETCH And currentFunction <> TOOL_SCENERY Then - If numVerts = 0 Then - toolAction = False - End If - End If - - If noneSelected Then - mnuDeselect_Click - noneSelected = False - End If - - If numSelWaypoints = 0 And frmWaypoints.Visible = True Then - frmWaypoints.ClearWaypt - End If - - selectedCoords(1).X = 0 - selectedCoords(1).Y = 0 - selectedCoords(2).X = 0 - selectedCoords(2).Y = 0 - -End Sub - -Private Sub CreateConnection(X As Single, Y As Single) - - Dim i As Integer - Dim notSel As Integer - Dim currentDist As Long, shortestDist As Long - Dim xVal As Single, yVal As Single - - xVal = X / zoomFactor + scrollCoords(2).X - yVal = Y / zoomFactor + scrollCoords(2).Y - - notSel = 0 - shortestDist = (8 ^ 2 + 1) - For i = 1 To waypointCount - If (Waypoints(i).pathNum = 1 And frmWaypoints.showPaths <> 2) Or (Waypoints(i).pathNum = 2 And frmWaypoints.showPaths <> 1) Then - If nearCoord(xVal, Waypoints(i).X, 8 / zoomFactor) And nearCoord(yVal, Waypoints(i).Y, 8 / zoomFactor) Then - currentDist = (Waypoints(i).X - xVal) ^ 2 + (Waypoints(i).Y - yVal) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - notSel = i - End If - End If - End If - Next - If notSel > 0 And currentWaypoint <> notSel Then - If currentWaypoint > 0 Then 'connecting waypoints - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - conCount = conCount + 1 - ReDim Preserve Connections(conCount) - Connections(conCount).point1 = currentWaypoint - Connections(conCount).point2 = notSel - Waypoints(currentWaypoint).numConnections = Waypoints(currentWaypoint).numConnections + 1 - SaveUndo - End If - currentWaypoint = notSel - ElseIf notSel > 0 Then - currentWaypoint = notSel - Else - currentWaypoint = 0 - For i = 1 To waypointCount - Waypoints(i).selected = False - Next - numSelWaypoints = 0 - End If - - getInfo - Render - -End Sub - -Private Sub CreatePolys(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim xVal As Single, yVal As Single - Dim shortestDist As Integer, currentDist As Long - Dim temp As D3DVECTOR2 - Dim tempVertex As TCustomVertex - - If numVerts = 0 Then - ReDim Preserve Polys(polyCount + 1) - ReDim Preserve PolyCoords(polyCount + 1) - ReDim Preserve vertexList(polyCount + 1) - vertexList(polyCount + 1).polyType = polyType - End If - numVerts = numVerts + 1 - - xVal = X - yVal = Y - - If snapToGrid And showGrid Then - xVal = snapVertexToGrid(xVal, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) - yVal = snapVertexToGrid(yVal, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) - PolyCoords(polyCount + 1).vertex(numVerts).X = Int(xVal / zoomFactor + scrollCoords(2).X + 0.5) - PolyCoords(polyCount + 1).vertex(numVerts).Y = Int(yVal / zoomFactor + scrollCoords(2).Y + 0.5) - ElseIf ohSnap Then 'snap - shortestDist = snapRadius ^ 2 + 1 - For i = 1 To polyCount - For j = 1 To 3 - If nearCoord(xVal, Polys(i).vertex(j).X, shortestDist) And nearCoord(yVal, Polys(i).vertex(j).Y, shortestDist) Then - currentDist = ((Polys(i).vertex(j).X - xVal) ^ 2 + (Polys(i).vertex(j).Y - yVal) ^ 2) - If currentDist < shortestDist Then - shortestDist = currentDist - xVal = Polys(i).vertex(j).X - yVal = Polys(i).vertex(j).Y - PolyCoords(polyCount + 1).vertex(numVerts).X = PolyCoords(i).vertex(j).X - PolyCoords(polyCount + 1).vertex(numVerts).Y = PolyCoords(i).vertex(j).Y - End If - End If - Next - Next - End If - - If (xVal = X And yVal = Y) Or (Not ohSnap And Not snapToGrid) Then 'no snapping occured - PolyCoords(polyCount + 1).vertex(numVerts).X = Int(xVal / zoomFactor + scrollCoords(2).X + 0.5) - PolyCoords(polyCount + 1).vertex(numVerts).Y = Int(yVal / zoomFactor + scrollCoords(2).Y + 0.5) - End If - - Polys(polyCount + 1).vertex(numVerts) = CreateCustomVertex(xVal, yVal, _ - 0, 1, ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)), _ - (xVal / zoomFactor + scrollCoords(2).X) / xTexture, (yVal / zoomFactor + scrollCoords(2).Y) / yTexture) - vertexList(polyCount + 1).color(numVerts).red = polyClr.red - vertexList(polyCount + 1).color(numVerts).green = polyClr.green - vertexList(polyCount + 1).color(numVerts).blue = polyClr.blue - - If mnuQuad.Checked And mnuCustomX.Checked Then - If creatingQuad Then - Polys(polyCount + 1).vertex(numVerts).tu = (frmTexture.x1tex * 2 + 0.5) / xTexture - Else - If numVerts = 2 Or numVerts = 3 Then - Polys(polyCount + 1).vertex(numVerts).tu = (frmTexture.x2tex * 2 - 0.5) / xTexture - Else - Polys(polyCount + 1).vertex(numVerts).tu = (frmTexture.x1tex * 2 + 0.5) / xTexture - End If - End If - End If - - If mnuQuad.Checked And mnuCustomY.Checked Then - If creatingQuad Then - Polys(polyCount + 1).vertex(numVerts).tv = (frmTexture.y2tex * 2 - 0.5) / yTexture - Else - If numVerts > 2 Then - Polys(polyCount + 1).vertex(numVerts).tv = (frmTexture.y2tex * 2 - 0.5) / yTexture - Else - Polys(polyCount + 1).vertex(numVerts).tv = (frmTexture.y1tex * 2 + 0.5) / yTexture - End If - End If - End If - - - If numVerts = 1 Then - Polys(polyCount + 1).vertex(2) = Polys(polyCount + 1).vertex(1) - Polys(polyCount + 1).vertex(numVerts + 1).X = X - Polys(polyCount + 1).vertex(numVerts + 1).Y = Y - Polys(polyCount + 1).vertex(numVerts + 2) = Polys(polyCount + 1).vertex(1) - PolyCoords(polyCount + 1).vertex(numVerts + 2) = PolyCoords(polyCount + 1).vertex(1) - ElseIf numVerts = 3 Then - numVerts = 0 - polyCount = polyCount + 1 - If Not isCW(polyCount) Then 'switch to make cw - temp = PolyCoords(polyCount).vertex(3) - PolyCoords(polyCount).vertex(3) = PolyCoords(polyCount).vertex(2) - PolyCoords(polyCount).vertex(2) = temp - - tempVertex = Polys(polyCount).vertex(3) - Polys(polyCount).vertex(3) = Polys(polyCount).vertex(2) - Polys(polyCount).vertex(2) = tempVertex - End If - toolAction = False - frmInfo.lblCount(0).Caption = polyCount - frmInfo.lblCount(6).Caption = getMapDimensions - - applyLightsToVert CInt(polyCount), 1 - applyLightsToVert CInt(polyCount), 2 - applyLightsToVert CInt(polyCount), 3 - - Polys(polyCount).Perp.vertex(1).z = 2 - Polys(polyCount).Perp.vertex(2).z = 2 - Polys(polyCount).Perp.vertex(3).z = 2 - - SaveUndo - If mnuQuad.Checked And Not creatingQuad Then - ReDim Preserve Polys(polyCount + 1) - ReDim Preserve PolyCoords(polyCount + 1) - ReDim Preserve vertexList(polyCount + 1) - vertexList(polyCount + 1).polyType = polyType - Polys(polyCount + 1).vertex(1) = Polys(polyCount).vertex(1) - Polys(polyCount + 1).vertex(2) = Polys(polyCount).vertex(3) - PolyCoords(polyCount + 1).vertex(1) = PolyCoords(polyCount).vertex(1) - PolyCoords(polyCount + 1).vertex(2) = PolyCoords(polyCount).vertex(3) - vertexList(polyCount + 1).color(1) = vertexList(polyCount).color(1) - vertexList(polyCount + 1).color(2) = vertexList(polyCount).color(3) - numVerts = 2 - Polys(polyCount + 1).vertex(3) = Polys(polyCount).vertex(3) - PolyCoords(polyCount + 1).vertex(3) = PolyCoords(polyCount).vertex(3) - toolAction = True - creatingQuad = True - ElseIf creatingQuad Then - creatingQuad = False - End If - prompt = True - End If - - Render - -End Sub - -Private Sub startSketch(X As Single, Y As Single) - - On Error GoTo ErrorHandler - - showSketch = True - frmDisplay.setLayer 10, showSketch - - sketchLines = sketchLines + 1 - ReDim Preserve sketch(sketchLines) - - sketch(sketchLines).vertex(1).X = X / zoomFactor + scrollCoords(2).X - sketch(sketchLines).vertex(1).Y = Y / zoomFactor + scrollCoords(2).Y - sketch(sketchLines).vertex(2).X = sketch(sketchLines).vertex(1).X - sketch(sketchLines).vertex(2).Y = sketch(sketchLines).vertex(1).Y - - sketch(sketchLines).vertex(1).z = 1 - sketch(sketchLines).vertex(2).z = 1 - - Render - - Exit Sub - -ErrorHandler: - - MsgBox "Error starting sketch" & vbNewLine & Error$ - -End Sub - -Private Sub lineSketch(X As Single, Y As Single) - - On Error GoTo ErrorHandler - - sketchLines = sketchLines + 1 - ReDim Preserve sketch(sketchLines) - - sketch(sketchLines).vertex(1).X = sketch(0).vertex(1).X - sketch(sketchLines).vertex(1).Y = sketch(0).vertex(1).Y - sketch(sketchLines).vertex(2).X = Int(X / zoomFactor + scrollCoords(2).X + 0.5) - sketch(sketchLines).vertex(2).Y = Int(Y / zoomFactor + scrollCoords(2).Y + 0.5) - - sketch(sketchLines).vertex(1).z = 1 - sketch(sketchLines).vertex(2).z = 1 - - Exit Sub - -ErrorHandler: - - MsgBox "Error sketching line" & vbNewLine & Error$ - -End Sub - -Private Sub linkSketch(X As Single, Y As Single) - - Dim xVal As Single, yVal As Single - - On Error GoTo ErrorHandler - - xVal = X / zoomFactor + scrollCoords(2).X - yVal = Y / zoomFactor + scrollCoords(2).Y - - If (xVal - sketch(sketchLines).vertex(1).X) ^ 2 + (yVal - sketch(sketchLines).vertex(1).Y) ^ 2 > 16 ^ 2 Then - - sketch(sketchLines).vertex(2).X = X / zoomFactor + scrollCoords(2).X - sketch(sketchLines).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y - - sketchLines = sketchLines + 1 - ReDim Preserve sketch(sketchLines) - - sketch(sketchLines).vertex(1).X = X / zoomFactor + scrollCoords(2).X - sketch(sketchLines).vertex(1).Y = Y / zoomFactor + scrollCoords(2).Y - sketch(sketchLines).vertex(2).X = X / zoomFactor + scrollCoords(2).X - sketch(sketchLines).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y - - sketch(sketchLines).vertex(1).z = 1 - sketch(sketchLines).vertex(2).z = 1 - - End If - - Exit Sub - -ErrorHandler: - - MsgBox "Error linking sketch" & vbNewLine & Error$ - -End Sub - -Private Sub endSketch(X As Single, Y As Single) - - sketch(sketchLines).vertex(2).X = X / zoomFactor + scrollCoords(2).X - sketch(sketchLines).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y - - Render - - Exit Sub -ErrorHandler: - MsgBox "Error ending sketch" & vbNewLine & Error$ - -End Sub - -Private Sub CreateScenery(X As Single, Y As Single) - - Dim xVal As Integer, yVal As Integer - Dim i As Integer - - On Error GoTo ErrorHandler - - If numCorners = 0 Then - Scenery(0).screenTr.X = X - Scenery(0).screenTr.Y = Y - End If - - numCorners = numCorners + 1 - - xVal = (Scenery(0).screenTr.X) - yVal = (Scenery(0).screenTr.Y) - - If snapToGrid And showGrid Then - - xVal = snapVertexToGrid(xVal, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) - yVal = snapVertexToGrid(yVal, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) - - If numCorners = 1 Then - Scenery(0).screenTr.X = xVal - Scenery(0).screenTr.Y = yVal - ElseIf numCorners = 2 Then - - End If - - End If - - If numCorners = 1 And Not frmScenery.rotateScenery Then numCorners = numCorners + 1 - If numCorners = 2 And Not frmScenery.scaleScenery Then numCorners = numCorners + 1 - - If numCorners = 3 Then - - sceneryCount = sceneryCount + 1 - ReDim Preserve Scenery(sceneryCount) - - Scenery(sceneryCount) = Scenery(0) - Scenery(sceneryCount).Translation.X = Int(Scenery(0).screenTr.X / zoomFactor + scrollCoords(2).X + 0.5) - Scenery(sceneryCount).Translation.Y = Int(Scenery(0).screenTr.Y / zoomFactor + scrollCoords(2).Y + 0.5) - - If Scenery(0).Style = 0 Then 'create scenery texture - CreateSceneryTexture currentScenery - Scenery(0).Style = sceneryElements - Scenery(sceneryCount).Style = sceneryElements - frmScenery.notClicked = True - End If - - setCurrentScenery - frmInfo.lblCount(1).Caption = sceneryCount & "/500 (" & sceneryElements & ")" - numCorners = 0 - - prompt = True - SaveUndo - - End If - - Exit Sub - -ErrorHandler: - - MsgBox "Error creating scenery" & vbNewLine & Error$ - -End Sub - -Private Sub snapSelected(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim PolyNum As Integer - Dim xVal As Single, yVal As Single - Dim temp As D3DVECTOR2 - Dim tempVertex As TCustomVertex - Dim shortestDist As Single, currentDist As Single - Dim xDiff As Single, yDiff As Single - - 'make sure polys are cw - For i = 1 To numSelectedPolys - If Not isCW(selectedPolys(i)) Then 'switch to make cw - temp = PolyCoords(selectedPolys(i)).vertex(3) - PolyCoords(selectedPolys(i)).vertex(3) = PolyCoords(selectedPolys(i)).vertex(2) - PolyCoords(selectedPolys(i)).vertex(2) = temp - - tempVertex = Polys(selectedPolys(i)).vertex(3) - Polys(selectedPolys(i)).vertex(3) = Polys(selectedPolys(i)).vertex(2) - Polys(selectedPolys(i)).vertex(2) = tempVertex - - PolyNum = vertexList(selectedPolys(i)).vertex(3) - vertexList(selectedPolys(i)).vertex(3) = vertexList(selectedPolys(i)).vertex(2) - vertexList(selectedPolys(i)).vertex(2) = PolyNum - - PolyNum = 0 - End If - Next - - 'if grid is on, snap to grid - 'else, if vert snapping is on then snap to verts - - 'find which vertex of poly is selected - PolyNum = 0 - If numSelectedPolys > 0 Then - For j = 1 To 3 - If vertexList(selectedPolys(1)).vertex(j) = 1 Then 'which vertex in poly is selected - If PolyNum > 0 And Not (snapToGrid And showGrid) Then 'if more than one vertex in poly selected - Render - Exit Sub - Else - PolyNum = j - End If - End If - Next - - xVal = (Polys(selectedPolys(1)).vertex(PolyNum).X) - yVal = (Polys(selectedPolys(1)).vertex(PolyNum).Y) - Else - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - xVal = Scenery(i).screenTr.X - yVal = Scenery(i).screenTr.Y - Exit For - End If - Next - End If - - If snapToGrid And showGrid Then - - xDiff = xVal - snapVertexToGrid(xVal, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) - yDiff = yVal - snapVertexToGrid(yVal, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then 'if selected - Polys(PolyNum).vertex(j).X = Polys(PolyNum).vertex(j).X - xDiff - Polys(PolyNum).vertex(j).Y = Polys(PolyNum).vertex(j).Y - yDiff - - PolyCoords(PolyNum).vertex(j).X = Int(Polys(PolyNum).vertex(j).X / zoomFactor + scrollCoords(2).X + 0.5) - PolyCoords(PolyNum).vertex(j).Y = Int(Polys(PolyNum).vertex(j).Y / zoomFactor + scrollCoords(2).Y + 0.5) - - If fixedTexture Then - Polys(PolyNum).vertex(j).tu = PolyCoords(PolyNum).vertex(j).X / xTexture - Polys(PolyNum).vertex(j).tv = PolyCoords(PolyNum).vertex(j).Y / yTexture - End If - End If - Next - Next - End If - - If numSelectedScenery > 0 Then - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - Scenery(i).screenTr.X = Scenery(i).screenTr.X - xDiff - Scenery(i).screenTr.Y = Scenery(i).screenTr.Y - yDiff - - Scenery(i).Translation.X = Int(Scenery(i).screenTr.X / zoomFactor + scrollCoords(2).X + 0.5) - Scenery(i).Translation.Y = Int(Scenery(i).screenTr.Y / zoomFactor + scrollCoords(2).Y + 0.5) - End If - Next - End If - - If numSelSpawns > 0 Then - For i = 1 To spawnPoints - If Spawns(i).active = 1 Then - Spawns(i).X = Int((Spawns(i).X + inc / 2) / inc) * inc - Spawns(i).Y = Int((Spawns(i).Y + inc / 2) / inc) * inc - End If - Next - End If - - If numSelColliders > 0 Then - For i = 1 To colliderCount - If Colliders(i).active = 1 Then - Colliders(i).X = Int((Colliders(i).X + inc / 2) / inc) * inc - Colliders(i).Y = Int((Colliders(i).Y + inc / 2) / inc) * inc - End If - Next - End If - - If numSelLights > 0 Then - For i = 1 To lightCount - If Lights(i).selected Then - Lights(i).X = Int((Lights(i).X + inc / 2) / inc) * inc - Lights(i).Y = Int((Lights(i).Y + inc / 2) / inc) * inc - End If - Next - End If - - rCenter.X = rCenter.X - xDiff / zoomFactor - rCenter.Y = rCenter.Y - yDiff / zoomFactor - For i = 0 To 3 - selRect(i).X = selRect(i).X - xDiff / zoomFactor - selRect(i).Y = selRect(i).Y - yDiff / zoomFactor - Next - - ElseIf ohSnap And numSelectedPolys > 0 Then - - 'if vertices with different coords are selected then exit sub - If numSelectedPolys > 1 Then 'check if any different coords - For i = 2 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then 'if selected and has same coords - If Polys(selectedPolys(i)).vertex(j).X <> xVal Or Polys(selectedPolys(i)).vertex(j).Y <> yVal Then - Render - Exit Sub - End If - End If - Next - Next - End If - - 'snap - shortestDist = snapRadius ^ 2 + 1 - For i = 1 To polyCount - For j = 1 To 3 - If nearCoord(xVal, Polys(i).vertex(j).X, shortestDist) And nearCoord(yVal, Polys(i).vertex(j).Y, shortestDist) Then - currentDist = (Polys(i).vertex(j).X - xVal) ^ 2 + (Polys(i).vertex(j).Y - yVal) ^ 2 - If currentDist <= shortestDist And vertexList(i).vertex(j) = 0 Then - shortestDist = currentDist - xDiff = xVal - Polys(i).vertex(j).X - yDiff = yVal - Polys(i).vertex(j).Y - xVal = Polys(i).vertex(j).X - yVal = Polys(i).vertex(j).Y - End If - End If - Next - Next - - 'if snapping occured - If xVal <> (Polys(selectedPolys(1)).vertex(PolyNum).X) Or yVal <> (Polys(selectedPolys(1)).vertex(PolyNum).Y) Then - For i = 1 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then - Polys(selectedPolys(i)).vertex(j).X = xVal - Polys(selectedPolys(i)).vertex(j).Y = yVal - - PolyCoords(selectedPolys(i)).vertex(j).X = (xVal / zoomFactor + scrollCoords(2).X) - PolyCoords(selectedPolys(i)).vertex(j).Y = (yVal / zoomFactor + scrollCoords(2).Y) - - End If - Next - Next - rCenter.X = rCenter.X - xDiff / zoomFactor - rCenter.Y = rCenter.Y - yDiff / zoomFactor - For i = 0 To 3 - selRect(i).X = selRect(i).X - xDiff / zoomFactor - selRect(i).Y = selRect(i).Y - yDiff / zoomFactor - Next - End If - - PolyNum = 0 - - End If - - getInfo - - Render - -End Sub - -Private Sub regionSelection(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim xVal As Single, yVal As Single - Dim isSelected As Boolean - - xVal = X / zoomFactor + scrollCoords(2).X - yVal = Y / zoomFactor + scrollCoords(2).Y - - If currentFunction = TOOL_VSELECT Then - numSelectedPolys = 0 - ReDim selectedPolys(numSelectedPolys) - numSelectedScenery = 0 - numSelSpawns = 0 - numSelColliders = 0 - numSelWaypoints = 0 - numSelLights = 0 - For i = 1 To sceneryCount - Scenery(i).selected = 0 - Next - End If - - If showPolys Or showWireframe Or showPoints Then - isSelected = RegionSelPolys(X, Y) - ElseIf currentFunction = TOOL_VSELECT Then - For i = 1 To polyCount - vertexList(i).vertex(1) = 0 - vertexList(i).vertex(2) = 0 - vertexList(i).vertex(3) = 0 - Next - End If - If showObjects Then - isSelected = RegionSelObjects(xVal, yVal, isSelected) - ElseIf currentFunction = TOOL_VSELECT Then - For i = 1 To spawnPoints - Spawns(i).active = 0 - Next - For i = 1 To colliderCount - Colliders(i).active = 0 - Next - End If - If showWaypoints Then - isSelected = RegionSelWaypoints(xVal, yVal, isSelected) - Else - For i = 1 To waypointCount - Waypoints(i).selected = False - Next - End If - If showLights Then - isSelected = regionSelLights(xVal, yVal, isSelected) - ElseIf currentFunction = TOOL_VSELECT Then - For i = 1 To lightCount - Lights(i).selected = 0 - Next - End If - - currentWaypoint = 0 - - selectedCoords(1).X = 0 - selectedCoords(1).Y = 0 - selectedCoords(2).X = 0 - selectedCoords(2).Y = 0 - - getRCenter - getInfo - selectionChanged = True - Render - -End Sub - -Private Function RegionSelPolys(X As Single, Y As Single) As Boolean - - Dim i As Integer, j As Integer - Dim currentDist As Long, shortestDist As Long - Dim pIndex As Integer, vIndex As Integer - Dim selVerts As Byte, selected As Byte - Dim xVal As Single, yVal As Single - - xVal = X / zoomFactor + scrollCoords(2).X - yVal = Y / zoomFactor + scrollCoords(2).Y - - For i = 1 To polyCount - - If currentFunction = TOOL_VSELECT Then - vertexList(i).vertex(1) = 0 - vertexList(i).vertex(2) = 0 - vertexList(i).vertex(3) = 0 - End If - - If (pointInPoly(X, Y, i)) Then - shortestDist = 64 ^ 2 + 1 - For j = 1 To 3 - currentDist = (PolyCoords(i).vertex(j).X - xVal) ^ 2 + (PolyCoords(i).vertex(j).Y - yVal) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - pIndex = i - vIndex = j - End If - Next - If pIndex > 0 And vIndex > 0 Then - If (currentFunction = TOOL_VSELADD And vertexList(pIndex).vertex(vIndex) = 1) Or (currentFunction = TOOL_VSELSUB And vertexList(pIndex).vertex(vIndex) = 0) Then - pIndex = 0 - vIndex = 0 - ElseIf currentFunction <> TOOL_VSELECT Then - Exit For - End If - End If - End If - - Next - - If pIndex > 0 And vIndex > 0 Then - If currentFunction = TOOL_VSELECT Then - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = pIndex - vertexList(pIndex).vertex(vIndex) = 1 - RegionSelPolys = True - ElseIf currentFunction = TOOL_VSELADD Then - For j = 1 To 3 - selVerts = selVerts + vertexList(pIndex).vertex(j) - Next - If selVerts > 0 Then 'poly already selected - vertexList(pIndex).vertex(vIndex) = 1 - Else - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = pIndex - vertexList(pIndex).vertex(vIndex) = 1 - End If - RegionSelPolys = True - ElseIf currentFunction = TOOL_VSELSUB Then - vertexList(pIndex).vertex(vIndex) = 0 - For i = 1 To numSelectedPolys - For j = 1 To 3 - selVerts = selVerts + vertexList(selectedPolys(i)).vertex(j) - Next - If selVerts = 0 Then 'no longer selected, put last here and shorten array - selectedPolys(i) = selectedPolys(numSelectedPolys) - numSelectedPolys = numSelectedPolys - 1 - End If - selVerts = 0 - Next - ReDim Preserve selectedPolys(numSelectedPolys) - RegionSelPolys = True - End If - End If - -End Function - -Private Function RegionSelObjects(xVal As Single, yVal As Single, skipSel As Boolean) As Boolean - - Dim i As Integer, j As Integer - Dim currentDist As Long, shortestDist As Long - Dim Index As Integer - - shortestDist = (8 ^ 2 + 1) - For i = 1 To spawnPoints - If currentFunction = TOOL_VSELECT Then Spawns(i).active = 0 - If nearCoord(xVal, Spawns(i).X, 8 / zoomFactor) And nearCoord(yVal, Spawns(i).Y, 8 / zoomFactor) Then - currentDist = (Spawns(i).X - xVal) ^ 2 + (Spawns(i).Y - yVal) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - Index = i - End If - End If - Next - - If Index > 0 Then - If currentFunction = TOOL_VSELECT Then - Spawns(Index).active = 1 - numSelSpawns = numSelSpawns + 1 - skipSel = True - ElseIf currentFunction = TOOL_VSELADD Then - Spawns(Index).active = 1 - numSelSpawns = numSelSpawns + 1 - skipSel = True - ElseIf currentFunction = TOOL_VSELSUB Then - Spawns(Index).active = 0 - numSelSpawns = numSelSpawns - 1 - skipSel = True - End If - End If - - shortestDist = 64 ^ 2 + 1 - For i = 1 To colliderCount - If currentFunction = TOOL_VSELECT Then Colliders(i).active = 0 - If nearCoord(xVal, Colliders(i).X, Colliders(i).radius / 2) And nearCoord(yVal, Colliders(i).Y, Colliders(i).radius / 2) Then - currentDist = (Colliders(i).X - xVal) ^ 2 + (Colliders(i).Y - yVal) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - Index = i - End If - End If - Next - - If Index > 0 And Not skipSel Then - If currentFunction = TOOL_VSELECT Then - Colliders(Index).active = 1 - numSelColliders = numSelColliders + 1 - skipSel = True - ElseIf currentFunction = TOOL_VSELADD Then - Colliders(Index).active = 1 - numSelColliders = numSelColliders + 1 - skipSel = True - ElseIf currentFunction = TOOL_VSELSUB Then - Colliders(Index).active = 0 - numSelColliders = numSelColliders - 1 - skipSel = True - End If - End If - - RegionSelObjects = skipSel - -End Function - -Private Function regionSelLights(xVal As Single, yVal As Single, skipSel As Boolean) As Boolean - - Dim i As Integer, j As Integer - Dim currentDist As Long, shortestDist As Long - Dim Index As Integer - - shortestDist = (8 ^ 2 + 1) - For i = 1 To lightCount - If currentFunction = TOOL_VSELECT Then Lights(i).selected = 0 - If nearCoord(xVal, Lights(i).X, 8 / zoomFactor) And nearCoord(yVal, Lights(i).Y, 8 / zoomFactor) Then - currentDist = (Lights(i).X - xVal) ^ 2 + (Lights(i).Y - yVal) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - Index = i - End If - End If - Next - - If Index > 0 And Not skipSel Then - If currentFunction = TOOL_VSELECT Then - Lights(Index).selected = 1 - numSelLights = numSelLights + 1 - skipSel = True - ElseIf currentFunction = TOOL_VSELADD Then - Lights(Index).selected = 1 - numSelLights = numSelLights + 1 - skipSel = True - ElseIf currentFunction = TOOL_VSELSUB Then - Lights(Index).selected = 0 - numSelLights = numSelLights - 1 - skipSel = True - End If - End If - - regionSelLights = skipSel - -End Function - -Private Function RegionSelWaypoints(xVal As Single, yVal As Single, skipSel As Boolean) As Boolean - - Dim i As Integer, j As Integer - Dim currentDist As Long, shortestDist As Long - Dim Index As Integer - - shortestDist = (8 ^ 2 + 1) - For i = 1 To waypointCount - If currentFunction = TOOL_VSELECT Then Waypoints(i).selected = False - If (frmWaypoints.showPaths = Waypoints(i).pathNum) Or frmWaypoints.showPaths = 0 Then - If nearCoord(xVal, Waypoints(i).X, 8 / zoomFactor) And nearCoord(yVal, Waypoints(i).Y, 8 / zoomFactor) Then - currentDist = (Waypoints(i).X - xVal) ^ 2 + (Waypoints(i).Y - yVal) ^ 2 - If currentDist < shortestDist Then - shortestDist = currentDist - Index = i - End If - End If - End If - Next - - If Index > 0 And Not skipSel Then - If currentFunction = TOOL_VSELECT Then - Waypoints(Index).selected = True - numSelWaypoints = numSelWaypoints + 1 - ElseIf currentFunction = TOOL_VSELADD Then - Waypoints(Index).selected = True - numSelWaypoints = numSelWaypoints + 1 - ElseIf currentFunction = TOOL_VSELSUB Then - Waypoints(Index).selected = False - numSelWaypoints = numSelWaypoints - 1 - End If - End If - -End Function - -Private Function eraseSketch(X As Single, Y As Single) As Byte - - Dim i As Integer, j As Integer - Dim currentDist As Long, shortestDist As Long - Dim lineIndex As Integer - - On Error GoTo ErrorHandler - - eraseSketch = 0 - - shortestDist = clrRadius ^ 2 + 1 - For i = 1 To sketchLines - For j = 1 To 2 - currentDist = (X - sketch(i).vertex(j).X) ^ 2 + (Y - sketch(i).vertex(j).Y) ^ 2 - If (currentDist < shortestDist) Then - shortestDist = currentDist - lineIndex = i - End If - Next - Next - - If lineIndex > 0 Then - sketch(lineIndex) = sketch(sketchLines) - sketchLines = sketchLines - 1 - ReDim Preserve sketch(sketchLines) - Render - eraseSketch = 1 - End If - - Exit Function - -ErrorHandler: - - MsgBox "Error erasing sketch" & vbNewLine & Error$ - -End Function - -Private Function moveLines(X As Single, Y As Single, xDiff As Single, yDiff As Single) As Byte - - Dim i As Integer, j As Integer - Dim dist As Single - - On Error GoTo ErrorHandler - - xDiff = xDiff / zoomFactor - yDiff = yDiff / zoomFactor - - moveLines = 0 - - For i = 1 To sketchLines - For j = 1 To 2 - dist = (X - sketch(i).vertex(j).X) ^ 2 + (Y - sketch(i).vertex(j).Y) ^ 2 - If dist < clrRadius ^ 2 Then - sketch(i).vertex(j).X = sketch(i).vertex(j).X + xDiff * Cos((dist / (clrRadius ^ 2)) * pi / 2) - sketch(i).vertex(j).Y = sketch(i).vertex(j).Y + yDiff * Cos((dist / (clrRadius ^ 2)) * pi / 2) - moveLines = 1 - End If - Next - Next - - Exit Function - -ErrorHandler: - - MsgBox "Error moving sketch lines" & vbNewLine & Error$ - -End Function - -Private Sub deleteSmallLines() - - Dim i As Integer - - On Error GoTo ErrorHandler - - For i = 1 To sketchLines - If (Int(sketch(i).vertex(1).X + 0.5) = Int(sketch(i).vertex(2).X + 0.5)) And (Int(sketch(i).vertex(1).Y + 0.5) = Int(sketch(i).vertex(2).Y + 0.5)) Then - sketch(i) = sketch(sketchLines) - sketchLines = sketchLines - 1 - End If - Next - - ReDim Preserve sketch(sketchLines) - - Render - - Exit Sub - -ErrorHandler: - - MsgBox "Error deleting small sketch lines" & vbNewLine & Error$ - -End Sub - -Private Sub VertexSelection(X As Single, Y As Single) - - Dim i As Integer, j As Integer - - On Error GoTo ErrorHandler - - If currentFunction = TOOL_VSELECT Then - numSelectedPolys = 0 - ReDim selectedPolys(numSelectedPolys) - numSelectedScenery = 0 - numSelSpawns = 0 - numSelColliders = 0 - numSelWaypoints = 0 - ElseIf currentFunction = TOOL_VSELSUB Then - numSelectedPolys = 0 - ReDim selectedPolys(numSelectedPolys) - End If - - If showPolys Or showWireframe Or showPoints Then - VertexSelPolys - ElseIf currentFunction = TOOL_VSELECT Then - For i = 1 To polyCount - For j = 1 To 3 - vertexList(i).vertex(j) = 0 - Next - Next - End If - - If showScenery Then - VertexSelScenery - ElseIf currentFunction = TOOL_VSELECT Then - For i = 1 To sceneryCount - Scenery(i).selected = 0 - Next - End If - - If showObjects Then - VertexSelObjects - ElseIf currentFunction = TOOL_VSELECT Then - For i = 1 To spawnPoints - Spawns(i).active = 0 - Next - For i = 1 To colliderCount - Colliders(i).active = 0 - Next - End If - - If showWaypoints Then - VertexSelWaypoints - ElseIf currentFunction = TOOL_VSELECT Then - For i = 1 To waypointCount - Waypoints(i).selected = False - Next - End If - - If showLights Then - VertexSelLights - ElseIf currentFunction = TOOL_VSELECT Then - For i = 1 To lightCount - Lights(i).selected = 0 - Next - End If - - currentWaypoint = 0 - - selectedCoords(1).X = X - selectedCoords(1).Y = Y - selectedCoords(2).X = X - selectedCoords(2).Y = Y - - getRCenter - getInfo - selectionChanged = True - Render - - Exit Sub - -ErrorHandler: - - MsgBox "Error selecting vertices" & vbNewLine & Error$ - -End Sub - -Private Sub VertexSelPolys() - - Dim i As Integer, j As Integer - Dim addPoly As Integer, notSel As Integer - - If currentFunction = TOOL_VSELECT Then - - For i = 1 To polyCount - For j = 1 To 3 - vertexList(i).vertex(j) = 0 - If inSelRect(Polys(i).vertex(j).X, Polys(i).vertex(j).Y) Then - addPoly = 1 - vertexList(i).vertex(j) = 1 - End If - Next - If addPoly = 1 Then - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = i - End If - addPoly = 0 - notSel = 0 - Next - - ElseIf currentFunction = TOOL_VSELADD Then - - For i = 1 To polyCount - For j = 1 To 3 - If vertexList(i).vertex(j) = 0 Then - notSel = notSel + 1 - If inSelRect(Polys(i).vertex(j).X, Polys(i).vertex(j).Y) Then - addPoly = 1 - vertexList(i).vertex(j) = 1 - End If - End If - Next - If addPoly = 1 And notSel = 3 Then - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = i - End If - addPoly = 0 - notSel = 0 - Next - - ElseIf currentFunction = TOOL_VSELSUB Then - - For i = 1 To polyCount - For j = 1 To 3 - If vertexList(i).vertex(j) = 1 Then 'if already selected and if in range - If inSelRect(Polys(i).vertex(j).X, Polys(i).vertex(j).Y) Then - notSel = notSel + 1 - vertexList(i).vertex(j) = 0 - Else 'if already selected but not in range - addPoly = 1 - End If - End If - Next - If addPoly = 1 Then - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = i - End If - addPoly = 0 - notSel = 0 - Next - - End If - -End Sub - -Private Sub VertexSelScenery() - - Dim i As Integer, sVal As Integer - Dim sceneryCoords(3) As TCustomVertex - Dim selected(3) As Boolean - - For i = 1 To sceneryCount - sVal = Scenery(i).Style - - sceneryCoords(0).X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor - sceneryCoords(0).Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor - sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(i).rotation) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor - sceneryCoords(1).Y = sceneryCoords(0).Y - Sin(Scenery(i).rotation) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor - sceneryCoords(3).X = sceneryCoords(0).X + Sin(Scenery(i).rotation) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor - sceneryCoords(3).Y = sceneryCoords(0).Y + Cos(Scenery(i).rotation) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor - sceneryCoords(2).X = sceneryCoords(3).X + sceneryCoords(1).X - sceneryCoords(0).X - sceneryCoords(2).Y = sceneryCoords(3).Y + sceneryCoords(1).Y - sceneryCoords(0).Y - - selected(0) = inSelRect(sceneryCoords(0).X, sceneryCoords(0).Y) - If sceneryVerts Then - selected(1) = inSelRect(sceneryCoords(1).X, sceneryCoords(1).Y) - selected(2) = inSelRect(sceneryCoords(2).X, sceneryCoords(2).Y) - selected(3) = inSelRect(sceneryCoords(3).X, sceneryCoords(3).Y) - Else - selected(1) = False - selected(2) = False - selected(3) = False - End If - - If currentFunction = TOOL_VSELECT Then - Scenery(i).selected = 0 - End If - - If showWireframe Or ((Scenery(i).level = 0 And sslBack) Or (Scenery(i).level = 1 And sslMid) Or (Scenery(i).level = 2 And sslFront)) Then - If selected(0) Or selected(1) Or selected(2) Or selected(3) Then - If currentFunction = TOOL_VSELECT Then - Scenery(i).selected = 1 - numSelectedScenery = numSelectedScenery + 1 - ElseIf currentFunction = TOOL_VSELADD Then - If Scenery(i).selected = 0 Then - numSelectedScenery = numSelectedScenery + 1 - End If - Scenery(i).selected = 1 - ElseIf currentFunction = TOOL_VSELSUB Then - If Scenery(i).selected = 1 Then - numSelectedScenery = numSelectedScenery - 1 - End If - Scenery(i).selected = 0 - End If - End If - End If - Next - -End Sub - -Private Sub VertexSelObjects() - - Dim i As Integer, j As Integer - Dim xCoord As Long, yCoord As Long - - For i = 1 To spawnPoints - xCoord = (Spawns(i).X - scrollCoords(2).X) * zoomFactor - yCoord = (Spawns(i).Y - scrollCoords(2).Y) * zoomFactor - If currentFunction = TOOL_VSELECT Then Spawns(i).active = 0 - If inSelRect(xCoord, yCoord) Then - If currentFunction = TOOL_VSELECT Then - Spawns(i).active = 1 - numSelSpawns = numSelSpawns + 1 - ElseIf currentFunction = TOOL_VSELADD And Spawns(i).active = 0 Then - numSelSpawns = numSelSpawns + 1 - Spawns(i).active = 1 - ElseIf currentFunction = TOOL_VSELSUB And Spawns(i).active = 1 Then - numSelSpawns = numSelSpawns - 1 - Spawns(i).active = 0 - End If - End If - Next - - For i = 1 To colliderCount - xCoord = (Colliders(i).X - scrollCoords(2).X) * zoomFactor - yCoord = (Colliders(i).Y - scrollCoords(2).Y) * zoomFactor - If currentFunction = TOOL_VSELECT Then Colliders(i).active = 0 - If inSelRect(xCoord, yCoord) Then - If currentFunction = TOOL_VSELECT Then - numSelColliders = numSelColliders + 1 - Colliders(i).active = 1 - ElseIf currentFunction = TOOL_VSELADD And Colliders(i).active = 0 Then - numSelColliders = numSelColliders + 1 - Colliders(i).active = 1 - ElseIf currentFunction = TOOL_VSELSUB And Colliders(i).active = 1 Then - numSelColliders = numSelColliders - 1 - Colliders(i).active = 0 - End If - End If - Next - -End Sub - -Private Sub VertexSelLights() - - Dim i As Integer, j As Integer - Dim xCoord As Long, yCoord As Long - - For i = 1 To lightCount - xCoord = (Lights(i).X - scrollCoords(2).X) * zoomFactor - yCoord = (Lights(i).Y - scrollCoords(2).Y) * zoomFactor - If currentFunction = TOOL_VSELECT Then Lights(i).selected = 0 - If inSelRect(xCoord, yCoord) Then - If currentFunction = TOOL_VSELECT Then - Lights(i).selected = 1 - numSelLights = numSelLights + 1 - ElseIf currentFunction = TOOL_VSELADD And Lights(i).selected = 0 Then - numSelLights = numSelLights + 1 - Lights(i).selected = 1 - ElseIf currentFunction = TOOL_VSELSUB And Lights(i).selected = 1 Then - numSelLights = numSelLights - 1 - Lights(i).selected = 0 - End If - End If - Next - -End Sub - -Private Sub VertexSelWaypoints() - - Dim i As Integer, j As Integer - Dim xCoord As Long, yCoord As Long - - For i = 1 To waypointCount - If (frmWaypoints.showPaths = Waypoints(i).pathNum) Or frmWaypoints.showPaths = 0 Then - xCoord = (Waypoints(i).X - scrollCoords(2).X) * zoomFactor - yCoord = (Waypoints(i).Y - scrollCoords(2).Y) * zoomFactor - If currentFunction = TOOL_VSELECT Then Waypoints(i).selected = False - If inSelRect(xCoord, yCoord) Then - If currentFunction = TOOL_VSELECT Then - Waypoints(i).selected = True - numSelWaypoints = numSelWaypoints + 1 - ElseIf currentFunction = TOOL_VSELADD And Not Waypoints(i).selected Then - numSelWaypoints = numSelWaypoints + 1 - Waypoints(i).selected = True - ElseIf currentFunction = TOOL_VSELSUB And Waypoints(i).selected Then - numSelWaypoints = numSelWaypoints - 1 - Waypoints(i).selected = False - End If - End If - End If - Next - -End Sub - -Private Sub getRCenter() - - Dim i As Integer, j As Integer - Dim setCoords As Boolean - Dim xVal As Single, yVal As Single - Dim Width As Single, Height As Single - - On Error GoTo ErrorHandler - - If numSelectedPolys > 0 Then - For j = 1 To 3 - If vertexList(selectedPolys(1)).vertex(j) = 1 Then - selRect(0).X = PolyCoords(selectedPolys(1)).vertex(j).X - selRect(0).Y = PolyCoords(selectedPolys(1)).vertex(j).Y - selRect(2).X = PolyCoords(selectedPolys(1)).vertex(j).X - selRect(2).Y = PolyCoords(selectedPolys(1)).vertex(j).Y - End If - Next - For i = 1 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then - compareRect PolyCoords(selectedPolys(i)).vertex(j).X, PolyCoords(selectedPolys(i)).vertex(j).Y - End If - Next - Next - End If - If numSelectedScenery > 0 Then - setCoords = False - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - - If Not setCoords And numSelectedPolys = 0 Then - setCoords = True - selRect(0).X = Scenery(i).Translation.X - selRect(0).Y = Scenery(i).Translation.Y - selRect(2).X = Scenery(i).Translation.X - selRect(2).Y = Scenery(i).Translation.Y - End If - compareRect Scenery(i).Translation.X, Scenery(i).Translation.Y - - Width = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X - Height = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y - - xVal = Scenery(i).Translation.X + (Cos(Scenery(i).rotation) * Width) + (Sin(Scenery(i).rotation) * Height) - yVal = Scenery(i).Translation.Y - (Sin(Scenery(i).rotation) * Width) + (Cos(Scenery(i).rotation) * Height) - - compareRect xVal, yVal - - End If - Next - End If - - If numSelWaypoints > 0 Then - setCoords = False - For i = 1 To waypointCount - If Waypoints(i).selected Then - If Not setCoords And numSelectedPolys = 0 And numSelectedScenery = 0 Then - setCoords = True - selRect(0).X = Waypoints(i).X - selRect(0).Y = Waypoints(i).Y - selRect(2).X = Waypoints(i).X - selRect(2).Y = Waypoints(i).Y - End If - compareRect Waypoints(i).X, Waypoints(i).Y - End If - Next - End If - - If numSelColliders > 0 Then - setCoords = False - For i = 1 To colliderCount - If Colliders(i).active Then - If Not setCoords And numSelectedPolys = 0 And numSelectedScenery = 0 Then - setCoords = True - selRect(0).X = Colliders(i).X - selRect(0).Y = Colliders(i).Y - selRect(2).X = Colliders(i).X - selRect(2).Y = Colliders(i).Y - End If - compareRect Colliders(i).X, Colliders(i).Y - End If - Next - End If - - If numSelSpawns > 0 Then - setCoords = False - For i = 1 To spawnPoints - If Spawns(i).active Then - If Not setCoords And numSelectedPolys = 0 And numSelectedScenery = 0 Then - setCoords = True - selRect(0).X = Spawns(i).X - selRect(0).Y = Spawns(i).Y - selRect(2).X = Spawns(i).X - selRect(2).Y = Spawns(i).Y - End If - compareRect Spawns(i).X, Spawns(i).Y - End If - Next - End If - - If numSelLights > 0 Then - setCoords = False - For i = 1 To lightCount - If Lights(i).selected Then - If Not setCoords And numSelectedPolys = 0 And numSelectedScenery = 0 Then - setCoords = True - selRect(0).X = Lights(i).X - selRect(0).Y = Lights(i).Y - selRect(2).X = Lights(i).X - selRect(2).Y = Lights(i).Y - End If - compareRect Lights(i).X, Lights(i).Y - End If - Next - End If - - selRect(1).X = selRect(2).X - selRect(1).Y = selRect(0).Y - selRect(3).X = selRect(0).X - selRect(3).Y = selRect(2).Y - - If mnuFixedRCenter.Checked Then - rCenter.X = Midpoint(selRect(0).X, selRect(2).X) - rCenter.Y = Midpoint(selRect(0).Y, selRect(2).Y) - End If - - Exit Sub - -ErrorHandler: - - MsgBox Error$ - -End Sub - -Private Sub compareRect(ByVal xVal As Integer, ByVal yVal As Integer) - - If xVal < selRect(0).X Then selRect(0).X = xVal - If xVal > selRect(2).X Then selRect(2).X = xVal - If yVal < selRect(0).Y Then selRect(0).Y = yVal - If yVal > selRect(2).Y Then selRect(2).Y = yVal - -End Sub - -Private Sub vertexSelAlt(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim xDist As Integer, yDist As Integer - Dim xCenter As Integer, yCenter As Integer - Dim addPoly As Integer, notSel As Integer - - xDist = (X - selectedCoords(1).X) / 2 'x distance from coord - yDist = (Y - selectedCoords(1).Y) / 2 'y distance from coord - - xCenter = X - xDist - yCenter = Y - yDist - - numSelectedPolys = 0 - ReDim selectedPolys(numSelectedPolys) - - For i = 1 To polyCount - For j = 1 To 3 - 'if in range - If nearCoord(xCenter, Polys(i).vertex(j).X, Abs(xDist)) And nearCoord(yCenter, Polys(i).vertex(j).Y, Abs(yDist)) Then - If vertexList(i).vertex(j) = 0 Then - vertexList(i).vertex(j) = 1 - addPoly = 1 - Else - vertexList(i).vertex(j) = 0 - End If - ElseIf vertexList(i).vertex(j) = 1 Then - addPoly = 1 - End If - Next - If addPoly = 1 Then - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = i - End If - addPoly = 0 - Next - - selectedCoords(1).X = X - selectedCoords(1).Y = Y - selectedCoords(2).X = X - selectedCoords(2).Y = Y - - Render - -End Sub - -Private Sub polySelection(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim addPoly As Integer - Dim shortestDist As Integer - Dim firstClicked As Integer - Dim foundSelected As Integer - - addPoly = 0 - If currentFunction = TOOL_PSELECT Then 'select polys (destroy and remake) - - ReDim selectedPolys(0) - numSelectedPolys = 0 - numSelectedScenery = 0 - - If showPolys Or showWireframe Or showPoints Then - shortestDist = 16 ^ 2 + 1 - For i = 1 To polyCount - If (pointInPoly(X, Y, i)) And addPoly = 0 Then 'if in poly and no other poly selected - If firstClicked = 0 Then - firstClicked = i - End If - 'not selected and after selected - If foundSelected > 0 And (vertexList(i).vertex(1) + vertexList(i).vertex(1) + vertexList(i).vertex(1) < 3) Then - vertexList(i).vertex(1) = 1 - vertexList(i).vertex(2) = 1 - vertexList(i).vertex(3) = 1 - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = i - addPoly = 1 - 'not selected, not found - ElseIf (vertexList(i).vertex(1) + vertexList(i).vertex(1) + vertexList(i).vertex(1) < 3) Then - Else 'poly is selected - foundSelected = i - vertexList(i).vertex(1) = 0 - vertexList(i).vertex(2) = 0 - vertexList(i).vertex(3) = 0 - End If - Else - vertexList(i).vertex(1) = 0 - vertexList(i).vertex(2) = 0 - vertexList(i).vertex(3) = 0 - End If - Next - End If - - If addPoly = 0 And firstClicked > 0 Then - vertexList(firstClicked).vertex(1) = 1 - vertexList(firstClicked).vertex(2) = 1 - vertexList(firstClicked).vertex(3) = 1 - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = firstClicked - addPoly = 1 - End If - - If showScenery And addPoly = 0 Then - For i = 1 To sceneryCount - Scenery(i).selected = 0 - If showWireframe Or ((Scenery(i).level = 0 And sslBack) Or (Scenery(i).level = 1 And sslMid) Or (Scenery(i).level = 2 And sslFront)) Then - If PointInProp(X, Y, i) And addPoly = 0 Then - Scenery(i).selected = 1 - numSelectedScenery = numSelectedScenery + 1 - addPoly = 1 - End If - End If - Next - Else - For i = 1 To sceneryCount - Scenery(i).selected = 0 - Next - End If - - If showObjects Then - For i = 1 To spawnPoints - Spawns(i).active = 0 - Next - numSelSpawns = 0 - For i = 1 To colliderCount - Colliders(i).active = 0 - Next - numSelColliders = 0 - End If - If showLights Then - For i = 1 To lightCount - Lights(i).selected = 0 - Next - numSelLights = 0 - End If - If showWaypoints Then - For i = 1 To waypointCount - If (frmWaypoints.showPaths = Waypoints(i).pathNum) Or frmWaypoints.showPaths = 0 Then - Waypoints(i).selected = False - End If - Next - numSelWaypoints = 0 - End If - - ElseIf currentFunction = TOOL_PSELADD Then 'add polys - - addPoly = 0 - If showPolys Or showWireframe Or showPoints Then - For i = 1 To polyCount - If pointInPoly(X, Y, i) And vertexList(i).vertex(1) = 0 And addPoly = 0 Then 'if in poly and not already selected - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = i - vertexList(i).vertex(1) = 1 - vertexList(i).vertex(2) = 1 - vertexList(i).vertex(3) = 1 - addPoly = 1 - End If - Next - End If - - If showScenery And addPoly = 0 Then - For i = 1 To sceneryCount - If Scenery(i).selected = 0 And addPoly = 0 Then - If PointInProp(X, Y, i) Then - Scenery(i).selected = 1 - numSelectedScenery = numSelectedScenery + 1 - addPoly = 1 - End If - End If - Next - End If - - ElseIf currentFunction = TOOL_PSELSUB Then 'subtract polys - - ReDim selectedPolys(1) - numSelectedPolys = 0 - - If showPolys Or showWireframe Or showPoints Then - For i = 1 To polyCount - If vertexList(i).vertex(1) = 1 Then 'if poly already selected - If (pointInPoly(X, Y, i)) And addPoly = 0 Then 'if poly clicked - vertexList(i).vertex(1) = 0 - vertexList(i).vertex(2) = 0 - vertexList(i).vertex(3) = 0 - addPoly = 1 - Else - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = i - End If - End If - Next - End If - - If showScenery And addPoly = 0 Then - For i = 1 To sceneryCount - If Scenery(i).selected = 1 And addPoly = 0 Then - If PointInProp(X, Y, i) Then - Scenery(i).selected = 0 - numSelectedScenery = numSelectedScenery - 1 - addPoly = 1 - End If - End If - Next - End If - - End If - - getRCenter - getInfo - selectionChanged = True - Render - -End Sub - -Private Function PointInProp(ByVal X As Single, ByVal Y As Single, Index As Integer) As Boolean - - Dim xDiff As Long, yDiff As Long - Dim theta As Single - Dim R As Single - - On Error GoTo ErrorHandler - - PointInProp = False - - xDiff = (X - Scenery(Index).screenTr.X) - yDiff = (Y - Scenery(Index).screenTr.Y) - - R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from scenery rotation center - If xDiff = 0 Then - If yDiff > 0 Then - theta = pi / 2 + Scenery(Index).rotation - Else - theta = 3 * pi / 2 + Scenery(Index).rotation - End If - ElseIf xDiff > 0 Then - theta = Atn(yDiff / xDiff) + Scenery(Index).rotation - ElseIf xDiff < 0 Then - theta = pi + Atn(yDiff / xDiff) + Scenery(Index).rotation - End If - - X = R * Cos(theta) - Y = R * Sin(theta) - - If isBetween(0, X, SceneryTextures(Scenery(Index).Style).Width * Scenery(Index).Scaling.X * zoomFactor) Then - If isBetween(0, Y, SceneryTextures(Scenery(Index).Style).Height * Scenery(Index).Scaling.Y * zoomFactor) Then - PointInProp = True - End If - End If - - Exit Function - -ErrorHandler: - - MsgBox "Error selecting scenery" & vbNewLine & Error$ - -End Function - -Private Sub ColorFill(X As Single, Y As Single) - - Dim i As Integer, j As Integer - Dim PolyNum As Integer - Dim destClr As TColor - Dim polyColored As Boolean - - If numSelectedPolys > 0 Or numSelectedScenery > 0 Then - - If showPolys Or showWireframe Or showPoints Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - destClr = getRGB(Polys(PolyNum).vertex(j).Color) - destClr = applyBlend(destClr) - Polys(PolyNum).vertex(j).Color = ARGB(getAlpha(Polys(PolyNum).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(PolyNum).color(j).red = destClr.red - vertexList(PolyNum).color(j).green = destClr.green - vertexList(PolyNum).color(j).blue = destClr.blue - applyLightsToVert PolyNum, j - polyColored = True - End If - Next - Next - End If - - If showScenery Then - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - destClr = getRGB(Scenery(i).Color) - destClr = applyBlend(destClr) - Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) - polyColored = True - End If - Next - End If - - If polyColored Then - SaveUndo - End If - - Else - - If showPolys Or showWireframe Or showPoints Then - For i = 1 To polyCount - If (pointInPoly(X, Y, i)) Then - For j = 1 To 3 - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - destClr = getRGB(Polys(i).vertex(j).Color) 'get clr of poly - destClr = applyBlend(destClr) - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) - vertexList(i).color(j).red = destClr.red - vertexList(i).color(j).green = destClr.green - vertexList(i).color(j).blue = destClr.blue - applyLightsToVert i, j - polyColored = True - Next - End If - Next - End If - - If Not polyColored And showScenery Then - For i = 1 To sceneryCount - If PointInProp(X, Y, i) Then - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - destClr = getRGB(Scenery(i).Color) - destClr = applyBlend(destClr) - Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) - polyColored = True - End If - Next - End If - - If polyColored Then - SaveUndo - End If - - End If - - prompt = True - - Render - -End Sub - -Private Function applyBlend(dClr As TColor) As TColor - - If blendMode = 0 Then 'normal - applyBlend.red = polyClr.red * opacity + dClr.red * (1 - opacity) - applyBlend.green = polyClr.green * opacity + dClr.green * (1 - opacity) - applyBlend.blue = polyClr.blue * opacity + dClr.blue * (1 - opacity) - ElseIf blendMode = 1 Then 'multiply - applyBlend.red = (dClr.red / 255 * polyClr.red) * opacity + dClr.red * (1 - opacity) - applyBlend.green = (dClr.green / 255 * polyClr.green) * opacity + dClr.green * (1 - opacity) - applyBlend.blue = (dClr.blue / 255 * polyClr.blue) * opacity + dClr.blue * (1 - opacity) - ElseIf blendMode = 2 Then 'screen - applyBlend.red = (dClr.red - dClr.red / 255 * polyClr.red + polyClr.red) * opacity + dClr.red * (1 - opacity) - applyBlend.green = (dClr.green - dClr.green / 255 * polyClr.green + polyClr.green) * opacity + dClr.green * (1 - opacity) - applyBlend.blue = (dClr.blue - dClr.blue / 255 * polyClr.blue + polyClr.blue) * opacity + dClr.blue * (1 - opacity) - ElseIf blendMode = 3 Then 'AND 'darken - applyBlend.red = lowerVal(dClr.red, polyClr.red) * opacity + dClr.red * (1 - opacity) - applyBlend.green = lowerVal(dClr.green, polyClr.green) * opacity + dClr.green * (1 - opacity) - applyBlend.blue = lowerVal(dClr.blue, polyClr.blue) * opacity + dClr.blue * (1 - opacity) - ElseIf blendMode = 4 Then 'OR 'lighten - applyBlend.red = higherVal(dClr.red, polyClr.red) * opacity + dClr.red * (1 - opacity) - applyBlend.green = higherVal(dClr.green, polyClr.green) * opacity + dClr.green * (1 - opacity) - applyBlend.blue = higherVal(dClr.blue, polyClr.blue) * opacity + dClr.blue * (1 - opacity) - ElseIf blendMode = 5 Then 'XOR 'difference - applyBlend.red = diffVal(dClr.red, polyClr.red) * opacity + dClr.red * (1 - opacity) - applyBlend.green = diffVal(dClr.green, polyClr.green) * opacity + dClr.green * (1 - opacity) - applyBlend.blue = diffVal(dClr.blue, polyClr.blue) * opacity + dClr.blue * (1 - opacity) - Else - applyBlend.red = 0 - applyBlend.green = 0 - applyBlend.blue = 0 - End If - -End Function - -Private Function diffVal(val1 As Byte, val2 As Byte) As Byte - - If val1 > val2 Then - diffVal = val1 - val2 - Else - diffVal = val2 - val1 - End If - -End Function - -Private Function lowerVal(val1 As Byte, val2 As Byte) As Byte - - If val1 < val2 Then - lowerVal = val1 - Else - lowerVal = val2 - End If - -End Function - -Private Function higherVal(val1 As Byte, val2 As Byte) As Byte - - If val1 > val2 Then - higherVal = val1 - Else - higherVal = val2 - End If - -End Function - -Private Function snapVertexToGrid(ByVal coord As Single, offset As Single) As Single - - Dim target As Single - - offset = (inc * zoomFactor) - offset - - target = (Int(coord / (inc * zoomFactor)) * (inc * zoomFactor) + offset) - If target > coord Then target = target - inc * zoomFactor - - If (coord - target) < ((inc * zoomFactor) / 2) Then - snapVertexToGrid = target - Else - snapVertexToGrid = target + inc * zoomFactor - End If - -End Function - -Private Sub deletePolys() - - Dim i As Integer, j As Integer - Dim offset As Integer - - On Error GoTo ErrorHandler - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - prompt = True - - If numSelectedScenery > 0 Then - offset = 1 - For i = 1 To sceneryCount - Scenery(offset) = Scenery(i) - If Scenery(i).selected = 1 Then 'scenery selected - sceneryCount = sceneryCount - 1 - Else 'not selected - offset = offset + 1 - End If - Next - ReDim Preserve Scenery(sceneryCount) - End If - - If numSelSpawns > 0 Then - offset = 1 - For i = 1 To spawnPoints - Spawns(offset) = Spawns(i) - If Spawns(i).active = 1 Then - spawnPoints = spawnPoints - 1 - Else 'not selected - offset = offset + 1 - End If - Next - ReDim Preserve Spawns(spawnPoints) - End If - - If numSelColliders > 0 Then - offset = 1 - For i = 1 To colliderCount - Colliders(offset) = Colliders(i) - If Colliders(i).active = 1 Then 'scenery selected - colliderCount = colliderCount - 1 - Else 'not selected - offset = offset + 1 - End If - Next - ReDim Preserve Colliders(colliderCount) - End If - - If numSelWaypoints > 0 Then - - currentWaypoint = 0 - offset = 1 - For i = 1 To waypointCount - Waypoints(i).tempIndex = Waypoints(offset).tempIndex - Waypoints(offset) = Waypoints(i) - If Waypoints(i).selected Then - waypointCount = waypointCount - 1 - Waypoints(i).tempIndex = -1 - Else 'not selected - Waypoints(i).tempIndex = offset - offset = offset + 1 - End If - Next - - offset = 1 - For i = 1 To conCount - Connections(offset) = Connections(i) - If Waypoints(Connections(i).point1).tempIndex < 0 Or Waypoints(Connections(i).point2).tempIndex < 0 Then - conCount = conCount - 1 - Else 'not selected - Connections(offset).point1 = Waypoints(Connections(offset).point1).tempIndex - Connections(offset).point2 = Waypoints(Connections(offset).point2).tempIndex - offset = offset + 1 - End If - Next - For i = 1 To waypointCount - Waypoints(i).tempIndex = i - Waypoints(i).numConnections = 0 - Next - ReDim Preserve Waypoints(waypointCount) - ReDim Preserve Connections(conCount) - For i = 1 To conCount - Waypoints(Connections(i).point1).numConnections = Waypoints(Connections(i).point1).numConnections + 1 - Next - - End If - - If numSelLights > 0 Then - offset = 1 - For i = 1 To lightCount - Lights(offset) = Lights(i) - If Lights(i).selected = 1 Then - lightCount = lightCount - 1 - Else 'not selected - offset = offset + 1 - End If - Next - ReDim Preserve Lights(lightCount) - If lightCount > 0 Then - applyLights - ElseIf lightCount = 0 Then - For i = 1 To polyCount - For j = 1 To 3 - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) - Next - Next - End If - End If - - numSelectedScenery = 0 - numSelSpawns = 0 - numSelColliders = 0 - numSelWaypoints = 0 - numSelLights = 0 - - If numSelectedPolys > 0 Then 'delete polys - - numSelectedPolys = 0 - ReDim selectedPolys(0) - - offset = 1 - - For i = 1 To polyCount - - Polys(offset) = Polys(i) - PolyCoords(offset) = PolyCoords(i) - vertexList(offset) = vertexList(i) - - If (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) = 3 Then 'poly selected - vertexList(offset).vertex(1) = 0 - vertexList(offset).vertex(2) = 0 - vertexList(offset).vertex(3) = 0 - polyCount = polyCount - 1 - ElseIf (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) > 0 Then 'vertices selected - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = offset - offset = offset + 1 - Else 'not selected - offset = offset + 1 - End If - - Next - - ReDim Preserve Polys(polyCount) - ReDim Preserve PolyCoords(polyCount) - ReDim Preserve vertexList(polyCount) - - End If - - setMapData - - SaveUndo - Render - getInfo - - Exit Sub - -ErrorHandler: - - MsgBox "Error deleting" & vbNewLine & Error$ - -End Sub - -Private Function nearCoord(ByVal mouseCoord As Single, ByVal polyCoord As Single, ByVal range As Single) As Boolean - - If mouseCoord <= (polyCoord + range) And mouseCoord >= (polyCoord - range) Then - nearCoord = True - End If - -End Function - -Private Function inSelRect(ByVal X As Single, ByVal Y As Single) As Boolean - - If (X > selectedCoords(1).X And X < selectedCoords(2).X) Or (X > selectedCoords(2).X And X < selectedCoords(1).X) Then - If (Y > selectedCoords(1).Y And Y < selectedCoords(2).Y) Or (Y > selectedCoords(2).Y And Y < selectedCoords(1).Y) Then - inSelRect = True - End If - End If - -End Function - -Private Sub mnuClrSketch_Click() - - sketchLines = 0 - ReDim Preserve sketch(0) - -End Sub - -Private Sub mnuCopy_Click() - - savePrefab appPath & "\Temp\copy.PFB" - -End Sub - -Private Sub mnuVSelBringForward_Click() - - mnuBringForward_Click - -End Sub - -Private Sub mnuVSelBringToFront_Click() - - mnuBringToFront_Click - -End Sub - -Private Sub mnuVSelClear_Click() - - mnuClear_Click - -End Sub - -Private Sub mnuVSelCopy_Click() - - mnuCopy_Click - -End Sub - -Private Sub mnuFlip_Click(Index As Integer) - - Dim i As Integer, j As Integer - Dim PolyNum As Integer - Dim vertSel As Byte - Dim temp As D3DVECTOR2 - Dim tempVertex As TCustomVertex - Dim tempClr As TColor - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If Index = 0 Then - scaleDiff.X = -1 - ElseIf Index = 1 Then - scaleDiff.Y = -1 - End If - - rCenter.X = selRect(0).X + (selRect(2).X - selRect(0).X) / 2 - rCenter.Y = selRect(0).Y + (selRect(2).Y - selRect(0).Y) / 2 - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - PolyCoords(PolyNum).vertex(j).X = (rCenter.X + (PolyCoords(PolyNum).vertex(j).X - rCenter.X) * scaleDiff.X) - PolyCoords(PolyNum).vertex(j).Y = (rCenter.Y + (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) * scaleDiff.Y) - Polys(PolyNum).vertex(j).X = (PolyCoords(PolyNum).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(PolyNum).vertex(j).Y = (PolyCoords(PolyNum).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - End If - Next - - 'make sure polys are cw - If Not isCW(PolyNum) Then 'switch to make cw - temp = PolyCoords(PolyNum).vertex(3) - PolyCoords(PolyNum).vertex(3) = PolyCoords(PolyNum).vertex(2) - PolyCoords(PolyNum).vertex(2) = temp - - tempVertex = Polys(PolyNum).vertex(3) - Polys(PolyNum).vertex(3) = Polys(PolyNum).vertex(2) - Polys(PolyNum).vertex(2) = tempVertex - - vertSel = vertexList(PolyNum).vertex(3) - vertexList(PolyNum).vertex(3) = vertexList(PolyNum).vertex(2) - vertexList(PolyNum).vertex(2) = vertSel - - tempClr = vertexList(PolyNum).color(3) - vertexList(PolyNum).color(3) = vertexList(PolyNum).color(2) - vertexList(PolyNum).color(2) = tempClr - End If - Next - End If - - If numSelectedScenery > 0 Then - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - - If scaleDiff.X * scaleDiff.Y < 0 Then - Scenery(i).rotation = -Scenery(i).rotation - Else - Scenery(i).rotation = Scenery(i).rotation - End If - - Scenery(i).Translation.X = rCenter.X + (Scenery(i).Translation.X - rCenter.X) * scaleDiff.X - Scenery(i).Translation.Y = rCenter.Y + (Scenery(i).Translation.Y - rCenter.Y) * scaleDiff.Y - - Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor - Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor - - Scenery(i).Scaling.X = Scenery(i).Scaling.X * scaleDiff.X - Scenery(i).Scaling.Y = Scenery(i).Scaling.Y * scaleDiff.Y - End If - Next - End If - - If numSelWaypoints > 0 Then - For i = 1 To waypointCount - If Waypoints(i).selected Then - Waypoints(i).X = (rCenter.X + (Waypoints(i).X - rCenter.X) * scaleDiff.X) - Waypoints(i).Y = (rCenter.Y + (Waypoints(i).Y - rCenter.Y) * scaleDiff.Y) - If Waypoints(i).wayType(0) Then - Waypoints(i).wayType(0) = False - Waypoints(i).wayType(1) = True - ElseIf Waypoints(i).wayType(1) Then - Waypoints(i).wayType(0) = True - Waypoints(i).wayType(1) = False - End If - End If - Next - End If - - scaleDiff.X = 1 - scaleDiff.Y = 1 - - SaveUndo - Render - getInfo - -End Sub - -Private Sub mnuFlipTexture_Click(Index As Integer) - - Dim i As Integer, j As Integer - Dim PolyNum As Integer - Dim avgMul As Single - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If Index = 0 Then - scaleDiff.X = -1 - ElseIf Index = 1 Then - scaleDiff.Y = -1 - End If - - rCenter.X = 0 - rCenter.Y = 0 - - avgMul = 1 - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - rCenter.X = rCenter.X * (1 - 1 / avgMul) + Polys(PolyNum).vertex(j).tu / avgMul - rCenter.Y = rCenter.Y * (1 - 1 / avgMul) + Polys(PolyNum).vertex(j).tv / avgMul - avgMul = avgMul + 1 - End If - Next - Next - End If - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - Polys(PolyNum).vertex(j).tu = (rCenter.X + (Polys(PolyNum).vertex(j).tu - rCenter.X) * scaleDiff.X) - Polys(PolyNum).vertex(j).tv = (rCenter.Y + (Polys(PolyNum).vertex(j).tv - rCenter.Y) * scaleDiff.Y) - End If - Next - Next - End If - - scaleDiff.X = 1 - scaleDiff.Y = 1 - - SaveUndo - Render - getInfo - -End Sub - -Private Sub mnuInvertSel_Click() - - Dim i As Integer, j As Integer - Dim addPoly As Boolean - - If showPolys Or showWireframe Or showPoints Then - numSelectedPolys = 0 - ReDim selectedPolys(polyCount) - For i = 1 To polyCount - addPoly = False - For j = 1 To 3 - If vertexList(i).vertex(j) = 0 Then - vertexList(i).vertex(j) = 1 - Else - vertexList(i).vertex(j) = 0 - End If - If vertexList(i).vertex(j) = 1 Then - addPoly = True - End If - Next - If addPoly Then - numSelectedPolys = numSelectedPolys + 1 - selectedPolys(numSelectedPolys) = i - End If - Next - ReDim Preserve selectedPolys(numSelectedPolys) - End If - - If showScenery Or showWireframe Or showPoints Then - numSelectedScenery = 0 - For i = 1 To sceneryCount - If (Scenery(i).level = 0 And sslBack) Or (Scenery(i).level = 1 And sslMid) Or (Scenery(i).level = 2 And sslFront) Then - If Scenery(i).selected = 0 Then - Scenery(i).selected = 1 - Else - Scenery(i).selected = 0 - End If - If Scenery(i).selected = 1 Then - numSelectedScenery = numSelectedScenery + 1 - End If - End If - Next - End If - - If showObjects Then - numSelSpawns = 0 - For i = 1 To spawnPoints - If Spawns(i).active = 0 Then - Spawns(i).active = 1 - Else - Spawns(i).active = 0 - End If - If Spawns(i).active = 1 Then - numSelSpawns = numSelSpawns + 1 - End If - Next - numSelColliders = 0 - For i = 1 To colliderCount - If Colliders(i).active = 0 Then - Colliders(i).active = 1 - Else - Colliders(i).active = 0 - End If - If Colliders(i).active Then - numSelColliders = numSelColliders + 1 - End If - Next - End If - - If showLights Then - numSelLights = 0 - For i = 1 To lightCount - If Lights(i).selected = 0 Then - Lights(i).selected = 1 - Else - Lights(i).selected = 0 - End If - If Lights(i).selected Then - numSelLights = numSelLights + 1 - End If - Next - End If - - If showWaypoints Then - numSelWaypoints = 0 - For i = 1 To waypointCount - Waypoints(i).selected = Not Waypoints(i).selected - If Waypoints(i).selected Then - numSelWaypoints = numSelWaypoints + 1 - End If - Next - End If - - getRCenter - getInfo - - Render - -End Sub - -Private Sub mnuPaste_Click() - - On Error GoTo ErrorHandler - - If (GetAttr(appPath & "\Temp\copy.PFB") And vbDirectory) = 0 Then - loadPrefab appPath & "\Temp\copy.PFB" - End If - -ErrorHandler: - -End Sub - -Private Sub mnuRecent_Click(Index As Integer) - - Dim i As Integer - Dim Result As VbMsgBoxResult - Dim FileName As String - - FileName = mnuRecent(Index).Caption - - If Len(Dir$(FileName)) <> 0 And FileName <> "" Then - - If prompt Then - Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) - DoEvents - If Result = vbCancel Then - Exit Sub - ElseIf Result = vbYes Then - mnuSave_Click - If prompt Then Exit Sub - End If - End If - DoEvents - - LoadFile FileName - For i = Index To 1 Step -1 - mnuRecent(i).Caption = mnuRecent(i - 1).Caption - Next - mnuRecent(0).Caption = FileName - ElseIf Len(Dir$(FileName)) = 0 Then - MsgBox "File not found: " & FileName - End If - -End Sub - -'put in recent files if it isn't already -Private Sub updateRecent(FileName As String) - - Dim i As Integer - - mnuRecentFiles.Enabled = True - - For i = 9 To 1 Step -1 - mnuRecent(i).Caption = mnuRecent(i - 1).Caption - If mnuRecent(i).Caption = "" Then - mnuRecent(i).Visible = False - Else - mnuRecent(i).Visible = True - End If - Next - mnuRecent(0).Caption = FileName - -End Sub - -Private Sub mnuResetView_Click() - - zoomFactor = 1 - scrollCoords(2).X = -ScaleWidth / 2 - scrollCoords(2).Y = -ScaleHeight / 2 - Zoom 1 - - Render - -End Sub - -Private Sub mnuRotate_Click(Index As Integer) - - Dim R As Single, theta As Single - Dim xDiff As Single, yDiff As Single - Dim i As Integer, j As Integer - Dim PolyNum As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If Index = 0 Then - rDiff = pi - ElseIf Index = 1 Then - rDiff = pi / 2 - ElseIf Index = 2 Then - rDiff = 3 * pi / 2 - End If - - rCenter.X = selRect(0).X + (selRect(2).X - selRect(0).X) / 2 - rCenter.Y = selRect(0).Y + (selRect(2).Y - selRect(0).Y) / 2 - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - xDiff = (PolyCoords(PolyNum).vertex(j).X - rCenter.X) - yDiff = (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) - - R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center - If xDiff = 0 Then - If yDiff > 0 Then - theta = pi / 2 - Else - theta = 3 * pi / 2 - End If - ElseIf xDiff > 0 Then - theta = Atn(yDiff / xDiff) - ElseIf xDiff < 0 Then - theta = pi + Atn(yDiff / xDiff) - End If - theta = theta + rDiff - - PolyCoords(PolyNum).vertex(j).X = rCenter.X + R * Cos(theta) - PolyCoords(PolyNum).vertex(j).Y = rCenter.Y + R * Sin(theta) - - Polys(PolyNum).vertex(j).X = (PolyCoords(PolyNum).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(PolyNum).vertex(j).Y = (PolyCoords(PolyNum).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - End If - Next - Next - End If - - If numSelectedScenery > 0 Then - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - xDiff = (Scenery(i).Translation.X - rCenter.X) - yDiff = (Scenery(i).Translation.Y - rCenter.Y) - - R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center - If xDiff = 0 Then - If yDiff > 0 Then - theta = pi / 2 - Else - theta = 3 * pi / 2 - End If - ElseIf xDiff > 0 Then - theta = Atn(yDiff / xDiff) - ElseIf xDiff < 0 Then - theta = pi + Atn(yDiff / xDiff) - End If - theta = theta + rDiff - - Scenery(i).Translation.X = rCenter.X + R * Cos(theta) - Scenery(i).Translation.Y = rCenter.Y + R * Sin(theta) - - Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor - Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor - - If scaleDiff.X * scaleDiff.Y < 0 Then - Scenery(i).rotation = -(Scenery(i).rotation - rDiff) - Else - Scenery(i).rotation = (Scenery(i).rotation - rDiff) - End If - End If - Next - End If - - rCenter.X = selRect(0).X - rCenter.Y = selRect(0).Y - rDiff = 0 - - getRCenter - getInfo - - SaveUndo - Render - -End Sub - -Private Sub mnuRotateTexture_Click(Index As Integer) - - Dim R As Single, theta As Single - Dim xDiff As Single, yDiff As Single - Dim i As Integer, j As Integer - Dim PolyNum As Integer - Dim avgMul As Single - Dim texRate As Single - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If Index = 0 Then - rDiff = pi - ElseIf Index = 2 Then - rDiff = pi / 2 - ElseIf Index = 1 Then - rDiff = 3 * pi / 2 - End If - - texRate = CSng(xTexture) / CSng(yTexture) - - rCenter.X = 0 - rCenter.Y = 0 - - avgMul = 1 - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - rCenter.X = rCenter.X * (1 - 1 / avgMul) + Polys(PolyNum).vertex(j).tu * texRate / avgMul - rCenter.Y = rCenter.Y * (1 - 1 / avgMul) + Polys(PolyNum).vertex(j).tv / avgMul - avgMul = avgMul + 1 - End If - Next - Next - End If - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - xDiff = (Polys(PolyNum).vertex(j).tu * texRate - rCenter.X) - yDiff = (Polys(PolyNum).vertex(j).tv - rCenter.Y) - - R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center - If xDiff = 0 Then - If yDiff > 0 Then - theta = pi / 2 - Else - theta = 3 * pi / 2 - End If - ElseIf xDiff > 0 Then - theta = Atn(yDiff / xDiff) - ElseIf xDiff < 0 Then - theta = pi + Atn(yDiff / xDiff) - End If - theta = theta + rDiff - - Polys(PolyNum).vertex(j).tu = (rCenter.X + R * Cos(theta)) / texRate - Polys(PolyNum).vertex(j).tv = rCenter.Y + R * Sin(theta) - End If - Next - Next - End If - - rCenter.X = selRect(0).X - rCenter.Y = selRect(0).Y - rDiff = 0 - - getRCenter - getInfo - - SaveUndo - Render - -End Sub - -Private Sub mnuSetRCenter_Click() - - mnuFixedRCenter.Checked = False - mnuSetRCenter.Checked = True - mnuCenterRCenter.Checked = False - rCenter.X = mouseCoords.X / zoomFactor + scrollCoords(2).X - rCenter.Y = mouseCoords.Y / zoomFactor + scrollCoords(2).Y - -End Sub - -Private Sub mnuFixedRCenter_Click() - - mnuFixedRCenter.Checked = True - mnuSetRCenter.Checked = False - mnuCenterRCenter.Checked = False - rCenter.X = Midpoint(selRect(0).X, selRect(2).X) - rCenter.Y = Midpoint(selRect(0).Y, selRect(2).Y) - -End Sub - -Private Sub mnuCenterRCenter_Click() - - mnuFixedRCenter.Checked = False - mnuSetRCenter.Checked = False - mnuCenterRCenter.Checked = True - rCenter.X = Midpoint(selRect(0).X, selRect(2).X) - rCenter.Y = Midpoint(selRect(0).Y, selRect(2).Y) - -End Sub - -Private Sub mnuShowSceneryLayer_Click(Index As Integer) - - mnuShowSceneryLayer(Index).Checked = Not mnuShowSceneryLayer(Index).Checked - - If Index = 0 Then - sslBack = mnuShowSceneryLayer(0).Checked - ElseIf Index = 1 Then - sslMid = mnuShowSceneryLayer(1).Checked - ElseIf Index = 2 Then - sslFront = mnuShowSceneryLayer(2).Checked - End If - -End Sub - -Private Sub mnuSnapSelected_Click() - - SnapSelection - -End Sub - -Private Sub mnuVSelDuplicate_Click() - - mnuDuplicate_Click - -End Sub - -Private Sub mnuVSelFlip_Click(Index As Integer) - - mnuFlip_Click Index - -End Sub - -Private Sub mnuVSelPaste_Click() - - mnuPaste_Click - -End Sub - -Private Sub mnuVSelRotate_Click(Index As Integer) - - mnuRotate_Click Index - -End Sub - -Private Sub mnuVSelSendBackward_Click() - - mnuSendBackward_Click - -End Sub - -Private Sub mnuVSelSendToBack_Click() - - mnuSendToBack_Click - -End Sub - -Private Sub mnuWayType_Click(Index As Integer) - - Dim i As Integer - - mnuWayType(Index).Checked = Not mnuWayType(Index).Checked - If Index = 0 Then - mnuWayType(1).Checked = False - ElseIf Index = 1 Then - mnuWayType(0).Checked = False - ElseIf Index = 2 Then - mnuWayType(3).Checked = False - ElseIf Index = 3 Then - mnuWayType(2).Checked = False - End If - - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - - For i = 0 To 4 - If mnuWayType(i).Checked Then - lblCurrentTool.Caption = lblCurrentTool.Caption & " (" & mnuWayType(i).Caption & ")" - End If - Next - -End Sub - -Private Sub tvwScenery_Expand(ByVal Node As MSComctlLib.Node) - - If Node.Key <> "Master List" And Node.Key <> "In Use" And Node.Key <> "" Then - mnuScenList.Tag = Node.Key - mnuScenList.Caption = "Add to " & Node.Key & " list" - End If - -End Sub - -Private Sub tvwScenery_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - If Button = 2 Then - If tvwScenery.SelectedItem.FirstSibling <> "In Use" Then - If tvwScenery.SelectedItem.Parent.Key = "Master List" Then - If mnuScenList.Tag <> "" Then - mnuScenList.Caption = "Add " & tvwScenery.SelectedItem.Text & " to " & mnuScenList.Tag & " List" - mnuScenList.Enabled = True - mnuScenRemove.Enabled = False - PopupMenu mnuScenTree - End If - ElseIf tvwScenery.SelectedItem.Parent.Key <> "In Use" Then - mnuScenRemove.Caption = "Remove " & tvwScenery.SelectedItem.Text & " from List" - mnuScenList.Enabled = False - mnuScenRemove.Enabled = True - PopupMenu mnuScenTree - End If - End If - End If - -End Sub - -Private Sub mnuScenList_Click() - - Dim i As Integer - Dim tempNode As Node - - tvwScenery.Nodes.Add mnuScenList.Tag, tvwChild, , tvwScenery.SelectedItem.Text - - Open appPath & "\lists\" & mnuScenList.Tag & ".txt" For Output As #1 - - Set tempNode = tvwScenery.Nodes.Item(mnuScenList.Tag).Child - For i = 1 To tvwScenery.Nodes(mnuScenList.Tag).Children - Print #1, tempNode.Text - Set tempNode = tempNode.Next - Next - - Close #1 - -End Sub - -Private Sub mnuScenRemove_Click() - - Dim i As Integer - Dim tempNode As Node - - tvwScenery.Nodes.Remove (tvwScenery.SelectedItem.Index) - - Open appPath & "\lists\" & mnuScenList.Tag & ".txt" For Output As #1 - - Set tempNode = tvwScenery.Nodes.Item(mnuScenList.Tag).Child - For i = 1 To tvwScenery.Nodes(mnuScenList.Tag).Children - Print #1, tempNode.Text - Set tempNode = tempNode.Next - Next - - Close #1 - -End Sub - -Public Sub tvwScenery_NodeClick(ByVal Node As MSComctlLib.Node) - - Dim i As Integer - Dim isInList As Boolean - Dim token As Long - Dim tempNode As Node - - On Error GoTo ErrorHandler - - 'if there is no parent - If tvwScenery.SelectedItem.FirstSibling = "In Use" Then Exit Sub - - If Len(Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & tvwScenery.SelectedItem.Text)) = 0 Then - frmScenery.picScenery.Picture = LoadPicture(appPath & "\" & gfxDir & "\notfound.bmp") - Exit Sub - End If - - If tvwScenery.SelectedItem.Parent.Key = "In Use" Then - - currentScenery = tvwScenery.SelectedItem.Text - - token = InitGDIPlus - frmScenery.picScenery.Picture = LoadPictureGDIPlus(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & currentScenery, , , RGB(0, 255, 0)) - FreeGDIPlus token - - Set tempNode = tvwScenery.Nodes.Item("In Use").Child - - For i = 1 To (tvwScenery.Nodes.Item("In Use").Children) - If currentScenery = tempNode.Text Then - frmSoldatMapEditor.setCurrentScenery i - frmScenery.lstScenery.ListIndex = i - 1 - End If - Set tempNode = tempNode.Next - Next - - Else - - If Len(Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & tvwScenery.SelectedItem.Text)) <> 0 Then - - currentScenery = tvwScenery.SelectedItem.Text - - token = InitGDIPlus - frmScenery.picScenery.Picture = LoadPictureGDIPlus(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & currentScenery, , , RGB(0, 255, 0)) - FreeGDIPlus token - - 'check if already in list - Set tempNode = tvwScenery.Nodes.Item("In Use").Child - - For i = 1 To (tvwScenery.Nodes.Item("In Use").Children) - If currentScenery = tempNode.Text Then - isInList = True - frmSoldatMapEditor.setCurrentScenery i - End If - Set tempNode = tempNode.Next - Next - - If Not isInList Then - frmSoldatMapEditor.setCurrentTexture currentScenery - End If - - End If - - frmScenery.lstScenery.ListIndex = -1 - - End If - - Exit Sub - -ErrorHandler: - - MsgBox "Error clicking scenery tree" & vbNewLine & Error$ - -End Sub - -Private Function confirmExists(FileName As String) As Boolean - - Dim tempNode As Node - Dim i As Integer - - Set tempNode = tvwScenery.Nodes.Item("Master List").Child - - For i = 1 To (tvwScenery.Nodes.Item("Master List").Children) - If LCase$(FileName) = LCase$(tempNode.Text) Then - confirmExists = True - End If - Set tempNode = tempNode.Next - Next - -End Function - -Private Sub txtZoom_KeyPress(KeyAscii As Integer) - - If KeyAscii = 13 Then - KeyAscii = 0 - picTitle.SetFocus - End If - -End Sub - -Private Sub txtZoom_LostFocus() - - Dim zoomInput As Single - - 'check if valid value was input - If txtZoom.Text = "" Then - txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" - ElseIf IsNumeric(txtZoom.Text) Then - zoomInput = txtZoom.Text - ElseIf IsNumeric(mid$(txtZoom.Text, 1, Len(txtZoom.Text) - 1)) And right$(txtZoom.Text, 1) = "%" Then - zoomInput = mid$(txtZoom.Text, 1, Len(txtZoom.Text) - 1) - Else - txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" - End If - - If (zoomInput / 100) >= MIN_ZOOM Or (zoomInput / 100) <= MAX_ZOOM Then - Zoom ((zoomInput / 100) / zoomFactor) - txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" - Else - txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" - End If - -End Sub - -Private Function getZoomDir(zoomDir As Single) As Single - - Dim zoomVal As Single - Dim i As Integer - - getZoomDir = zoomDir - - zoomVal = MIN_ZOOM - For i = 1 To 8 - If zoomDir > 1 Then 'zooming in - If (zoomFactor) > zoomVal And (zoomFactor) < (zoomVal * 2) Then - getZoomDir = (zoomVal * 2) / zoomFactor - Exit For - End If - ElseIf zoomDir < 1 Then 'zooming out - If (zoomFactor) < zoomVal And (zoomFactor) > (zoomVal * 0.5) Then - getZoomDir = (zoomVal * 0.5) / zoomFactor - Exit For - End If - End If - zoomVal = zoomVal * 2 - Next - -End Function - -Public Sub Zoom(zoomDir As Single) - - Dim i As Integer, j As Integer - Dim zoomVal As Single - - If zoomFactor * zoomDir < MIN_ZOOM Or zoomFactor * zoomDir > MAX_ZOOM Then Exit Sub - - Scenery(0).screenTr.X = Scenery(0).screenTr.X / zoomFactor + scrollCoords(2).X - Scenery(0).screenTr.Y = Scenery(0).screenTr.Y / zoomFactor + scrollCoords(2).Y - - zoomFactor = zoomFactor * zoomDir - - If zoomDir > 1 Then - 'zoom to middle - scrollCoords(2).X = scrollCoords(2).X + Me.ScaleWidth / zoomFactor / (2 / (zoomDir - 1)) - scrollCoords(2).Y = scrollCoords(2).Y + Me.ScaleHeight / zoomFactor / (2 / (zoomDir - 1)) - ElseIf zoomDir < 1 Then - scrollCoords(2).X = scrollCoords(2).X - Me.ScaleWidth / zoomFactor / (2 / (1 - zoomDir)) - scrollCoords(2).Y = scrollCoords(2).Y - Me.ScaleHeight / zoomFactor / (2 / (1 - zoomDir)) - End If - - For i = 1 To polyCount - For j = 1 To 3 - Polys(i).vertex(j).X = (PolyCoords(i).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(i).vertex(j).Y = (PolyCoords(i).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - Next - Next - - For i = 1 To sceneryCount - Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor - Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor - Next - - If numVerts > 0 Then - For j = 1 To 3 - Polys(polyCount + 1).vertex(j).X = (PolyCoords(polyCount + 1).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(polyCount + 1).vertex(j).Y = (PolyCoords(polyCount + 1).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - Next - End If - - For i = 1 To 4 - bgPolys(i).X = (bgPolyCoords(i).X - scrollCoords(2).X) * zoomFactor - bgPolys(i).Y = (bgPolyCoords(i).Y - scrollCoords(2).Y) * zoomFactor - Next - - Scenery(0).screenTr.X = (Scenery(0).screenTr.X - scrollCoords(2).X) * zoomFactor - Scenery(0).screenTr.Y = (Scenery(0).screenTr.Y - scrollCoords(2).Y) * zoomFactor - - selectedCoords(1).X = 0 - selectedCoords(1).Y = 0 - selectedCoords(2).X = 0 - selectedCoords(2).Y = 0 - - txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" - - Render - - If circleOn Then - Render - End If - -End Sub - -Public Sub zoomScroll(zoomDir As Single, ByVal X As Integer, ByVal Y As Integer) - - Dim i As Integer, j As Integer - - If (zoomFactor * zoomDir < MIN_ZOOM) And zoomFactor > MIN_ZOOM Then - zoomDir = MIN_ZOOM / zoomFactor - ElseIf zoomFactor * zoomDir > MAX_ZOOM And zoomFactor < MAX_ZOOM Then - zoomDir = MAX_ZOOM / zoomFactor - End If - - If zoomFactor * zoomDir < MIN_ZOOM Or zoomFactor * zoomDir > MAX_ZOOM Then Exit Sub - - Scenery(0).screenTr.X = Scenery(0).screenTr.X / zoomFactor + scrollCoords(2).X - Scenery(0).screenTr.Y = Scenery(0).screenTr.Y / zoomFactor + scrollCoords(2).Y - - selectedCoords(1).X = selectedCoords(1).X / zoomFactor + scrollCoords(2).X - selectedCoords(1).Y = selectedCoords(1).Y / zoomFactor + scrollCoords(2).Y - - zoomFactor = (zoomFactor * zoomDir) - - If zoomDir > 1 Then - scrollCoords(2).X = scrollCoords(2).X + X / zoomFactor / ((2 / (zoomDir - 1)) / 2) - scrollCoords(2).Y = scrollCoords(2).Y + Y / zoomFactor / ((2 / (zoomDir - 1)) / 2) - ElseIf zoomDir < 1 Then - scrollCoords(2).X = scrollCoords(2).X - Me.ScaleWidth / zoomFactor / (2 / (1 - zoomDir)) - scrollCoords(2).Y = scrollCoords(2).Y - Me.ScaleHeight / zoomFactor / (2 / (1 - zoomDir)) - End If - - For i = 1 To polyCount - For j = 1 To 3 - Polys(i).vertex(j).X = (PolyCoords(i).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(i).vertex(j).Y = (PolyCoords(i).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - Next - Next - - For i = 1 To sceneryCount - Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor - Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor - Next - - If numVerts > 0 Then - For j = 1 To 3 - Polys(polyCount + 1).vertex(j).X = (PolyCoords(polyCount + 1).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(polyCount + 1).vertex(j).Y = (PolyCoords(polyCount + 1).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - Next - End If - - For i = 1 To 4 - bgPolys(i).X = (bgPolyCoords(i).X - scrollCoords(2).X) * zoomFactor - bgPolys(i).Y = (bgPolyCoords(i).Y - scrollCoords(2).Y) * zoomFactor - Next - - Scenery(0).screenTr.X = (Scenery(0).screenTr.X - scrollCoords(2).X) * zoomFactor - Scenery(0).screenTr.Y = (Scenery(0).screenTr.Y - scrollCoords(2).Y) * zoomFactor - - selectedCoords(1).X = (selectedCoords(1).X - scrollCoords(2).X) * zoomFactor - selectedCoords(1).Y = (selectedCoords(1).Y - scrollCoords(2).Y) * zoomFactor - - txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" - - Render - -End Sub - -Private Function pointInPoly(ByVal X As Single, ByVal Y As Single, ByVal i As Integer) As Boolean - - Dim xDist As Single, yDist As Single - Dim xDiff As Single, yDiff As Single - Dim length As Single - Dim D As Single - - pointInPoly = True - - xDist = X - Polys(i).vertex(1).X - yDist = Y - Polys(i).vertex(1).Y - xDiff = Polys(i).vertex(2).X - Polys(i).vertex(1).X - yDiff = Polys(i).vertex(1).Y - Polys(i).vertex(2).Y - If xDiff = 0 And yDiff = 0 Then - length = 1 - Else - length = Sqr(xDiff ^ 2 + yDiff ^ 2) - End If - D = (yDiff / length) * xDist + (xDiff / length) * yDist - If D < 0 Then pointInPoly = False - - xDist = X - Polys(i).vertex(2).X - yDist = Y - Polys(i).vertex(2).Y - xDiff = Polys(i).vertex(3).X - Polys(i).vertex(2).X - yDiff = Polys(i).vertex(2).Y - Polys(i).vertex(3).Y - If xDiff = 0 And yDiff = 0 Then - length = 1 - Else - length = Sqr(xDiff ^ 2 + yDiff ^ 2) - End If - D = (yDiff / length) * xDist + (xDiff / length) * yDist - If D < 0 Then pointInPoly = False - - xDist = X - Polys(i).vertex(3).X - yDist = Y - Polys(i).vertex(3).Y - xDiff = Polys(i).vertex(1).X - Polys(i).vertex(3).X - yDiff = Polys(i).vertex(3).Y - Polys(i).vertex(1).Y - If xDiff = 0 And yDiff = 0 Then - length = 1 - Else - length = Sqr(xDiff ^ 2 + yDiff ^ 2) - End If - D = (yDiff / length) * xDist + (xDiff / length) * yDist - If D < 0 Then pointInPoly = False - -End Function - -Private Function isCW(ByVal i As Integer) As Boolean - - Dim xVal As Single, yVal As Single - - xVal = Midpoint(Polys(i).vertex(1).X, Midpoint(Polys(i).vertex(2).X, Polys(i).vertex(3).X)) - yVal = Midpoint(Polys(i).vertex(1).Y, Midpoint(Polys(i).vertex(2).Y, Polys(i).vertex(3).Y)) - - isCW = pointInPoly(xVal, yVal, i) - -End Function - -Private Function Midpoint(ByVal p1 As Single, ByVal p2 As Single) As Single - - If p1 < p2 Then - Midpoint = p1 + (p2 - p1) / 2 - Else - Midpoint = p2 + (p1 - p2) / 2 - End If - -End Function - -Public Sub setDispOptions(layerNum As Integer, value As Boolean) - - If layerNum = 0 Then - showBG = value - ElseIf layerNum = 1 Then - showPolys = value - ElseIf layerNum = 2 Then - showTexture = value - ElseIf layerNum = 3 Then - showWireframe = value - ElseIf layerNum = 4 Then - showPoints = value - ElseIf layerNum = 5 Then - showScenery = value - ElseIf layerNum = 6 Then - showObjects = value - ElseIf layerNum = 7 Then - showWaypoints = value - ElseIf layerNum = 8 Then - showGrid = value - mnuGrid.Checked = value - ElseIf layerNum = 9 Then - showLights = value - setLightsMode showLights - ElseIf layerNum = 10 Then - showSketch = value - End If - - Render - -End Sub - -Private Sub setLightsMode(lightsOn As Boolean) - - Dim i As Integer, j As Integer - - If Not lightsOn Then - For i = 1 To polyCount - For j = 1 To 3 - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) - Next - Next - Else - applyLights - End If - -End Sub - -Public Sub setColorMode(ByVal clrVal As Byte) - - colorMode = clrVal - -End Sub - -Public Sub setCurrentTool(ByVal Index As Integer) - - Dim i As Integer - - currentTool = Index - currentFunction = Index - If currentTool = TOOL_CREATE And mnuQuad.Checked Then - currentFunction = TOOL_QUAD - ElseIf currentTool <> TOOL_SCENERY Then - frmSoldatMapEditor.tvwScenery.Visible = False - End If - - circleOn = False - - If numVerts > 0 And currentTool <> TOOL_CREATE Then 'abort poly creation - numVerts = 0 - ElseIf numCorners > 0 And currentTool <> TOOL_SCENERY Then - numCorners = 0 - ElseIf currentWaypoint > 0 And currentTool <> TOOL_WAYPOINT Then - currentWaypoint = 0 - End If - toolAction = False - - If currentTool = TOOL_PSELECT And numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - vertexList(selectedPolys(i)).vertex(1) = 1 - vertexList(selectedPolys(i)).vertex(2) = 1 - vertexList(selectedPolys(i)).vertex(3) = 1 - Next - getRCenter - ElseIf currentTool = TOOL_MOVE Then - If numSelectedPolys = 0 And numSelectedScenery = 1 Then - frmInfo.mnuProp_Click 1 - Else - frmInfo.mnuProp_Click 2 - End If - ElseIf currentTool = TOOL_TEXTURE Then - frmInfo.mnuProp_Click 3 - ElseIf currentTool = TOOL_VCOLOR Then - circleOn = True - ElseIf currentTool = TOOL_DEPTHMAP Then - circleOn = True - End If - - SetCursor currentFunction + 1 - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - - If currentTool = TOOL_CREATE Then - lblCurrentTool.Caption = lblCurrentTool.Caption & " (" & mnuPolyType(polyType).Caption & ")" - ElseIf currentTool = TOOL_WAYPOINT Then - For i = 0 To 4 - If mnuWayType(i).Checked Then - lblCurrentTool.Caption = lblCurrentTool.Caption & " (" & mnuWayType(i).Caption & ")" - End If - Next - End If - - Render - -End Sub - -Public Function setTempTool(toolNum As Byte) As Byte - - setTempTool = currentTool - currentTool = toolNum - -End Function - -Public Sub setMapTexture(texturePath As String) - - On Error GoTo ErrorHandler - - Set mapTexture = D3DX.CreateTextureFromFileEx(D3DDevice, frmSoldatMapEditor.soldatDir & "textures\" & texturePath, D3DX_DEFAULT, D3DX_DEFAULT, _ - D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_TRIANGLE, _ - D3DX_FILTER_TRIANGLE, ColorKey, imageInfo, ByVal 0) - - textureFile = texturePath - - xTexture = imageInfo.Width - yTexture = imageInfo.Height - - frmInfo.lblDimensions.Caption = "Dimensions: " & xTexture & " x " & yTexture - frmInfo.txtQuadX(0).Text = 0 - frmInfo.txtQuadY(0).Text = 0 - frmInfo.txtQuadX(1).Text = xTexture - frmInfo.txtQuadY(1).Text = yTexture - - Render - -ErrorHandler: - -End Sub - -'set polyclr when rgb modified -Public Sub setPolyColor(Index As Integer, value As Byte) - - If Index = 0 Then - polyClr.red = value - ElseIf Index = 1 Then - polyClr.green = value - ElseIf Index = 2 Then - polyClr.blue = value - ElseIf Index = 3 Then - opacity = value / 100 - End If - If numVerts > 0 And (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) Then - Polys(polyCount + 1).vertex(numVerts + 1).Color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) - End If - Scenery(0).alpha = opacity * 255 - Scenery(0).Color = ARGB(opacity * 255, RGB(polyClr.blue, polyClr.green, polyClr.red)) - -End Sub - -'set polyclr when palette clicked -Public Sub setPaletteColor(red As Byte, green As Byte, blue As Byte) - - polyClr.red = red - polyClr.green = green - polyClr.blue = blue - If numVerts > 0 And (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) Then - Polys(polyCount + 1).vertex(numVerts + 1).Color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) - End If - Scenery(0).alpha = opacity * 255 - Scenery(0).Color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) - -End Sub - -Public Sub setBlendMode(Index As Integer) - - blendMode = Index - -End Sub - -Public Function getColor() As Long - - getColor = RGB(polyClr.red, polyClr.green, polyClr.blue) - -End Function - -Public Sub getOptions() - - Dim i As Integer - - frmMap.txtDesc = mapTitle - frmMap.txtJet = Options.StartJet - frmMap.cboGrenades.ListIndex = Options.GrenadePacks - frmMap.cboMedikits.ListIndex = Options.Medikits - frmMap.cboSteps.ListIndex = Options.Steps - frmMap.cboWeather.ListIndex = Options.Weather - frmMap.picBackClr(0).BackColor = RGB(bgColors(1).red, bgColors(1).green, bgColors(1).blue) - frmMap.picBackClr(1).BackColor = RGB(bgColors(2).red, bgColors(2).green, bgColors(2).blue) - - For i = 0 To frmMap.cboTexture.ListCount - 1 - If frmMap.cboTexture.List(i) = textureFile Then - frmMap.cboTexture.ListIndex = i - End If - Next - -End Sub - -Public Sub setOptions() - - Options.GrenadePacks = frmMap.cboGrenades.ListIndex - Options.Medikits = frmMap.cboMedikits.ListIndex - Options.StartJet = frmMap.txtJet.Text - Options.Steps = frmMap.cboSteps.ListIndex - Options.Weather = frmMap.cboWeather.ListIndex - Options.BackgroundColor = ARGB(255, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red)) - Options.BackgroundColor = ARGB(255, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red)) - - mapTitle = frmMap.txtDesc.Text - -End Sub - -Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) - - Dim Result As VbMsgBoxResult - Dim temp As String - - temp = Data.Files.Item(1) - If right(temp, 1) = """" Then - temp = left(temp, Len(temp) - 1) - temp = right(temp, Len(temp) - 1) - End If - - If LCase$(right(temp, 4)) = ".pms" Then - - If prompt Then - Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) - DoEvents - If Result = vbCancel Then - Exit Sub - ElseIf Result = vbYes Then - mnuSave_Click - If prompt Then Exit Sub - End If - End If - DoEvents - - recentFiles Data.Files.Item(1) - - LoadFile Data.Files.Item(1) - - End If - -End Sub - -Public Sub Form_Paint() - - Render - -End Sub - -Public Sub Terminate() 'You are on the way to destruction. - - Dim Result As VbMsgBoxResult - - On Error GoTo ErrorHandler - - If prompt Then - Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) - DoEvents - If Result = vbCancel Then - Exit Sub - ElseIf Result = vbYes Then - mnuSave_Click - If prompt Then Exit Sub - End If - End If - DoEvents - - saveSettings - - Set mapTexture = Nothing - Set particleTexture = Nothing - Set patternTexture = Nothing - Set sketchTexture = Nothing - Set objectsTexture = Nothing - Set lineTexture = Nothing - Set pathTexture = Nothing - Set rCenterTexture = Nothing - - ReDim SceneryTextures(0) - Set SceneryTextures(0).Texture = Nothing - - DIDevice.Unacquire - - If hEvent <> 0 Then DX.DestroyEvent hEvent - - Set D3DDevice = Nothing - Set DIDevice = Nothing - Set DI = Nothing - Set D3D = Nothing - Set DX = Nothing - - Unload Me - End - - Exit Sub - -ErrorHandler: - - MsgBox "Error terminating" & vbNewLine & Error$ - -End Sub - -Private Sub Form_Resize() - - picHelp.left = frmSoldatMapEditor.ScaleWidth - 80 - picMinimize.left = frmSoldatMapEditor.ScaleWidth - 48 - picMaximize.left = frmSoldatMapEditor.ScaleWidth - 32 - picExit.left = frmSoldatMapEditor.ScaleWidth - 16 - - picProgress.left = frmSoldatMapEditor.ScaleWidth - 136 - -End Sub - -Private Sub MouseHelper_MouseWheel(ctrl As Variant, Direction As MBMouseHelper.mbDirectionConstants, Button As Long, Shift As Long, Cancel As Boolean) - - Dim zoomVal As Single - - If Direction = mbBackward Then - zoomScroll 0.8, mouseCoords.X, mouseCoords.Y - ElseIf Direction = mbForward Then - zoomScroll 1.25, mouseCoords.X, mouseCoords.Y - End If - -End Sub - -Public Sub setPreferences() - - inc = (gridSpacing / gridDivisions) - tvwScenery.Height = formHeight - 41 - 20 - resetDevice - Render - -End Sub - -Public Function setBGColor(Index As Integer) As Long - - frmColor.InitClr bgColors(Index).red, bgColors(Index).green, bgColors(Index).blue - frmColor.Show 1 - bgColors(Index).red = frmColor.red - bgColors(Index).green = frmColor.green - bgColors(Index).blue = frmColor.blue - - bgPolys(1).Color = RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red) - bgPolys(2).Color = RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red) - bgPolys(3).Color = RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red) - bgPolys(4).Color = RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red) - - setBGColor = RGB(bgColors(Index).red, bgColors(Index).green, bgColors(Index).blue) - - Render - -End Function - -Public Sub setLightColor() - - Dim i As Integer - Dim Index As Integer - - For i = 1 To lightCount - If Lights(i).selected = 1 Then - Index = i - Exit For - End If - Next - - frmColor.InitClr Lights(Index).color.red, Lights(Index).color.green, Lights(Index).color.blue - frmColor.Show 1 - - For i = 1 To lightCount - If Lights(i).selected = 1 Then - Lights(i).color.red = frmColor.red - Lights(i).color.green = frmColor.green - Lights(i).color.blue = frmColor.blue - End If - Next - - frmInfo.picLight.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) - - applyLights - -End Sub - -Public Sub setRadius(R As Integer) - - Dim i As Integer - - clrRadius = R - Colliders(0).radius = R - - If numSelColliders > 0 Then - For i = 1 To colliderCount - If Colliders(i).active Then - Colliders(i).radius = R - End If - Next - Render - End If - -End Sub - -Public Function setWayType(Index As Integer, tehValue As Boolean) As Boolean - - If numSelWaypoints = 0 Then - setWayType = False - Exit Function - End If - - Dim i As Integer - - For i = 1 To waypointCount - If Waypoints(i).selected Then - Waypoints(i).wayType(Index) = tehValue - If Index = 0 Then - Waypoints(i).wayType(1) = False - ElseIf Index = 1 Then - Waypoints(i).wayType(0) = False - ElseIf Index = 2 Then - Waypoints(i).wayType(3) = False - ElseIf Index = 3 Then - Waypoints(i).wayType(2) = False - End If - End If - Next - - setWayType = True - - Render - -End Function - -Public Sub setPathNum(tehValue As Byte) - - Dim i As Integer - - For i = 1 To waypointCount - If Waypoints(i).selected Then - Waypoints(i).pathNum = tehValue - End If - Next - - Render - -End Sub - -Public Function setSpecial(tehValue As Byte) As Boolean - - Dim i As Integer - - If numSelWaypoints = 0 Then - setSpecial = False - Exit Function - End If - - For i = 1 To waypointCount - If Waypoints(i).selected Then - Waypoints(i).special = tehValue - End If - Next - - setSpecial = True - -End Function - -Public Sub setShowPaths() - - Render - -End Sub - -Public Sub ClearUnused() - - Dim i As Integer, j As Integer - Dim doesExist As Boolean - Dim offset As Integer - Dim numDeleted As Integer - - On Error GoTo ErrorHandler - - offset = 1 - For i = 1 To sceneryElements - For j = 1 To sceneryCount 'check if exists - If Scenery(j).Style = i Then - doesExist = True - Exit For - End If - Next - 'check if duplicate - For j = 0 To offset - 2 - If frmScenery.lstScenery.List(j) = frmScenery.lstScenery.List(offset - 1) Then - doesExist = False - Exit For - End If - Next - SceneryTextures(offset) = SceneryTextures(i) - If doesExist Then 'if does not exist, will get overwritten next time - offset = offset + 1 - Else - numDeleted = numDeleted + 1 - frmScenery.lstScenery.RemoveItem offset - 1 - End If - For j = 1 To sceneryCount - If Scenery(j).Style = i Then - Scenery(j).Style = Scenery(j).Style - numDeleted - End If - Next - doesExist = False - Next - - If numDeleted > 0 Then - - Scenery(0).Style = 0 - - sceneryElements = sceneryElements - numDeleted - ReDim Preserve SceneryTextures(sceneryElements) - - tvwScenery.Nodes.Remove "In Use" - tvwScenery.Nodes.Add "Master List", tvwFirst, "In Use", "In Use" - For i = 0 To frmScenery.lstScenery.ListCount - 1 - tvwScenery.Nodes.Add "In Use", tvwChild, frmScenery.lstScenery.List(i), frmScenery.lstScenery.List(i) - Next - - End If - - numUndo = 0 - - Exit Sub - -ErrorHandler: - - MsgBox "Error clearing unused scenery" & vbNewLine & Error$ - -End Sub - -Private Sub saveSettings() - - Dim X As Integer, Y As Integer - Dim i As Integer, KeyCode As Byte - - Dim iniString As String - Dim currentColor As Long - Dim sNull As String - sNull = Chr$(0) - - 'preferences - iniString = "Dir=" & soldatDir & sNull & "Uncompiled=" & uncompDir & sNull & "Prefabs=" & prefabDir & sNull _ - & "GridSpacing=" & gridSpacing & sNull & "GridDiv=" & gridDivisions & sNull _ - & "GridClr1=" & RGBtoHex(gridClr) & sNull & "GridClr2=" & RGBtoHex(gridClr2) & sNull _ - & "GridAlpha1=" & gridOp1 & sNull & "GridAlpha2=" & gridOp2 & sNull _ - & "PolySrc=" & polyBlendSrc & sNull & "PolyDest=" & polyBlendDest & sNull _ - & "WireSrc=" & wireBlendSrc & sNull & "WireDest=" & wireBlendDest & sNull _ - & "PointClr=" & RGBtoHex(pointClr) & sNull & "SelectionClr=" & RGBtoHex(selectionClr) & sNull _ - & "BackClr=" & RGBtoHex(backClr) & sNull & "MaxUndo=" & max_undo & sNull _ - & "SceneryVerts=" & sceneryVerts & sNull & "Topmost=" & topmost & sNull & sNull - saveSection "Preferences", iniString - - 'display - iniString = "Background=" & showBG & sNull & "Polys=" & showPolys & sNull _ - & "Texture=" & showTexture & sNull & "Wireframe=" & showWireframe & sNull _ - & "Points=" & showPoints & sNull & "Scenery=" & showScenery & sNull _ - & "Objects=" & showObjects & sNull & "Waypoints=" & showWaypoints & sNull _ - & "Grid=" & showGrid & sNull & "Lights=" & showLights & sNull _ - & "Sketch=" & showSketch & sNull & sNull - saveSection "Display", iniString - - 'tool settings - currentColor = RGB(polyClr.blue, polyClr.green, polyClr.red) - iniString = "CurrentTool=" & currentTool & sNull & "SnapVertices=" & ohSnap & sNull _ - & "SnapToGrid=" & snapToGrid & sNull & "FixedTexture=" & fixedTexture & sNull _ - & "Opacity=" & (opacity * 100) & sNull & "ColorRadius=" & clrRadius & sNull _ - & "CurrentColor=" & RGBtoHex(currentColor) & sNull & "ColorMode=" & colorMode & sNull _ - & "BlendMode=" & blendMode & sNull & "SnapRadius=" & snapRadius & sNull _ - & "RotateScenery=" & frmScenery.rotateScenery & sNull & "ScaleScenery=" & frmScenery.scaleScenery & sNull _ - & "TextureWidth=" & xTexture & sNull & "TextureHeight=" & yTexture & sNull _ - & "Texture=" & textureFile & sNull _ - & "CustomX=" & mnuCustomX.Checked & sNull _ - & "CustomY=" & mnuCustomY.Checked & sNull & sNull - saveSection "ToolSettings", iniString - - 'hotkeys - iniString = "Move=" & frmTools.getHotKey(0) & sNull & "Create=" & frmTools.getHotKey(1) & sNull _ - & "VertexSelection=" & frmTools.getHotKey(2) & sNull & "PolySelection=" & frmTools.getHotKey(3) & sNull _ - & "VertexColor=" & frmTools.getHotKey(4) & sNull & "PolyColor=" & frmTools.getHotKey(5) & sNull _ - & "Texture=" & frmTools.getHotKey(6) & sNull & "Scenery=" & frmTools.getHotKey(7) & sNull _ - & "Waypoints=" & frmTools.getHotKey(8) & sNull & "Objects=" & frmTools.getHotKey(9) & sNull _ - & "ColorPicker=" & frmTools.getHotKey(10) & sNull & "Sketch=" & frmTools.getHotKey(11) & sNull _ - & "Lights=" & frmTools.getHotKey(12) & sNull & "Depthmap=" & frmTools.getHotKey(13) & sNull & sNull - saveSection "HotKeys", iniString - - 'waypoint keys - iniString = "Left=" & frmWaypoints.getWayptKey(0) & sNull & "Right=" & frmWaypoints.getWayptKey(1) & sNull _ - & "Up=" & frmWaypoints.getWayptKey(2) & sNull & "Down=" & frmWaypoints.getWayptKey(3) & sNull _ - & "Fly=" & frmWaypoints.getWayptKey(4) & sNull & sNull - saveSection "WaypointKeys", iniString - - 'layer keys - iniString = "Background=" & frmDisplay.getLayerKey(0) & sNull & "Polys=" & frmDisplay.getLayerKey(1) & sNull _ - & "Texture=" & frmDisplay.getLayerKey(2) & sNull & "Wireframe=" & frmDisplay.getLayerKey(3) & sNull _ - & "Points=" & frmDisplay.getLayerKey(4) & sNull & "Scenery=" & frmDisplay.getLayerKey(5) & sNull _ - & "Objects=" & frmDisplay.getLayerKey(6) & sNull & "Waypoints=" & frmDisplay.getLayerKey(7) & sNull & sNull - saveSection "LayerKeys", iniString - - 'palette - frmPalette.savePalette appPath & "\palettes\current.txt" - - 'workspace - iniString = "WindowState=" & Me.WindowState & sNull _ - & "Width=" & formWidth & sNull & "Height=" & formHeight & sNull _ - & "Left=" & formLeft & sNull & "Top=" & formTop & sNull & sNull - saveSection "Main", iniString, appPath & "\workspace\current.ini" - - saveWindow "Tools", frmTools, False - saveWindow "Display", frmDisplay, frmDisplay.collapsed - saveWindow "Properties", frmInfo, frmInfo.collapsed - saveWindow "Palette", frmPalette, frmPalette.collapsed - saveWindow "Scenery", frmScenery, frmScenery.collapsed - saveWindow "Waypoints", frmWaypoints, frmWaypoints.collapsed - saveWindow "Texture", frmTexture, frmTexture.collapsed - - 'recent files - iniString = "01=" & mnuRecent(0).Caption & sNull & "02=" & mnuRecent(1).Caption & sNull _ - & "03=" & mnuRecent(2).Caption & sNull & "04=" & mnuRecent(3).Caption & sNull _ - & "05=" & mnuRecent(4).Caption & sNull & "06=" & mnuRecent(5).Caption & sNull _ - & "07=" & mnuRecent(6).Caption & sNull & "08=" & mnuRecent(7).Caption & sNull _ - & "09=" & mnuRecent(8).Caption & sNull & "10=" & mnuRecent(9).Caption & sNull & sNull - saveSection "RecentFiles", iniString - - 'gfx dir - iniString = "Dir=" & gfxDir & sNull & sNull - saveSection "gfx", iniString - -End Sub - -Private Sub saveWindow(sectionName As String, window As Form, collapsed As Boolean, Optional FileName As String = "current.ini") - - Dim leftVal As Integer, topVal As Integer - Dim iniString As String - Dim sNull As String - sNull = Chr$(0) - - leftVal = window.left / Screen.TwipsPerPixelX - topVal = window.Top / Screen.TwipsPerPixelY - - iniString = "Visible=" & window.Visible & sNull & "Left=" & leftVal & sNull & "Top=" & topVal & sNull _ - & "Collapsed=" & collapsed & sNull & sNull - - saveSection sectionName, iniString, appPath & "\workspace\" & FileName - -End Sub - -Private Function SetIdePath() As Boolean - - appPath = appPath & "\pwinstall" - SetIdePath = True - -End Function - -Private Sub loadINI() - - On Error GoTo ErrorHandler - - appPath = App.path - - Debug.Assert SetIdePath 'workaround for debugging with ide - - Dim i As Integer - Dim numRecent As Integer - Dim errVal As String - - errVal = "1" - - soldatDir = loadString("Preferences", "Dir", , 1024) - uncompDir = loadString("Preferences", "Uncompiled", , 1024) - prefabDir = loadString("Preferences", "Prefabs", , 1024) - - gridSpacing = loadInt("Preferences", "GridSpacing") - gridDivisions = loadInt("Preferences", "GridDiv") - gridClr = HexToLong(loadString("Preferences", "GridClr1")) - gridClr2 = HexToLong(loadString("Preferences", "GridClr2")) - gridOp1 = loadInt("Preferences", "GridAlpha1") - gridOp2 = loadInt("Preferences", "GridAlpha2") - polyBlendSrc = loadInt("Preferences", "PolySrc") - polyBlendDest = loadInt("Preferences", "PolyDest") - wireBlendSrc = loadInt("Preferences", "WireSrc") - wireBlendDest = loadInt("Preferences", "WireDest") - pointClr = HexToLong(loadString("Preferences", "PointClr")) - selectionClr = HexToLong(loadString("Preferences", "SelectionClr")) - backClr = HexToLong(loadString("Preferences", "BackClr")) - max_undo = loadInt("Preferences", "MaxUndo") - sceneryVerts = loadString("Preferences", "SceneryVerts") - topmost = loadString("Preferences", "Topmost") - - errVal = "2" - - showBG = loadString("Display", "Background") - showPolys = loadString("Display", "Polys") - showTexture = loadString("Display", "Texture") - showWireframe = loadString("Display", "Wireframe") - showPoints = loadString("Display", "Points") - showScenery = loadString("Display", "Scenery") - showObjects = loadString("Display", "Objects") - showWaypoints = loadString("Display", "Waypoints") - showGrid = loadString("Display", "Grid") - showLights = loadString("Display", "Lights") - showSketch = loadString("Display", "Sketch") - - errVal = "3" - - currentTool = loadInt("ToolSettings", "CurrentTool") - ohSnap = loadString("ToolSettings", "SnapVertices") - snapToGrid = loadString("ToolSettings", "SnapToGrid") - fixedTexture = loadString("ToolSettings", "FixedTexture") - opacity = loadInt("ToolSettings", "Opacity") / 100 - clrRadius = loadInt("ToolSettings", "ColorRadius") - polyClr = getRGB(HexToLong(loadString("ToolSettings", "CurrentColor"))) - colorMode = loadInt("ToolSettings", "ColorMode") - blendMode = loadInt("ToolSettings", "BlendMode") - snapRadius = loadInt("ToolSettings", "SnapRadius") - frmScenery.rotateScenery = loadString("ToolSettings", "RotateScenery") - frmScenery.scaleScenery = loadString("ToolSettings", "ScaleScenery") - xTexture = loadInt("ToolSettings", "TextureWidth") - yTexture = loadInt("ToolSettings", "TextureHeight") - textureFile = loadString("ToolSettings", "Texture", , 1024) - mnuCustomX.Checked = loadString("ToolSettings", "CustomX") - mnuCustomY.Checked = loadString("ToolSettings", "CustomY") - - errVal = "4" - - frmTools.setHotKey 0, loadInt("HotKeys", "Move") - frmTools.setHotKey 1, loadInt("HotKeys", "Create") - frmTools.setHotKey 2, loadInt("HotKeys", "VertexSelection") - frmTools.setHotKey 3, loadInt("HotKeys", "PolySelection") - frmTools.setHotKey 4, loadInt("HotKeys", "VertexColor") - frmTools.setHotKey 5, loadInt("HotKeys", "PolyColor") - frmTools.setHotKey 6, loadInt("HotKeys", "Texture") - frmTools.setHotKey 7, loadInt("HotKeys", "Scenery") - frmTools.setHotKey 8, loadInt("HotKeys", "Waypoints") - frmTools.setHotKey 9, loadInt("HotKeys", "Objects") - frmTools.setHotKey 10, loadInt("HotKeys", "ColorPicker") - frmTools.setHotKey 11, loadInt("HotKeys", "Sketch") - frmTools.setHotKey 12, loadInt("HotKeys", "Lights") - frmTools.setHotKey 13, loadInt("HotKeys", "DepthMap") - - errVal = "5" - - frmWaypoints.setWayptKey 0, loadInt("WaypointKeys", "Left") - frmWaypoints.setWayptKey 1, loadInt("WaypointKeys", "Right") - frmWaypoints.setWayptKey 2, loadInt("WaypointKeys", "Up") - frmWaypoints.setWayptKey 3, loadInt("WaypointKeys", "Down") - frmWaypoints.setWayptKey 4, loadInt("WaypointKeys", "Fly") - - errVal = "6" - - frmDisplay.setLayerKey 0, loadInt("LayerKeys", "Background") - frmDisplay.setLayerKey 1, loadInt("LayerKeys", "Polys") - frmDisplay.setLayerKey 2, loadInt("LayerKeys", "Texture") - frmDisplay.setLayerKey 3, loadInt("LayerKeys", "Wireframe") - frmDisplay.setLayerKey 4, loadInt("LayerKeys", "Points") - frmDisplay.setLayerKey 5, loadInt("LayerKeys", "Scenery") - frmDisplay.setLayerKey 6, loadInt("LayerKeys", "Objects") - frmDisplay.setLayerKey 7, loadInt("LayerKeys", "Waypoints") - - errVal = "7" - - mnuRecent(0).Caption = loadString("RecentFiles", "01", , 1024) - mnuRecent(1).Caption = loadString("RecentFiles", "02", , 1024) - mnuRecent(2).Caption = loadString("RecentFiles", "03", , 1024) - mnuRecent(3).Caption = loadString("RecentFiles", "04", , 1024) - mnuRecent(4).Caption = loadString("RecentFiles", "05", , 1024) - mnuRecent(5).Caption = loadString("RecentFiles", "06", , 1024) - mnuRecent(6).Caption = loadString("RecentFiles", "07", , 1024) - mnuRecent(7).Caption = loadString("RecentFiles", "08", , 1024) - mnuRecent(8).Caption = loadString("RecentFiles", "09", , 1024) - mnuRecent(9).Caption = loadString("RecentFiles", "10", , 1024) - - errVal = "8" - - PolyTypeClrs(1) = CLng("&H" + (loadString("PolyTypeColors", "OnlyBullets"))) - PolyTypeClrs(2) = CLng("&H" + (loadString("PolyTypeColors", "OnlyPlayer"))) - PolyTypeClrs(3) = CLng("&H" + (loadString("PolyTypeColors", "DoesntCollide"))) - PolyTypeClrs(4) = CLng("&H" + (loadString("PolyTypeColors", "Ice"))) - PolyTypeClrs(5) = CLng("&H" + (loadString("PolyTypeColors", "Deadly"))) - PolyTypeClrs(6) = CLng("&H" + (loadString("PolyTypeColors", "BloodyDeadly"))) - PolyTypeClrs(7) = CLng("&H" + (loadString("PolyTypeColors", "Hurts"))) - PolyTypeClrs(8) = CLng("&H" + (loadString("PolyTypeColors", "Regenerates"))) - PolyTypeClrs(9) = CLng("&H" + (loadString("PolyTypeColors", "Lava"))) - PolyTypeClrs(10) = CLng("&H" + (loadString("PolyTypeColors", "TeamBullets"))) - PolyTypeClrs(11) = CLng("&H" + (loadString("PolyTypeColors", "TeamPlayers"))) - PolyTypeClrs(12) = PolyTypeClrs(10) - PolyTypeClrs(13) = PolyTypeClrs(11) - PolyTypeClrs(14) = PolyTypeClrs(10) - PolyTypeClrs(15) = PolyTypeClrs(11) - PolyTypeClrs(16) = PolyTypeClrs(10) - PolyTypeClrs(17) = PolyTypeClrs(11) - PolyTypeClrs(18) = CLng("&H" + (loadString("PolyTypeColors", "Bouncy"))) - PolyTypeClrs(19) = CLng("&H" + (loadString("PolyTypeColors", "Explosive"))) - PolyTypeClrs(20) = CLng("&H" + (loadString("PolyTypeColors", "HurtFlaggers"))) - PolyTypeClrs(21) = CLng("&H" + (loadString("PolyTypeColors", "OnlyFlagger"))) - PolyTypeClrs(22) = CLng("&H" + (loadString("PolyTypeColors", "NonFlagger"))) - PolyTypeClrs(23) = CLng("&H" + (loadString("PolyTypeColors", "FlagCollides"))) - PolyTypeClrs(24) = CLng("&H" + (loadString("PolyTypeColors", "Back"))) - PolyTypeClrs(25) = CLng("&H" + (loadString("PolyTypeColors", "BackTransition"))) - - errVal = "9" - - gfxDir = loadString("gfx", "Dir", , 1024) - - If gfxDir = "" Then gfxDir = "gfx" - - errVal = "10" - - For i = 1 To 9 - If mnuRecent(i).Caption = "" Then - numRecent = numRecent + 1 - mnuRecent(i).Visible = False - Else - mnuRecent(i).Visible = True - End If - Next - If numRecent = 9 And mnuRecent(0).Caption = "" Then - mnuRecentFiles.Enabled = False - End If - - Exit Sub - -ErrorHandler: - - MsgBox "Error loading ini file" & vbNewLine & Error$ & vbNewLine & errVal - -End Sub - -Private Function getNextValue(sectionString As String, ByRef eIndex As Integer) As String - - Dim nIndex As Integer - - eIndex = InStr(eIndex, sectionString, "=") + 1 - nIndex = InStr(eIndex, sectionString, vbNullChar) - getNextValue = mid$(sectionString, eIndex, nIndex) - -End Function - -Private Sub loadWorkspace(Optional FileName As String = "current.ini") - - On Error GoTo ErrorHandler - - Me.WindowState = loadInt("Main", "WindowState", appPath & "\workspace\" & FileName) - Me.formWidth = loadInt("Main", "Width", appPath & "\workspace\" & FileName) - Me.formHeight = loadInt("Main", "Height", appPath & "\workspace\" & FileName) - Me.formLeft = loadInt("Main", "Left", appPath & "\workspace\" & FileName) - Me.formTop = loadInt("Main", "Top", appPath & "\workspace\" & FileName) - - If Me.WindowState = vbNormal Then - Me.Width = formWidth * Screen.TwipsPerPixelX - Me.Height = formHeight * Screen.TwipsPerPixelY - Me.left = formLeft * Screen.TwipsPerPixelX - Me.Top = formTop * Screen.TwipsPerPixelY - End If - - tvwScenery.Height = formHeight - 41 - 20 - - mnuTools.Checked = loadString("Tools", "Visible", appPath & "\workspace\" & FileName) - frmTools.xPos = loadInt("Tools", "Left", appPath & "\workspace\" & FileName) - frmTools.yPos = loadInt("Tools", "Top", appPath & "\workspace\" & FileName) - frmTools.collapsed = loadString("Tools", "Collapsed", appPath & "\workspace\" & FileName) - - mnuDisplay.Checked = loadString("Display", "Visible", appPath & "\workspace\" & FileName) - frmDisplay.xPos = loadInt("Display", "Left", appPath & "\workspace\" & FileName) - frmDisplay.yPos = loadInt("Display", "Top", appPath & "\workspace\" & FileName) - frmDisplay.collapsed = loadString("Display", "Collapsed", appPath & "\workspace\" & FileName) - - mnuInfo.Checked = loadString("Properties", "Visible", appPath & "\workspace\" & FileName) - frmInfo.xPos = loadInt("Properties", "Left", appPath & "\workspace\" & FileName) - frmInfo.yPos = loadInt("Properties", "Top", appPath & "\workspace\" & FileName) - frmInfo.collapsed = loadString("Properties", "Collapsed", appPath & "\workspace\" & FileName) - - mnuPalette.Checked = loadString("Palette", "Visible", appPath & "\workspace\" & FileName) - frmPalette.xPos = loadInt("Palette", "Left", appPath & "\workspace\" & FileName) - frmPalette.yPos = loadInt("Palette", "Top", appPath & "\workspace\" & FileName) - frmPalette.collapsed = loadString("Palette", "Collapsed", appPath & "\workspace\" & FileName) - - mnuScenery.Checked = loadString("Scenery", "Visible", appPath & "\workspace\" & FileName) - frmScenery.xPos = loadInt("Scenery", "Left", appPath & "\workspace\" & FileName) - frmScenery.yPos = loadInt("Scenery", "Top", appPath & "\workspace\" & FileName) - frmScenery.collapsed = loadString("Scenery", "Collapsed", appPath & "\workspace\" & FileName) - - mnuWaypoints.Checked = loadString("Waypoints", "Visible", appPath & "\workspace\" & FileName) - frmWaypoints.xPos = loadInt("Waypoints", "Left", appPath & "\workspace\" & FileName) - frmWaypoints.yPos = loadInt("Waypoints", "Top", appPath & "\workspace\" & FileName) - frmWaypoints.collapsed = loadString("Waypoints", "Collapsed", appPath & "\workspace\" & FileName) - - mnuTexture.Checked = loadString("Texture", "Visible", appPath & "\workspace\" & FileName) - frmTexture.xPos = loadInt("Texture", "Left", appPath & "\workspace\" & FileName) - frmTexture.yPos = loadInt("Texture", "Top", appPath & "\workspace\" & FileName) - frmTexture.collapsed = loadString("Texture", "Collapsed", appPath & "\workspace\" & FileName) - - Exit Sub - -ErrorHandler: - - MsgBox "Error loading workspace" & vbNewLine & Error$ - -End Sub - -Public Sub loadColors() - - On Error GoTo ErrorHandler - - bgClr = CLng("&H" + loadString("GUIColors", "Background", appPath & "\" & gfxDir & "\colors.ini")) - lblBackClr = CLng("&H" + loadString("GUIColors", "LabelBack", appPath & "\" & gfxDir & "\colors.ini")) - lblTextClr = CLng("&H" + loadString("GUIColors", "LabelText", appPath & "\" & gfxDir & "\colors.ini")) - txtBackClr = CLng("&H" + loadString("GUIColors", "TextBoxBack", appPath & "\" & gfxDir & "\colors.ini")) - txtTextClr = CLng("&H" + loadString("GUIColors", "TextBoxText", appPath & "\" & gfxDir & "\colors.ini")) - frameClr = CLng("&H" + loadString("GUIColors", "Frame", appPath & "\" & gfxDir & "\colors.ini")) - font1 = loadString("GUIColors", "font1", appPath & "\" & gfxDir & "\colors.ini", 40) - font2 = loadString("GUIColors", "font2", appPath & "\" & gfxDir & "\colors.ini", 40) - - If font1 = "" Then font1 = "Arial" - If font2 = "" Then font2 = "Arial" - - Exit Sub - -ErrorHandler: - - MsgBox "Error loading colors" & vbNewLine & Error$ - -End Sub - -Private Sub mnuExit_Click() - - Terminate - -End Sub - -Private Sub mnuNew_Click() - - Dim Result As VbMsgBoxResult - - If prompt Then - Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) - DoEvents - If Result = vbCancel Then - Exit Sub - ElseIf Result = vbYes Then - mnuSave_Click - If prompt Then Exit Sub - End If - End If - newMap - -End Sub - -Private Sub mnuOpen_Click() - - On Error GoTo ErrorHandler - - Dim Result As VbMsgBoxResult - - If prompt Then - Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) - DoEvents - If Result = vbCancel Then - Exit Sub - ElseIf Result = vbYes Then - mnuSave_Click - If prompt Then Exit Sub - End If - End If - DoEvents - - frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" - commonDialog.InitDir = uncompDir - commonDialog.FileName = uncompDir & currentFileName - frmSoldatMapEditor.commonDialog.DialogTitle = "Load Map" - commonDialog.ShowOpen - - If commonDialog.FileName <> "" Then - prompt = False - recentFiles commonDialog.FileName - polyCount = 0 - numSelectedPolys = 0 - ReDim selectedPolys(0) - ReDim vertexList(0) - ReDim Polys(0) - selectedCoords(1).X = 0 - selectedCoords(1).Y = 0 - selectedCoords(2).X = 0 - selectedCoords(2).Y = 0 - LoadFile commonDialog.FileName - End If - - RegainFocus - - Exit Sub - -ErrorHandler: - - If Error$ <> "Cancel was selected." Then - MsgBox "Error opening file" & vbNewLine & Error$ - End If - RegainFocus - -End Sub - -Private Sub mnuOpenCompiled_Click() - - On Error GoTo ErrorHandler - - Dim Result As VbMsgBoxResult - - If prompt Then - Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) - DoEvents - If Result = vbCancel Then - Exit Sub - ElseIf Result = vbYes Then - mnuSave_Click - If prompt Then Exit Sub - End If - End If - DoEvents - - frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" - commonDialog.InitDir = soldatDir & "Maps\" - commonDialog.FileName = soldatDir & "Maps\" & currentFileName - frmSoldatMapEditor.commonDialog.DialogTitle = "Load Map" - commonDialog.ShowOpen - - If commonDialog.FileName <> "" Then - prompt = False - recentFiles commonDialog.FileName - polyCount = 0 - numSelectedPolys = 0 - ReDim selectedPolys(0) - ReDim vertexList(0) - ReDim Polys(0) - selectedCoords(1).X = 0 - selectedCoords(1).Y = 0 - selectedCoords(2).X = 0 - selectedCoords(2).Y = 0 - LoadFile commonDialog.FileName - End If - - RegainFocus - - Exit Sub - -ErrorHandler: - - If Error$ <> "Cancel was selected." Then - MsgBox "Error opening compiled map" & vbNewLine & Error$ - End If - RegainFocus - -End Sub - -Private Sub mnuSave_Click() - - Dim i As Integer - - On Error GoTo ErrorHandler - - frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" - frmSoldatMapEditor.commonDialog.DialogTitle = "Save Map" - commonDialog.FileName = uncompDir & currentFileName - commonDialog.InitDir = uncompDir - - If lblFileName.Caption = "Untitled.pms" Then - - commonDialog.ShowSave - - If commonDialog.FileName <> "" Then - - recentFiles commonDialog.FileName - - DoEvents - SaveFile commonDialog.FileName - prompt = False - End If - - Else - SaveFile commonDialog.FileName - prompt = False - End If - - RegainFocus - - Exit Sub - -ErrorHandler: - - If Error$ <> "Cancel was selected." Then - MsgBox "Error saving file" & vbNewLine & Error$ - End If - RegainFocus - -End Sub - -Private Sub mnuSaveAs_Click() - - Dim i As Integer - - On Error GoTo ErrorHandler - - frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" - commonDialog.InitDir = appPath & "\Maps\" - commonDialog.FileName = appPath & "\Maps\" & currentFileName - frmSoldatMapEditor.commonDialog.DialogTitle = "Save Map" - commonDialog.ShowSave - - If commonDialog.FileName <> "" Then - - recentFiles commonDialog.FileName - - DoEvents - SaveFile commonDialog.FileName - prompt = False - End If - - RegainFocus - - Exit Sub - -ErrorHandler: - - If Error$ <> "Cancel was selected." Then - MsgBox "Error saving as" & vbNewLine & Error$ - End If - RegainFocus - -End Sub - -Private Sub mnuCompile_Click() - - Dim i As Integer - Dim length As Integer - - On Error GoTo ErrorHandler - - frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" - commonDialog.InitDir = frmSoldatMapEditor.soldatDir & "Maps\" - commonDialog.FileName = frmSoldatMapEditor.soldatDir & "Maps\" & currentFileName - frmSoldatMapEditor.commonDialog.DialogTitle = "Compile to pms" - - If lblFileName.Caption = "Untitled.pms" Then - - commonDialog.ShowSave - DoEvents - - If commonDialog.FileName <> "" Then - - SaveAndCompile commonDialog.FileName - prompt = False - - For i = 1 To Len(commonDialog.FileName) - If mid(commonDialog.FileName, i, 1) = "\" Then - length = i + 1 - End If - Next - lastCompiled = mid(commonDialog.FileName, length, Len(commonDialog.FileName) - length - 3) - End If - Else - SaveAndCompile commonDialog.FileName - prompt = False - - For i = 1 To Len(commonDialog.FileName) - If mid(commonDialog.FileName, i, 1) = "\" Then - length = i + 1 - End If - Next - lastCompiled = mid(commonDialog.FileName, length, Len(commonDialog.FileName) - length - 3) - - End If - - RegainFocus - - Exit Sub - -ErrorHandler: - - If Error$ <> "Cancel was selected." Then - MsgBox "Error compiling map" & vbNewLine & Error$ - End If - RegainFocus - -End Sub - -Private Sub mnuCompileAs_Click() - - Dim i As Integer - Dim length As Integer - - On Error GoTo ErrorHandler - - frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" - commonDialog.InitDir = frmSoldatMapEditor.soldatDir & "Maps\" - commonDialog.FileName = frmSoldatMapEditor.soldatDir & "Maps\" & currentFileName - frmSoldatMapEditor.commonDialog.DialogTitle = "Compile to pms" - commonDialog.ShowSave - - If commonDialog.FileName <> "" Then - DoEvents - SaveAndCompile commonDialog.FileName - prompt = False - - For i = 1 To Len(commonDialog.FileName) - If mid(commonDialog.FileName, i, 1) = "\" Then - length = i + 1 - End If - Next - lastCompiled = mid(commonDialog.FileName, length, Len(commonDialog.FileName) - length - 3) - End If - - RegainFocus - - Exit Sub - -ErrorHandler: - - If Error$ <> "Cancel was selected." Then - MsgBox "Error compiling map" & vbNewLine & Error$ - End If - RegainFocus - -End Sub - -Private Function recentFiles(FileName As String) As Boolean - - Dim i As Integer - Dim inRecent As Boolean - Dim Index As Integer - - For i = 0 To 9 - If mnuRecent(i).Caption = FileName Then - inRecent = True - Index = i - End If - Next - If Not inRecent Then - updateRecent FileName - Else - For i = Index To 1 Step -1 - mnuRecent(i).Caption = mnuRecent(i - 1).Caption - Next - mnuRecent(0).Caption = FileName - End If - -End Function - -Private Sub mnuExport_Click() - - On Error GoTo ErrorHandler - - frmSoldatMapEditor.commonDialog.Filter = "Prefab (*.pfb)|*.pfb" - commonDialog.InitDir = prefabDir - commonDialog.FileName = "Untitled.pfb" - frmSoldatMapEditor.commonDialog.DialogTitle = "Save Prefab" - commonDialog.ShowSave - - If commonDialog.FileName <> "" Then - - savePrefab commonDialog.FileName - - End If - - RegainFocus - - Exit Sub - -ErrorHandler: - - If Error$ <> "Cancel was selected." Then - MsgBox "Error exporting" & vbNewLine & Error$ - End If - RegainFocus - -End Sub - -Private Sub mnuImport_Click() - - On Error GoTo ErrorHandler - - commonDialog.Filter = "Prefab (*.pfb)|*.pfb" - commonDialog.InitDir = prefabDir - commonDialog.FileName = "" - commonDialog.DialogTitle = "Import" - commonDialog.ShowOpen - - If commonDialog.FileName <> "" Then - - loadPrefab commonDialog.FileName - - End If - - RegainFocus - - Exit Sub - -ErrorHandler: - - If Error$ <> "Cancel was selected." Then - MsgBox "Error importing" & vbNewLine & Error$ - End If - RegainFocus - -End Sub - -Private Sub savePrefab(FileName As String) - - On Error GoTo ErrorHandler - - Dim i As Integer, j As Integer - Dim Polygon As TPolygon - Dim elementName(50) As Byte - Dim elementString As String - Dim numSelCon As Integer - Dim offset As Integer - Dim tempConnection As TConnection - Dim alpha As Byte - - Open FileName For Binary Access Write Lock Write As #1 - - Put #1, , numSelectedPolys - For i = 1 To numSelectedPolys - Polygon = Polys(selectedPolys(i)) - For j = 1 To 3 - Polygon.vertex(j).X = PolyCoords(selectedPolys(i)).vertex(j).X - Polygon.vertex(j).Y = PolyCoords(selectedPolys(i)).vertex(j).Y - vertexList(selectedPolys(i)).vertex(j) = 1 - alpha = getAlpha(Polys(selectedPolys(i)).vertex(j).Color) - Polygon.vertex(j).Color = ARGB(alpha, RGB(vertexList(selectedPolys(i)).color(j).blue, vertexList(selectedPolys(i)).color(j).green, vertexList(selectedPolys(i)).color(j).red)) - Next - Put #1, , Polygon - Put #1, , vertexList(selectedPolys(i)).vertex(1) - Put #1, , vertexList(selectedPolys(i)).vertex(2) - Put #1, , vertexList(selectedPolys(i)).vertex(3) - Put #1, , vertexList(selectedPolys(i)).polyType - Next - - Put #1, , numSelectedScenery - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - Put #1, , Scenery(i) - elementString = frmScenery.lstScenery.List(Scenery(i).Style - 1) - elementName(0) = Len(elementString) - For j = 1 To elementName(0) - elementName(j) = Asc(mid(elementString, j, 1)) - Next - Put #1, , elementName - End If - Next - - Put #1, , numSelColliders - For i = 1 To colliderCount - If Colliders(i).active = 1 Then - Put #1, , Colliders(i) - End If - Next - - Put #1, , numSelSpawns - For i = 1 To spawnPoints - If Spawns(i).active = 1 Then - Put #1, , Spawns(i) - End If - Next - - offset = 0 - Put #1, , numSelWaypoints - For i = 1 To waypointCount - If Waypoints(i).selected Then - offset = offset + 1 - Waypoints(i).tempIndex = offset - Put #1, , Waypoints(i) - End If - Next - - numSelCon = 0 - For i = 1 To conCount - If Waypoints(Connections(i).point1).selected And Waypoints(Connections(i).point2).selected Then - numSelCon = numSelCon + 1 - End If - Next - - Put #1, , numSelCon - For i = 1 To conCount - If Waypoints(Connections(i).point1).selected And Waypoints(Connections(i).point2).selected Then - tempConnection.point1 = Waypoints(Connections(i).point1).tempIndex - tempConnection.point2 = Waypoints(Connections(i).point2).tempIndex - Put #1, , tempConnection - End If - Next - - For i = 1 To waypointCount - Waypoints(i).tempIndex = i - Next - - Close #1 - - Exit Sub - -ErrorHandler: - - MsgBox Error$ - -End Sub - -Private Sub loadPrefab(FileName As String) - - On Error GoTo ErrorHandler - - Dim newPolys As Integer, newScenery As Integer - Dim newElements As Integer - Dim elementName(50) As Byte - Dim elementString As String - Dim newColliders As Integer, newSpawnPoints As Integer, newWaypoints As Integer, newConnections As Integer - Dim i As Integer, j As Integer - Dim tehValue As Integer - Dim tempClr As TColor - - mnuDeselect_Click - - Open FileName For Binary Access Read Lock Read As #1 - - Get #1, , newPolys - If newPolys > 0 Then - ReDim Preserve Polys(polyCount + newPolys) - ReDim Preserve PolyCoords(polyCount + newPolys) - ReDim Preserve vertexList(polyCount + newPolys) - numSelectedPolys = newPolys - ReDim selectedPolys(newPolys) - - For i = 1 To newPolys - tehValue = polyCount + i - Get #1, , Polys(tehValue) - Get #1, , vertexList(tehValue).vertex(1) - Get #1, , vertexList(tehValue).vertex(2) - Get #1, , vertexList(tehValue).vertex(3) - Get #1, , vertexList(tehValue).polyType - For j = 1 To 3 - PolyCoords(tehValue).vertex(j).X = Polys(tehValue).vertex(j).X - PolyCoords(tehValue).vertex(j).Y = Polys(tehValue).vertex(j).Y - Polys(tehValue).vertex(j).X = (PolyCoords(tehValue).vertex(j).X - scrollCoords(2).X) * zoomFactor - Polys(tehValue).vertex(j).Y = (PolyCoords(tehValue).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - tempClr = getRGB(Polys(tehValue).vertex(j).Color) - vertexList(tehValue).color(j).red = tempClr.red - vertexList(tehValue).color(j).green = tempClr.green - vertexList(tehValue).color(j).blue = tempClr.blue - Next - selectedPolys(i) = tehValue - Next - polyCount = polyCount + newPolys - End If - - Get #1, , newScenery - If newScenery > 0 Then - If Not showScenery Then - showScenery = True - frmDisplay.setLayer 5, showScenery - End If - numSelectedScenery = newScenery - ReDim Preserve Scenery(sceneryCount + newScenery) - If newScenery > 0 Then - For i = 1 To newScenery - tehValue = sceneryCount + i - Get #1, , Scenery(tehValue) - Scenery(tehValue).screenTr.X = (Scenery(tehValue).Translation.X - scrollCoords(2).X) * zoomFactor - Scenery(tehValue).screenTr.Y = (Scenery(tehValue).Translation.Y - scrollCoords(2).Y) * zoomFactor - Scenery(tehValue).Style = 0 - - Get #1, , elementName - 'get scenery name - elementString = "" - For j = 1 To elementName(0) - elementString = elementString + Chr$(elementName(j)) - Next - 'find scenery in list - For j = 1 To sceneryElements - If frmScenery.lstScenery.List(j - 1) = elementString Then - Scenery(tehValue).Style = j - End If - Next - 'scenery not in list, so load it - If Scenery(tehValue).Style = 0 Then - CreateSceneryTexture elementString - Scenery(tehValue).Style = sceneryElements - End If - Next - End If - End If - sceneryCount = sceneryCount + newScenery - - Get #1, , newColliders - If newColliders > 0 Then - showObjects = True - numSelColliders = newColliders - ReDim Preserve Colliders(colliderCount + newColliders) - For i = 1 To newColliders - Get #1, , Colliders(colliderCount + i) - Next - colliderCount = colliderCount + newColliders - End If - - Get #1, , newSpawnPoints - If newSpawnPoints > 0 Then - showObjects = True - numSelSpawns = newSpawnPoints - ReDim Preserve Spawns(spawnPoints + newSpawnPoints) - For i = 1 To newSpawnPoints - Get #1, , Spawns(spawnPoints + i) - Next - spawnPoints = spawnPoints + newSpawnPoints - End If - - Get #1, , newWaypoints - If newWaypoints > 0 Then - showWaypoints = True - numSelWaypoints = newWaypoints - ReDim Preserve Waypoints(waypointCount + newWaypoints) - For i = 1 To newWaypoints - Get #1, , Waypoints(waypointCount + i) - Next - Get #1, , newConnections - If newConnections > 0 Then - ReDim Preserve Connections(conCount + newConnections) - For i = 1 To newConnections - Get #1, , Connections(conCount + i) - Connections(conCount + i).point1 = Connections(conCount + i).point1 + waypointCount - Connections(conCount + i).point2 = Connections(conCount + i).point2 + waypointCount - Next - conCount = conCount + newConnections - End If - waypointCount = waypointCount + newWaypoints - For i = 1 To waypointCount - Waypoints(i).tempIndex = i - Next - End If - - frmDisplay.setLayer 6, showObjects - - Close #1 - - setMapData - - getInfo - getRCenter - - Exit Sub - -ErrorHandler: - - MsgBox Error$ - -End Sub - -Private Sub mnuRunSoldat_Click() - - SetGameMode lastCompiled - SetMapList lastCompiled - RunSoldat - -End Sub - -Private Sub SetMapList(FileName As String) - - Open soldatDir & "mapslist.txt" For Output As #1 - Print #1, FileName - Close #1 - -End Sub - -Private Sub mnuUndo_Click() - - loadUndo False - -End Sub - -Private Sub mnuRedo_Click() - - loadUndo True - -End Sub - -Private Sub mnuDuplicate_Click() - - Dim i As Integer, j As Integer - Dim offset As Integer - - On Error GoTo ErrorHandler - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - polyCount = polyCount + numSelectedPolys - ReDim Preserve Polys(polyCount) - ReDim Preserve PolyCoords(polyCount) - ReDim Preserve vertexList(polyCount) - For i = 1 To numSelectedPolys - PolyCoords(polyCount - numSelectedPolys + i) = PolyCoords(selectedPolys(i)) - PolyCoords(polyCount - numSelectedPolys + i).vertex(1).X = PolyCoords(selectedPolys(i)).vertex(1).X + 32 - PolyCoords(polyCount - numSelectedPolys + i).vertex(2).X = PolyCoords(selectedPolys(i)).vertex(2).X + 32 - PolyCoords(polyCount - numSelectedPolys + i).vertex(3).X = PolyCoords(selectedPolys(i)).vertex(3).X + 32 - Polys(polyCount - numSelectedPolys + i) = Polys(selectedPolys(i)) - Polys(polyCount - numSelectedPolys + i).vertex(1).X = (PolyCoords(polyCount - numSelectedPolys + i).vertex(1).X - scrollCoords(2).X) * zoomFactor - Polys(polyCount - numSelectedPolys + i).vertex(2).X = (PolyCoords(polyCount - numSelectedPolys + i).vertex(2).X - scrollCoords(2).X) * zoomFactor - Polys(polyCount - numSelectedPolys + i).vertex(3).X = (PolyCoords(polyCount - numSelectedPolys + i).vertex(3).X - scrollCoords(2).X) * zoomFactor - vertexList(polyCount - numSelectedPolys + i).polyType = vertexList(selectedPolys(i)).polyType - vertexList(polyCount - numSelectedPolys + i).color(1) = vertexList(selectedPolys(i)).color(1) - vertexList(polyCount - numSelectedPolys + i).color(2) = vertexList(selectedPolys(i)).color(2) - vertexList(polyCount - numSelectedPolys + i).color(3) = vertexList(selectedPolys(i)).color(3) - For j = 1 To 3 - vertexList(selectedPolys(i)).vertex(j) = 0 - vertexList(polyCount - numSelectedPolys + i).vertex(j) = 1 - Next - selectedPolys(i) = polyCount - numSelectedPolys + i - Next - - End If - offset = 0 - If numSelectedScenery > 0 Then - ReDim Preserve Scenery(sceneryCount + numSelectedScenery) - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - offset = offset + 1 - Scenery(sceneryCount + offset) = Scenery(i) - Scenery(sceneryCount + offset).Translation.X = Scenery(sceneryCount + offset).Translation.X + 32 - Scenery(sceneryCount + offset).screenTr.X = Scenery(sceneryCount + offset).screenTr.X + 32 * zoomFactor - Scenery(i).selected = 0 - End If - Next - sceneryCount = sceneryCount + numSelectedScenery - End If - - If numSelectedScenery > 0 Or numSelectedPolys > 0 Then - rCenter.X = rCenter.X + 32 - selRect(0).X = selRect(0).X + 32 - selRect(1).X = selRect(1).X + 32 - selRect(2).X = selRect(2).X + 32 - selRect(3).X = selRect(3).X + 32 - End If - - offset = 0 - For i = 1 To spawnPoints - If Spawns(i).active = 1 Then - offset = offset + 1 - ReDim Preserve Spawns(spawnPoints + offset) - Spawns(spawnPoints + offset) = Spawns(i) - Spawns(spawnPoints + offset).X = Spawns(spawnPoints + offset).X + 32 - Spawns(i).active = 0 - End If - Next - spawnPoints = spawnPoints + offset - - offset = 0 - For i = 1 To colliderCount - If Colliders(i).active = 1 Then - offset = offset + 1 - ReDim Preserve Colliders(colliderCount + offset) - Colliders(colliderCount + offset) = Colliders(i) - Colliders(colliderCount + offset).X = Colliders(colliderCount + offset).X + 32 - Colliders(i).active = 0 - End If - Next - colliderCount = colliderCount + offset - - If numSelWaypoints > 0 Then - - offset = 0 - For i = 1 To waypointCount - If Waypoints(i).selected Then - offset = offset + 1 - ReDim Preserve Waypoints(waypointCount + offset) - Waypoints(waypointCount + offset) = Waypoints(i) - Waypoints(waypointCount + offset).X = Waypoints(waypointCount + offset).X + 32 - Waypoints(waypointCount + offset).tempIndex = 0 - Waypoints(i).tempIndex = waypointCount + offset - End If - Next - - waypointCount = waypointCount + offset - - offset = 0 - For i = 1 To conCount - If Waypoints(Connections(i).point1).selected And Waypoints(Connections(i).point2).selected Then - offset = offset + 1 - ReDim Preserve Connections(conCount + offset) - Connections(conCount + offset).point1 = Waypoints(Connections(i).point1).tempIndex - Connections(conCount + offset).point2 = Waypoints(Connections(i).point2).tempIndex - End If - Next - - conCount = conCount + offset - - For i = 1 To waypointCount - If Waypoints(i).tempIndex > 0 Then - Waypoints(i).selected = False - End If - Waypoints(i).tempIndex = i - Next - - End If - - setMapData - - getRCenter - - SaveUndo - Render - getInfo - - prompt = True - - Exit Sub - -ErrorHandler: - - MsgBox "Duplicate error" & vbNewLine & Error$ - -End Sub - -Private Sub mnuClear_Click() - - deletePolys - -End Sub - -Private Sub mnuSelectAll_Click() - - Dim i As Integer, j As Integer - - If showPolys Or showWireframe Or showPoints Then - ReDim selectedPolys(polyCount) - For i = 1 To polyCount - selectedPolys(i) = i - For j = 1 To 3 - vertexList(i).vertex(j) = 1 - Next - Next - numSelectedPolys = polyCount - End If - - If showScenery Or showWireframe Or showPoints Then - numSelectedScenery = 0 - For i = 1 To sceneryCount - If (Scenery(i).level = 0 And sslBack) Or (Scenery(i).level = 1 And sslMid) Or (Scenery(i).level = 2 And sslFront) Then - Scenery(i).selected = 1 - numSelectedScenery = numSelectedScenery + 1 - End If - Next - End If - - If showObjects Then - For i = 1 To spawnPoints - Spawns(i).active = 1 - Next - numSelSpawns = spawnPoints - For i = 1 To colliderCount - Colliders(i).active = 1 - Next - numSelColliders = colliderCount - End If - - If showLights Then - For i = 1 To lightCount - Lights(i).selected = 1 - Next - numSelLights = lightCount - End If - - If showWaypoints Then - For i = 1 To waypointCount - Waypoints(i).selected = True - Next - numSelWaypoints = waypointCount - End If - - getRCenter - getInfo - - Render - -End Sub - -Private Sub mnuDeselect_Click() - - Dim i As Integer, j As Integer - - numSelectedPolys = 0 - ReDim selectedPolys(0) - numSelectedScenery = 0 - numSelSpawns = 0 - numSelColliders = 0 - numSelWaypoints = 0 - - For i = 1 To polyCount - For j = 1 To 3 - vertexList(i).vertex(j) = 0 - Next - Next - For i = 1 To sceneryCount - Scenery(i).selected = 0 - Next - For i = 1 To colliderCount - Colliders(i).active = 0 - Next - For i = 1 To spawnPoints - Spawns(i).active = 0 - Next - For i = 1 To waypointCount - Waypoints(i).selected = False - Next - - Render - getInfo - -End Sub - -Private Sub mnuSelColor_Click() - - Dim i As Integer, j As Integer - Dim addPoly As Byte - Dim clrVal As TColor - - numSelectedPolys = 0 - ReDim selectedPolys(0) - - For i = 1 To polyCount - For j = 1 To 3 - vertexList(i).vertex(j) = 0 - clrVal = getRGB(Polys(i).vertex(j).Color) - If clrVal.red = polyClr.red And clrVal.green = polyClr.green And clrVal.blue = polyClr.blue Then - addPoly = 1 - vertexList(i).vertex(j) = 1 - End If - Next - If addPoly = 1 Then - numSelectedPolys = numSelectedPolys + 1 - ReDim Preserve selectedPolys(numSelectedPolys) - selectedPolys(numSelectedPolys) = i - End If - addPoly = 0 - Next - - Render - -End Sub - -Private Sub mnuBringToFront_Click() - - Dim i As Integer, j As Integer - Dim tempTri As TTriangle - Dim tempPoly As TPolygon - Dim tempScenery As TScenery - Dim tempVertex As TVertexData - Dim offset As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - offset = polyCount - For i = polyCount To 1 Step -1 - If (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) > 0 Then 'if selected - tempPoly = Polys(i) - tempTri = PolyCoords(i) - tempVertex = vertexList(i) - For j = i To (offset - 1) - Polys(j) = Polys(j + 1) - PolyCoords(j) = PolyCoords(j + 1) - vertexList(j) = vertexList(j + 1) - Next - Polys(offset) = tempPoly - PolyCoords(offset) = tempTri - vertexList(offset) = tempVertex - - selectedPolys(polyCount - offset + 1) = offset - offset = offset - 1 - End If - Next - End If - - If numSelectedScenery > 0 Then - offset = sceneryCount - For i = sceneryCount To 1 Step -1 - If Scenery(i).selected Then 'if selected - tempScenery = Scenery(i) - For j = i To (offset - 1) - Scenery(j) = Scenery(j + 1) - Next - Scenery(offset) = tempScenery - offset = offset - 1 - End If - Next - End If - - prompt = True - SaveUndo - Render - getInfo - -End Sub - -Private Sub mnuSendToBack_Click() - - Dim i As Integer, j As Integer - Dim tempTri As TTriangle - Dim tempPoly As TPolygon - Dim tempScenery As TScenery - Dim tempVertex As TVertexData - Dim offset As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - offset = 1 - For i = 1 To polyCount - If (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) > 0 Then 'if selected - tempPoly = Polys(i) - tempTri = PolyCoords(i) - tempVertex = vertexList(i) - For j = i To offset + 1 Step -1 - Polys(j) = Polys(j - 1) - PolyCoords(j) = PolyCoords(j - 1) - vertexList(j) = vertexList(j - 1) - Next - Polys(offset) = tempPoly - PolyCoords(offset) = tempTri - vertexList(offset) = tempVertex - - selectedPolys(offset) = offset - offset = offset + 1 - End If - Next - End If - - - If numSelectedScenery > 0 Then - offset = 1 - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then 'if selected - tempScenery = Scenery(i) - For j = i To offset + 1 Step -1 - Scenery(j) = Scenery(j - 1) - Next - Scenery(offset) = tempScenery - offset = offset + 1 - End If - Next - End If - - prompt = True - SaveUndo - Render - getInfo - -End Sub - -Private Sub mnuBringForward_Click() - - Dim i As Integer - Dim tempTri As TTriangle - Dim tempPoly As TPolygon - Dim tempScenery As TScenery - Dim tempVertex As TVertexData - Dim offset As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - offset = polyCount - For i = (polyCount - 1) To 1 Step -1 - If (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) > 0 Then 'if selected - If (vertexList(i + 1).vertex(1) + vertexList(i + 1).vertex(2) + vertexList(i + 1).vertex(3)) > 0 Then - selectedPolys(polyCount - offset + 1) = i + 1 - offset = offset - 1 - Else - tempPoly = Polys(i) - tempTri = PolyCoords(i) - tempVertex = vertexList(i) - - Polys(i) = Polys(i + 1) - PolyCoords(i) = PolyCoords(i + 1) - vertexList(i) = vertexList(i + 1) - - Polys(i + 1) = tempPoly - PolyCoords(i + 1) = tempTri - vertexList(i + 1) = tempVertex - - selectedPolys(polyCount - offset + 1) = i + 1 - offset = offset - 1 - End If - End If - Next - End If - - If numSelectedScenery > 0 Then - offset = sceneryCount - For i = (sceneryCount - 1) To 1 Step -1 - If Scenery(i).selected = 1 Then 'if selected - If Scenery(i + 1).selected = 1 Then - offset = offset - 1 - Else - tempScenery = Scenery(i) - Scenery(i) = Scenery(i + 1) - Scenery(i + 1) = tempScenery - offset = offset - 1 - End If - End If - Next - End If - - prompt = True - SaveUndo - Render - getInfo - -End Sub - -Private Sub mnuSendBackward_Click() - - Dim i As Integer - Dim tempTri As TTriangle - Dim tempPoly As TPolygon - Dim tempVertex As TVertexData - Dim offset As Integer - Dim tempScenery As TScenery - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - offset = 1 - For i = 2 To polyCount - If (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) > 0 Then 'if selected - If (vertexList(i - 1).vertex(1) + vertexList(i - 1).vertex(2) + vertexList(i - 1).vertex(3)) > 0 Then - selectedPolys(offset) = i - 1 - offset = offset + 1 - Else - tempPoly = Polys(i) - tempTri = PolyCoords(i) - tempVertex = vertexList(i) - - Polys(i) = Polys(i - 1) - PolyCoords(i) = PolyCoords(i - 1) - vertexList(i) = vertexList(i - 1) - - Polys(i - 1) = tempPoly - PolyCoords(i - 1) = tempTri - vertexList(i - 1) = tempVertex - - selectedPolys(offset) = i - 1 - offset = offset + 1 - End If - End If - Next - End If - - If numSelectedScenery > 0 Then - offset = 1 - For i = 2 To sceneryCount - If Scenery(i).selected = 1 Then 'if selected - If Scenery(i - 1).selected = 1 Then - offset = offset + 1 - Else - tempScenery = Scenery(i) - Scenery(i) = Scenery(i - 1) - Scenery(i - 1) = tempScenery - offset = offset + 1 - End If - End If - Next - End If - - prompt = True - SaveUndo - Render - getInfo - -End Sub - -Private Sub mnuFixTexture_Click() - - Dim PolyNum As Integer - Dim i As Integer, j As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - PolyNum = selectedPolys(i) - For j = 1 To 3 - If vertexList(PolyNum).vertex(j) = 1 Then - Polys(PolyNum).vertex(j).tu = (PolyCoords(PolyNum).vertex(j).X / xTexture) - Polys(PolyNum).vertex(j).tv = (PolyCoords(PolyNum).vertex(j).Y / yTexture) - End If - Next - Next - prompt = True - End If - - SaveUndo - Render - getInfo - -End Sub - -Private Sub mnuUntexture_Click() - - Dim i As Integer, j As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then - Polys(selectedPolys(i)).vertex(j).tu = 1 - Polys(selectedPolys(i)).vertex(j).tv = 1 - End If - Next - Next - prompt = True - End If - - SaveUndo - Render - getInfo - -End Sub - -Private Sub mnuVisible_Click() - - Dim i As Integer, j As Integer - - On Error GoTo ErrorHandler - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - For i = 1 To numSelectedPolys - For j = 1 To 3 - If Polys(selectedPolys(i)).vertex(j).z < 0 Then - Polys(selectedPolys(i)).vertex(j).rhw = 1 - Polys(selectedPolys(i)).vertex(j).z = 1 - Else - Polys(selectedPolys(i)).vertex(j).rhw = -10 - Polys(selectedPolys(i)).vertex(j).z = -1 - End If - Next - Next - - prompt = True - SaveUndo - Render - - Exit Sub - -ErrorHandler: - - MsgBox Error$ - -End Sub - -Private Sub mnuAverage_Click() - - AverageVertices - -End Sub - -Private Sub mnuApplyLight_Click() - - Dim i As Integer, j As Integer - Dim tehClr As TColor - - If lightCount = 0 Then Exit Sub - - If numSelectedPolys > 0 Then - - For i = 1 To numSelectedPolys - For j = 1 To 3 - 'apply poly color to base color - tehClr = getRGB(Polys(selectedPolys(i)).vertex(j).Color) - vertexList(selectedPolys(i)).color(j).red = tehClr.red - vertexList(selectedPolys(i)).color(j).green = tehClr.green - vertexList(selectedPolys(i)).color(j).blue = tehClr.blue - Next - Next - - Else - - For i = 1 To polyCount - For j = 1 To 3 - 'apply poly color to base color - tehClr = getRGB(Polys(i).vertex(j).Color) - vertexList(i).color(j).red = tehClr.red - vertexList(i).color(j).green = tehClr.green - vertexList(i).color(j).blue = tehClr.blue - Next - Next - - End If - - ReDim Lights(0) - lightCount = 0 - - Render - -End Sub - -Private Sub mnuSplit_Click() - - If numSelectedPolys < 1 Then Exit Sub - - Dim i As Integer, j As Integer - Dim left As Byte, right As Byte - Dim clr1 As TColor - Dim clr2 As TColor - Dim alpha1 As Byte - Dim alpha2 As Byte - Dim newPolys As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - For i = 1 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then - If j = 1 Then - left = 2 - right = 3 - ElseIf j = 2 Then - left = 3 - right = 1 - ElseIf j = 3 Then - left = 1 - right = 2 - End If - polyCount = polyCount + 1 - newPolys = newPolys + 1 - - ReDim Preserve Polys(polyCount) - ReDim Preserve PolyCoords(polyCount) - ReDim Preserve vertexList(polyCount) - - ReDim Preserve selectedPolys(numSelectedPolys + newPolys) - selectedPolys(numSelectedPolys + newPolys) = polyCount - vertexList(polyCount).vertex(j) = 1 - - PolyCoords(polyCount).vertex(j) = PolyCoords(selectedPolys(i)).vertex(j) - PolyCoords(polyCount).vertex(left) = PolyCoords(selectedPolys(i)).vertex(left) - - PolyCoords(polyCount).vertex(right).X = Midpoint(PolyCoords(selectedPolys(i)).vertex(left).X, PolyCoords(selectedPolys(i)).vertex(right).X) - PolyCoords(polyCount).vertex(right).Y = Midpoint(PolyCoords(selectedPolys(i)).vertex(left).Y, PolyCoords(selectedPolys(i)).vertex(right).Y) - - PolyCoords(selectedPolys(i)).vertex(left) = PolyCoords(polyCount).vertex(right) - - Polys(polyCount).vertex(j) = Polys(selectedPolys(i)).vertex(j) - Polys(polyCount).vertex(left) = Polys(selectedPolys(i)).vertex(left) - Polys(polyCount).Perp.vertex(1).z = 2 - Polys(polyCount).Perp.vertex(2).z = 2 - Polys(polyCount).Perp.vertex(3).z = 2 - - 'coords - Polys(polyCount).vertex(right) = Polys(selectedPolys(i)).vertex(right) - Polys(polyCount).vertex(right).X = (PolyCoords(polyCount).vertex(right).X - scrollCoords(2).X) * zoomFactor - Polys(polyCount).vertex(right).Y = (PolyCoords(polyCount).vertex(right).Y - scrollCoords(2).Y) * zoomFactor - - 'texture coords - Polys(polyCount).vertex(right).tu = Midpoint(Polys(selectedPolys(i)).vertex(right).tu, Polys(polyCount).vertex(left).tu) - Polys(polyCount).vertex(right).tv = Midpoint(Polys(selectedPolys(i)).vertex(right).tv, Polys(polyCount).vertex(left).tv) - - vertexList(polyCount).color(j) = vertexList(selectedPolys(i)).color(j) - vertexList(polyCount).color(left) = vertexList(selectedPolys(i)).color(left) - - 'colors - clr1 = vertexList(selectedPolys(i)).color(right) - clr2 = vertexList(polyCount).color(left) - vertexList(polyCount).color(right).red = clr1.red * 0.5 + clr2.red * 0.5 - vertexList(polyCount).color(right).green = clr1.green * 0.5 + clr2.green * 0.5 - vertexList(polyCount).color(right).blue = clr1.blue * 0.5 + clr2.blue * 0.5 - - vertexList(selectedPolys(i)).color(left) = vertexList(polyCount).color(right) - - clr1 = getRGB(Polys(selectedPolys(i)).vertex(right).Color) - clr2 = getRGB(Polys(polyCount).vertex(left).Color) - alpha1 = getAlpha(Polys(selectedPolys(i)).vertex(right).Color) - alpha2 = getAlpha(Polys(polyCount).vertex(left).Color) - Polys(polyCount).vertex(right).Color = ARGB((alpha1 * 0.5 + alpha2 * 0.5), RGB((clr1.blue * 0.5 + clr2.blue * 0.5), (clr1.green * 0.5 + clr2.green * 0.5), (clr1.red * 0.5 + clr2.red * 0.5))) - - Polys(selectedPolys(i)).vertex(left) = Polys(polyCount).vertex(right) - - vertexList(polyCount).polyType = vertexList(selectedPolys(i)).polyType - End If - Next - Next - - numSelectedPolys = numSelectedPolys + newPolys - SaveUndo - Render - getInfo - - frmInfo.lblCount(0).Caption = polyCount - frmInfo.lblCount(6).Caption = getMapDimensions - -End Sub - -Private Sub mnuJoinVertices_Click() - - Dim firstVertex As Integer - Dim i As Integer, j As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - For j = 1 To 3 - If vertexList(selectedPolys(1)).vertex(4 - j) = 1 Then - firstVertex = 4 - j - End If - Next - - For i = 2 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then - PolyCoords(selectedPolys(i)).vertex(j).X = PolyCoords(selectedPolys(1)).vertex(firstVertex).X - PolyCoords(selectedPolys(i)).vertex(j).Y = PolyCoords(selectedPolys(1)).vertex(firstVertex).Y - Polys(selectedPolys(i)).vertex(j).X = Polys(selectedPolys(1)).vertex(firstVertex).X - Polys(selectedPolys(i)).vertex(j).Y = Polys(selectedPolys(1)).vertex(firstVertex).Y - End If - Next - Next - - prompt = True - End If - - SaveUndo - Render - getInfo - -End Sub - -Private Sub mnuCreate_Click() - - If numSelectedPolys < 1 Or numSelectedPolys > 3 Then Exit Sub - - Dim i As Integer, j As Integer - Dim numSelVerts As Integer - Dim temp As D3DVECTOR2 - Dim tempVertex As TCustomVertex - Dim tempClr As TColor - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - ReDim Preserve Polys(polyCount + 1) - ReDim Preserve PolyCoords(polyCount + 1) - ReDim Preserve vertexList(polyCount + 1) - - For i = 1 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then - numSelVerts = numSelVerts + 1 - Polys(polyCount + 1).vertex(numSelVerts) = Polys(selectedPolys(i)).vertex(j) - PolyCoords(polyCount + 1).vertex(numSelVerts) = PolyCoords(selectedPolys(i)).vertex(j) - vertexList(polyCount + 1).color(numSelVerts) = vertexList(selectedPolys(i)).color(j) - vertexList(polyCount + 1).polyType = vertexList(selectedPolys(i)).polyType - End If - If numSelVerts = 3 Then Exit For - Next - If numSelVerts = 3 Then Exit For - Next - - If numSelVerts > 2 Then - polyCount = polyCount + 1 - End If - - If Not isCW(polyCount) Then 'switch to make cw - temp = PolyCoords(polyCount).vertex(3) - PolyCoords(polyCount).vertex(3) = PolyCoords(polyCount).vertex(2) - PolyCoords(polyCount).vertex(2) = temp - - tempVertex = Polys(polyCount).vertex(3) - Polys(polyCount).vertex(3) = Polys(polyCount).vertex(2) - Polys(polyCount).vertex(2) = tempVertex - - tempClr = vertexList(polyCount).color(3) - vertexList(polyCount).color(3) = vertexList(polyCount).color(2) - vertexList(polyCount).color(2) = tempClr - End If - - Polys(polyCount).Perp.vertex(1).z = 2 - Polys(polyCount).Perp.vertex(2).z = 2 - Polys(polyCount).Perp.vertex(3).z = 2 - - frmInfo.lblCount(0).Caption = polyCount - frmInfo.lblCount(6).Caption = getMapDimensions - - SaveUndo - Render - -End Sub - -Private Sub mnuSever_Click() - - Dim i As Integer - Dim offset As Integer - Dim numConnections As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - numConnections = conCount - - If numSelWaypoints > 1 Then - offset = 1 - For i = 1 To conCount - Connections(offset) = Connections(i) - If Waypoints(Connections(i).point1).selected And Waypoints(Connections(i).point2).selected Then - numConnections = numConnections - 1 - Waypoints(Connections(i).point1).numConnections = Waypoints(Connections(i).point1).numConnections - 1 - Else 'not selected - offset = offset + 1 - End If - Next - ElseIf numSelWaypoints = 1 Then - offset = 1 - For i = 1 To conCount - Connections(offset) = Connections(i) - If Waypoints(Connections(i).point1).selected Or Waypoints(Connections(i).point2).selected Then - numConnections = numConnections - 1 - Waypoints(Connections(i).point1).numConnections = Waypoints(Connections(i).point1).numConnections - 1 - Else 'not selected - offset = offset + 1 - End If - Next - End If - - conCount = numConnections - ReDim Preserve Connections(conCount) - - SaveUndo - Render - -End Sub - -Private Sub mnuRefreshBG_Click() - - Dim i As Integer, j As Integer - Dim bgSize As Integer - Dim xOffset As Integer, yOffset As Integer - - maxX = 0 - maxY = 0 - minX = 0 - minY = 0 - - If polyCount > 0 Then - For i = 1 To polyCount - For j = 1 To 3 - If PolyCoords(i).vertex(j).X > maxX Then maxX = PolyCoords(i).vertex(j).X - If PolyCoords(i).vertex(j).X < minX Then minX = PolyCoords(i).vertex(j).X - If PolyCoords(i).vertex(j).Y > maxY Then maxY = PolyCoords(i).vertex(j).Y - If PolyCoords(i).vertex(j).Y < minY Then minY = PolyCoords(i).vertex(j).Y - Next - Next - End If - - xOffset = Int(Midpoint(maxX, minX)) - yOffset = Int(Midpoint(maxY, minY)) - - If (maxX - minX) > (maxY - minY) Then - bgSize = maxX - xOffset - Else - bgSize = maxY - xOffset - End If - - bgPolyCoords(1).X = xOffset - (bgSize + 640) - bgPolyCoords(1).Y = yOffset - (bgSize + 640) - - bgPolyCoords(2).X = xOffset - (bgSize + 640) - bgPolyCoords(2).Y = yOffset + (bgSize + 640) - - bgPolyCoords(3).X = xOffset + (bgSize + 640) - bgPolyCoords(3).Y = yOffset - (bgSize + 640) - - bgPolyCoords(4).X = xOffset + (bgSize + 640) - bgPolyCoords(4).Y = yOffset + (bgSize + 640) - - For i = 1 To 4 - bgPolys(i).X = (bgPolyCoords(i).X - scrollCoords(2).X) * zoomFactor - bgPolys(i).Y = (bgPolyCoords(i).Y - scrollCoords(2).Y) * zoomFactor - Next - - frmInfo.lblCount(6).Caption = getMapDimensions - - Render - -End Sub - -Private Sub mnuPreferences_Click() - - frmPreferences.Show 1 - PolyTypeClrs(0) = frmSoldatMapEditor.selectionClr - -End Sub - -Private Sub mnuMap_Click() - - frmMap.Show 1 - ctrlDown = False - setCurrentTool currentTool - -End Sub - -Private Sub mnuZoomIn_Click() - - Zoom 2 - -End Sub - -Private Sub mnuZoomOut_Click() - - Zoom 0.5 - -End Sub - -Private Sub mnuGrid_Click() - - mnuGrid.Checked = Not mnuGrid.Checked - showGrid = mnuGrid.Checked - frmDisplay.setLayer 8, mnuGrid.Checked - Render - -End Sub - -Private Sub mnuSnapToGrid_Click() - - mnuSnapToGrid.Checked = Not mnuSnapToGrid.Checked - snapToGrid = mnuSnapToGrid.Checked - -End Sub - -Private Sub mnuRefresh_Click() - - resetDevice - -End Sub - -Private Sub mnuTools_Click() - - mnuTools.Checked = Not mnuTools.Checked - frmTools.Visible = mnuTools.Checked - -End Sub - -Private Sub mnuDisplay_Click() - - mnuDisplay.Checked = Not mnuDisplay.Checked - frmDisplay.Visible = mnuDisplay.Checked - -End Sub - -Private Sub mnuPalette_Click() - - mnuPalette.Checked = Not mnuPalette.Checked - frmPalette.Visible = mnuPalette.Checked - -End Sub - -Private Sub mnuWaypoints_Click() - - mnuWaypoints.Checked = Not mnuWaypoints.Checked - frmWaypoints.Visible = mnuWaypoints.Checked - -End Sub - -Private Sub mnuScenery_Click() - - mnuScenery.Checked = Not mnuScenery.Checked - frmScenery.Visible = mnuScenery.Checked - -End Sub - -Private Sub mnuinfo_Click() - - mnuInfo.Checked = Not mnuInfo.Checked - frmInfo.Visible = mnuInfo.Checked - -End Sub - -Private Sub mnuTexture_Click() - - mnuTexture.Checked = Not mnuTexture.Checked - frmTexture.Visible = mnuTexture.Checked - -End Sub - -Private Sub mnuBlendWireframe_Click() - - mnuBlendWireframe.Checked = Not mnuBlendWireframe.Checked - clrWireframe = mnuBlendWireframe.Checked - -End Sub - -Private Sub mnuBlendPolys_Click() - - mnuBlendPolys.Checked = Not mnuBlendPolys.Checked - clrPolys = mnuBlendPolys.Checked - -End Sub - -Private Sub mnuFixedTexture_Click() - - mnuFixedTexture.Checked = Not mnuFixedTexture.Checked - fixedTexture = mnuFixedTexture.Checked - -End Sub - -Private Sub mnuSnapToVerts_Click() - - mnuSnapToVerts.Checked = Not mnuSnapToVerts.Checked - ohSnap = mnuSnapToVerts.Checked - -End Sub - -Private Sub mnuLoadSpace_Click() - - On Error GoTo ErrorHandler - - frmSoldatMapEditor.commonDialog.Filter = "Ini File (*.ini)|*.ini" - commonDialog.InitDir = appPath & "\Workspace\" - commonDialog.FileName = "" - frmSoldatMapEditor.commonDialog.DialogTitle = "Load Workspace" - commonDialog.ShowOpen - - If commonDialog.FileName <> "" Then - If Len(Dir$(appPath & "\Workspace\" & commonDialog.FileTitle)) <> 0 Then - loadWorkspace commonDialog.FileTitle - frmTools.setForm - frmDisplay.setForm - frmInfo.setForm - frmPalette.setForm - frmScenery.setForm - frmTexture.setForm - frmWaypoints.setForm - End If - End If - - RegainFocus - - Exit Sub - -ErrorHandler: - - RegainFocus - -End Sub - -Private Sub mnuSaveSpace_Click() - - On Error GoTo ErrorHandler - - Dim iniString As String - Dim sNull As String - sNull = Chr$(0) - - frmSoldatMapEditor.commonDialog.Filter = "Ini File (*.ini)|*.ini" - commonDialog.InitDir = appPath & "\Workspace\" - commonDialog.FileName = "" - frmSoldatMapEditor.commonDialog.DialogTitle = "Save Workspace" - commonDialog.ShowSave - - If commonDialog.FileName <> "" Then - - iniString = "WindowState=" & Me.WindowState & sNull _ - & "Width=" & formWidth & sNull & "Height=" & formHeight & sNull _ - & "Left=" & formLeft & sNull & "Top=" & formTop & sNull & sNull - saveSection "Main", iniString, appPath & "\workspace\" & commonDialog.FileTitle - - saveWindow "Tools", frmTools, False, commonDialog.FileTitle - saveWindow "Display", frmDisplay, frmDisplay.collapsed, commonDialog.FileTitle - saveWindow "Properties", frmInfo, frmInfo.collapsed, commonDialog.FileTitle - saveWindow "Palette", frmPalette, frmPalette.collapsed, commonDialog.FileTitle - saveWindow "Scenery", frmScenery, frmScenery.collapsed, commonDialog.FileTitle - saveWindow "Waypoints", frmWaypoints, frmWaypoints.collapsed, commonDialog.FileTitle - saveWindow "Texture", frmTexture, frmTexture.collapsed, commonDialog.FileTitle - - End If - - RegainFocus - - Exit Sub - -ErrorHandler: - - RegainFocus - -End Sub - -Private Sub mnuResetWindows_Click() - - If Me.WindowState = vbNormal Then - - formWidth = Screen.Width / Screen.TwipsPerPixelX - (64 + 208 + 208) - formHeight = formWidth * 3 / 4 - formLeft = Screen.Width / Screen.TwipsPerPixelX / 2 - formWidth / 2 - 1 - formTop = Screen.Height / Screen.TwipsPerPixelY / 2 - formHeight / 2 - 1 - - tvwScenery.Height = formHeight - 41 - 20 - - Me.Width = formWidth * Screen.TwipsPerPixelX - Me.Height = formHeight * Screen.TwipsPerPixelY - Me.left = Screen.Width / 2 - Me.Width / 2 - Screen.TwipsPerPixelX - Me.Top = Screen.Height / 2 - Me.Height / 2 - Screen.TwipsPerPixelY - - frmTools.left = Me.left - frmTools.Width + Screen.TwipsPerPixelX - frmTools.Top = Me.Top + 41 * Screen.TwipsPerPixelY - frmPalette.left = Me.left + Me.Width - Screen.TwipsPerPixelX - frmPalette.Top = Me.Top + 41 * Screen.TwipsPerPixelY - frmDisplay.left = frmPalette.left - frmDisplay.Top = frmPalette.Top + frmPalette.Height - Screen.TwipsPerPixelY - frmScenery.left = Me.left + Me.Width - Screen.TwipsPerPixelX - frmScenery.Top = frmDisplay.Top + frmDisplay.Height - Screen.TwipsPerPixelY - frmInfo.left = Me.left - frmInfo.Width + Screen.TwipsPerPixelX - frmInfo.Top = frmTools.Top + frmTools.Height - Screen.TwipsPerPixelY - frmWaypoints.left = Me.left - frmWaypoints.Width + Screen.TwipsPerPixelX - frmWaypoints.Top = frmInfo.Top + frmInfo.Height - Screen.TwipsPerPixelY - frmTexture.Top = frmPalette.Top - frmTexture.left = frmPalette.left - frmTexture.Width + Screen.TwipsPerPixelX - - resetDevice - - Else - - frmTools.left = Me.left - frmTools.Top = Me.Top + 41 * Screen.TwipsPerPixelY - frmPalette.left = Me.left + Me.Width - frmPalette.Width - frmPalette.Top = Me.Top + 41 * Screen.TwipsPerPixelY - frmDisplay.left = frmPalette.left - frmDisplay.Top = frmPalette.Top + frmPalette.Height - Screen.TwipsPerPixelY - frmWaypoints.left = Me.left - frmWaypoints.Top = Me.Top + Me.Height - frmWaypoints.Height - 19 * Screen.TwipsPerPixelY - frmScenery.left = Me.left + Me.Width - frmScenery.Width - frmScenery.Top = frmDisplay.Top + frmDisplay.Height - Screen.TwipsPerPixelY - frmInfo.left = Me.left - frmInfo.Top = frmWaypoints.Top - frmInfo.Height + Screen.TwipsPerPixelY - frmTexture.Top = frmPalette.Top - frmTexture.left = frmPalette.left - frmTexture.Width + Screen.TwipsPerPixelX - - End If - -End Sub - -Private Sub mnuShowAll_Click() - - mnuTools.Checked = True - frmTools.Visible = True - - mnuPalette.Checked = True - frmPalette.Visible = True - - mnuDisplay.Checked = True - frmDisplay.Visible = True - - mnuScenery.Checked = True - frmScenery.Visible = True - - mnuInfo.Checked = True - frmInfo.Visible = True - - mnuTexture.Checked = True - frmTexture.Visible = True - - mnuWaypoints.Checked = True - frmWaypoints.Visible = True - -End Sub - -Private Sub mnuHideAll_Click() - - mnuTools.Checked = False - frmTools.Visible = False - - mnuPalette.Checked = False - frmPalette.Visible = False - - mnuDisplay.Checked = False - frmDisplay.Visible = False - - mnuScenery.Checked = False - frmScenery.Visible = False - - mnuInfo.Checked = False - frmInfo.Visible = False - - mnuTexture.Checked = False - frmTexture.Visible = False - - mnuWaypoints.Checked = False - frmWaypoints.Visible = False - -End Sub - -Private Sub mnuGostek_Click() - - If mnuGostek.Checked Then - gostek.X = 0 - gostek.Y = 0 - Else - mnuGostek.Checked = True - mnuSpawn(Spawns(0).Team).Checked = False - mnuCollider.Checked = False - End If - -End Sub - -Private Sub mnuCollider_Click() - - mnuCollider.Checked = True - mnuSpawn(Spawns(0).Team).Checked = False - mnuGostek.Checked = False - Colliders(0).radius = clrRadius -End Sub - -Private Sub mnuSpawn_Click(Index As Integer) - - mnuCollider.Checked = False - mnuSpawn(Spawns(0).Team).Checked = False - mnuSpawn(Index).Checked = True - mnuGostek.Checked = False - Spawns(0).Team = Index - -End Sub - -Private Sub mnuPolyType_Click(Index As Integer) - - mnuPolyType(polyType).Checked = False - mnuPolyType(Index).Checked = True - polyType = Index - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag & " (" & mnuPolyType(polyType).Caption & ")" - -End Sub - -Private Sub mnuQuad_Click() - - mnuQuad.Checked = Not mnuQuad.Checked - - If mnuQuad.Checked Then - currentFunction = TOOL_QUAD - SetCursor currentFunction + 1 - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - Else - currentFunction = TOOL_CREATE - SetCursor currentFunction + 1 - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag - End If - - lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag & " (" & mnuPolyType(polyType).Caption & ")" - -End Sub - -Private Sub mnuCustomX_Click() - - mnuCustomX.Checked = Not mnuCustomX.Checked - -End Sub - -Private Sub mnuCustomY_Click() - - mnuCustomY.Checked = Not mnuCustomY.Checked - -End Sub - -Private Sub mnuFitOnScreen_Click() - - If polyCount < 1 Then Exit Sub - - Dim Width As Integer, Height As Integer - - mnuRefreshBG_Click - - scrollCoords(2).X = -Me.ScaleWidth / 2 - 1 + Midpoint(minX, maxX) - scrollCoords(2).Y = -Me.ScaleHeight / 2 - 25 + Midpoint(minY, maxY) - zoomFactor = 1 - - Width = maxX - minX - Height = maxY - minY - - If Height / Width < (Me.ScaleHeight - 88) / (Me.ScaleWidth - 32) Then - Zoom ((Me.ScaleWidth - 32) / Width) - Else - Zoom ((Me.ScaleHeight - 88) / Height) - End If - -End Sub - -Private Sub mnuActualPixels_Click() - - zoomFactor = (Me.ScaleWidth + 2) / 640 - Zoom 1 - -End Sub - -Private Sub mnuScenTrans_Click(Index As Integer) - - mnuScenTrans(Index).Checked = Not mnuScenTrans(Index).Checked - - If Index = 0 Then 'rotate - frmScenery.rotateScenery = mnuScenTrans(Index).Checked - mouseEvent2 frmScenery.picRotate, 0, 0, BUTTON_SMALL, frmScenery.rotateScenery, BUTTON_UP - ElseIf Index = 1 Then - frmScenery.scaleScenery = mnuScenTrans(Index).Checked - mouseEvent2 frmScenery.picScale, 0, 0, BUTTON_SMALL, frmScenery.scaleScenery, BUTTON_UP - End If - -End Sub - -Public Sub getInfo() - - Dim i As Integer, j As Integer - Dim scenNum As Integer - - On Error GoTo ErrorHandler - - frmInfo.noChange = True - frmWaypoints.noChange = True - - For i = 1 To waypointCount - If Waypoints(i).selected Then - frmWaypoints.getPathNum Waypoints(i).pathNum - For j = 0 To 4 - frmWaypoints.getWayType j, Waypoints(i).wayType(j) - Next - frmWaypoints.cboSpecial.ListIndex = Waypoints(i).special - frmWaypoints.lblNumCon = Waypoints(i).numConnections - Exit For - End If - Next - - If numSelectedPolys = 0 And numSelectedScenery = 0 Then - If numSelLights > 0 Then - For i = 1 To lightCount - If Lights(i).selected = 1 Then - frmInfo.txtLightProp(0).Text = Lights(i).z - frmInfo.txtLightProp(1).Text = Lights(i).range - frmInfo.picLight.BackColor = RGB(Lights(i).color.red, Lights(i).color.green, Lights(i).color.blue) - Exit For - End If - Next - frmInfo.mnuProp_Click 4 - Else - frmInfo.mnuProp_Click 5 - End If - frmInfo.lblCoords = "" - frmInfo.lblIndex = "" - frmInfo.lblSelPolys = "" - frmInfo.lblSelScenery = "" - frmInfo.noChange = False - frmWaypoints.noChange = False - Exit Sub - End If - - If numSelectedPolys > 0 Then - - frmInfo.cboPolyType.ListIndex = vertexList(selectedPolys(1)).polyType - frmInfo.txtBounciness.Enabled = False - For j = 1 To 3 - If vertexList(selectedPolys(1)).vertex(j) = 1 Then - frmInfo.txtBounciness.Text = Int((Polys(selectedPolys(1)).Perp.vertex(j).z - 1) * 100) - If frmInfo.txtBounciness.Text < 0 Then - frmInfo.txtBounciness.Text = 0 - End If - If frmInfo.cboPolyType.ListIndex = 18 Then - frmInfo.txtBounciness.Enabled = True - End If - frmInfo.txtTexture(0).Text = Int(Polys(selectedPolys(1)).vertex(j).tu * 10000 + 0.5) / 10000 - frmInfo.txtTexture(1).Text = Int(Polys(selectedPolys(1)).vertex(j).tv * 10000 + 0.5) / 10000 - frmInfo.txtVertexAlpha.Text = Int((getAlpha(Polys(selectedPolys(1)).vertex(j).Color) / 255 * 100) * 100 + 0.5) / 100 - frmInfo.lblCoords.Caption = Int(PolyCoords(selectedPolys(1)).vertex(j).X * 100 + 0.5) / 100 & ", " & Int(PolyCoords(selectedPolys(1)).vertex(j).Y * 100) / 100 - Exit For - End If - Next - - End If - - If numSelectedScenery > 0 Then - - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - scenNum = i - frmInfo.txtScenProp(0).Text = Int(Scenery(i).Scaling.X * 100 * 100 + 0.5) / 100 - frmInfo.txtScenProp(1).Text = Int(Scenery(i).Scaling.Y * 100 * 100 + 0.5) / 100 - frmInfo.txtScenProp(2).Text = Int(Scenery(i).alpha / 255 * 100 * 10 + 0.5) / 10 - frmInfo.txtScenProp(3).Text = Int(Scenery(i).rotation * 180 / pi * 10 + 0.5) / 10 - frmInfo.cboLevel.ListIndex = Scenery(i).level - If numSelectedPolys = 0 Then - frmInfo.lblCoords.Caption = Int(Scenery(i).Translation.X * 100 + 0.5) / 100 & ", " & Int(Scenery(i).Translation.Y * 100) / 100 - End If - Exit For - End If - Next - - End If - - If numSelectedPolys = 1 And numSelectedScenery = 0 Then - frmInfo.lblIndex.Caption = selectedPolys(1) - ElseIf numSelectedPolys = 0 And numSelectedScenery = 1 Then - frmInfo.lblIndex.Caption = scenNum - Else - frmInfo.lblIndex.Caption = "" - End If - - If currentTool = TOOL_MOVE Then - If numSelectedPolys = 0 And numSelectedScenery = 1 Then - frmInfo.mnuProp_Click 1 - Else - frmInfo.mnuProp_Click 2 - End If - ElseIf numSelectedPolys > 0 And numSelectedScenery = 0 Then - frmInfo.mnuProp_Click 0 - ElseIf numSelectedPolys = 0 And numSelectedScenery > 0 Then - frmInfo.mnuProp_Click 1 - End If - - frmInfo.txtScale(0).Text = Int(scaleDiff.X * 1000 + 0.5) / 10 - frmInfo.txtScale(1).Text = Int(scaleDiff.Y * 1000 + 0.5) / 10 - frmInfo.txtRotate.Text = rDiff - - If numSelectedScenery = 1 And numSelectedPolys = 0 Then - frmInfo.lblSelPolys = "" - frmInfo.lblSelScenery = frmScenery.lstScenery.List(Scenery(scenNum).Style - 1) - Else - If numSelectedPolys = 0 Then - frmInfo.lblSelPolys = "" - Else - frmInfo.lblSelPolys = "Polys: " & numSelectedPolys - End If - If numSelectedScenery = 0 Then - frmInfo.lblSelScenery = "" - Else - frmInfo.lblSelScenery = "Scenery: " & numSelectedScenery - End If - End If - - If numSelWaypoints = 0 Then - frmWaypoints.ClearWaypt - End If - - frmInfo.noChange = False - frmWaypoints.noChange = False - - Exit Sub - -ErrorHandler: - - MsgBox "getInfo() error" & vbNewLine & Error$ - -End Sub - -'apply scale/rotate - -Public Sub applyPolyType(ByVal Index As Integer) - - Dim i As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - vertexList(selectedPolys(i)).polyType = Index - Next - End If - SaveUndo - Render - -End Sub - -Public Sub applyTextureCoords(ByVal tehValue As Single, Index As Integer) - - Dim i As Integer, j As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then - If Index = 0 Then - Polys(selectedPolys(i)).vertex(j).tu = tehValue - Else - Polys(selectedPolys(i)).vertex(j).tv = tehValue - End If - End If - Next - Next - End If - SaveUndo - Render - -End Sub - -Public Sub applyVertexAlpha(tehValue As Single) - - Dim i As Integer, j As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - For j = 1 To 3 - If vertexList(selectedPolys(i)).vertex(j) = 1 Then - Polys(selectedPolys(i)).vertex(j).Color = ARGB(tehValue * 255, Polys(selectedPolys(i)).vertex(j).Color) - End If - Next - Next - End If - SaveUndo - Render - -End Sub - -Public Sub applyBounciness(tehValue As Single) - - Dim i As Integer, j As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - If numSelectedPolys > 0 Then - For i = 1 To numSelectedPolys - For j = 1 To 3 - Polys(selectedPolys(i)).Perp.vertex(j).z = tehValue - Next - Next - End If - SaveUndo - -End Sub - -Public Sub applySceneryProp(ByVal tehValue As Single, Index As Integer) - - Dim i As Integer - Dim tempClr As TColor - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - For i = 1 To sceneryCount - If Scenery(i).selected = 1 Then - If Index = 0 Then 'x scale - Scenery(i).Scaling.X = tehValue - ElseIf Index = 1 Then 'y scale - Scenery(i).Scaling.Y = tehValue - ElseIf Index = 2 Then 'alpha - tempClr = getRGB(Scenery(i).Color) - Scenery(i).alpha = tehValue - Scenery(i).Color = ARGB(tehValue, RGB(tempClr.blue, tempClr.green, tempClr.red)) - ElseIf Index = 3 Then 'rotation - Scenery(i).rotation = tehValue - ElseIf Index = 4 Then 'level - Scenery(i).level = tehValue - End If - End If - Next - If Index = 0 Or Index = 1 Or Index = 3 Then - getRCenter - End If - SaveUndo - Render - -End Sub - -Public Sub applyLightProp(ByVal tehValue As Single, Index As Integer) - - Dim i As Integer - - If selectionChanged Then - SaveUndo - selectionChanged = False - End If - - For i = 1 To lightCount - If Lights(i).selected = 1 Then - If Index = 0 Then 'z-coord - Lights(i).z = tehValue - ElseIf Index = 1 Then - Lights(i).range = tehValue - End If - End If - Next - SaveUndo - applyLights - Render - -End Sub - -Private Sub picMenu_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picMenu(Index), X, Y, BUTTON_MENU, 0, BUTTON_DOWN - PopupMenu mnuMenu(Index), , Index * MENU_WIDTH, 41 - mouseEvent2 picMenu(Index), X, Y, BUTTON_MENU, 0, BUTTON_UP - -End Sub - -Private Sub picMenu_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picMenu(Index), X, Y, BUTTON_MENU, 0, BUTTON_MOVE - -End Sub - -Private Sub picHelp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHelp, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHelp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHelp, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHelp_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - RunHelp - - mouseEvent2 picHelp, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Public Sub SetColors() - - On Error Resume Next - - Dim c As Control - - frmSoldatMapEditor.picMenuBar.BackColor = bgClr - frmSoldatMapEditor.picStatus.BackColor = bgClr - txtZoom.BackColor = bgClr - txtZoom.ForeColor = lblTextClr - picProgress.BackColor = bgClr - lblFileName.BackColor = lblBackClr - lblFileName.ForeColor = lblTextClr - lblZoom.BackColor = lblBackClr - lblZoom.ForeColor = lblTextClr - lblCurrentTool.BackColor = lblBackClr - lblCurrentTool.ForeColor = lblTextClr - - For Each c In Me.Controls - If c.Tag = "font1" Then - c.Font.Name = font1 - ElseIf c.Tag = "font2" Then - c.Font.Name = font2 - End If - Next - -End Sub - -Private Sub picMaximize_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picMaximize, X, Y, BUTTON_SMALL, (Me.WindowState = vbNormal), BUTTON_DOWN - -End Sub - -Private Sub picMaximize_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picMaximize, X, Y, BUTTON_SMALL, (Me.WindowState = vbNormal), BUTTON_MOVE - -End Sub - -Private Sub picMaximize_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - If Me.WindowState = 2 Then - Me.WindowState = 0 - Else - Me.WindowState = 2 - End If - - mouseEvent2 picMaximize, X, Y, BUTTON_SMALL, (Me.WindowState = vbNormal), BUTTON_UP - - resetDevice - -End Sub - -Private Sub picMinimize_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picMinimize, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picMinimize_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picMinimize, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Public Sub picMinimize_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picMinimize, X, Y, BUTTON_SMALL, 0, BUTTON_UP - If mnuDisplay.Checked Then frmDisplay.Hide - If mnuWaypoints.Checked Then frmWaypoints.Hide - If mnuTools.Checked Then frmTools.Hide - If mnuPalette.Checked Then frmPalette.Hide - If mnuScenery.Checked Then frmScenery.Hide - If mnuInfo.Checked Then frmInfo.Hide - If mnuTexture.Checked Then frmTexture.Hide - Me.Hide - frmTaskBar.WindowState = vbMinimized - -End Sub - -Private Sub picExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picExit, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picExit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picExit, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picExit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picExit, X, Y, BUTTON_SMALL, 0, BUTTON_UP - Terminate - -End Sub - -Private Sub picStatus_Click() - - If Me.WindowState = vbMaximized Then - Dim hwnd1 As Long - hwnd1 = FindWindow("Shell_traywnd", "") - Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW) - - End If - -End Sub - -Private Sub picTitle_DblClick() - - If Me.WindowState = 2 Then - Me.WindowState = 0 - mouseEvent2 picMaximize, 0, 0, BUTTON_SMALL, (Me.WindowState = vbNormal), BUTTON_UP - Else - Me.WindowState = 2 - mouseEvent2 picMaximize, 0, 0, BUTTON_SMALL, (Me.WindowState = vbNormal), BUTTON_UP - End If - resetDevice - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - If Me.WindowState < 2 Then - If Len(frmDisplay.Tag) <> 0 Then - - frmDisplay.Hide - - End If - If Len(frmInfo.Tag) <> 0 Then - - frmInfo.Hide - - End If - If Len(frmPalette.Tag) <> 0 Then - - frmPalette.Hide - - End If - If Len(frmScenery.Tag) <> 0 Then - - frmScenery.Hide - - End If - If Len(frmTexture.Tag) <> 0 Then - - frmTexture.Hide - - End If - If Len(frmTools.Tag) <> 0 Then - - frmTools.Hide - - End If - If Len(frmWaypoints.Tag) <> 0 Then - - frmWaypoints.Hide - - End If - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - - If Len(frmDisplay.Tag) <> 0 Then - - frmDisplay.Move (frmDisplay.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmDisplay.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) - frmDisplay.Show - - End If - If Len(frmInfo.Tag) <> 0 Then - - frmInfo.Move (frmInfo.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmInfo.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) - frmInfo.Show - - End If - If Len(frmPalette.Tag) <> 0 Then - - frmPalette.Move (frmPalette.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmPalette.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) - frmPalette.Show - - End If - If Len(frmScenery.Tag) <> 0 Then - - frmScenery.Move (frmScenery.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmScenery.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) - frmScenery.Show - - End If - If Len(frmTexture.Tag) <> 0 Then - - frmTexture.Move (frmTexture.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmTexture.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) - frmTexture.Show - - End If - If Len(frmTools.Tag) <> 0 Then - - frmTools.Move (frmTools.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmTools.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) - frmTools.Show - - End If - If Len(frmWaypoints.Tag) <> 0 Then - - frmWaypoints.Move (frmWaypoints.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmWaypoints.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) - frmWaypoints.Show - - End If - - formLeft = Me.left / Screen.TwipsPerPixelX - formTop = Me.Top / Screen.TwipsPerPixelY - - End If - -End Sub - -Private Sub AutoTexture() - - If (numSelectedPolys <= 0) Then - Exit Sub - End If - - Dim X As Single, Y As Single, z As Single - Dim vertIndex As Integer - Dim i As Integer - - For i = 1 To 3 - If vertexList(selectedPolys(1)).vertex(i) > 0 Then - vertIndex = i - End If - Next - - X = PolyCoords(selectedPolys(1)).vertex(vertIndex).X - Y = PolyCoords(selectedPolys(1)).vertex(vertIndex).Y - z = Polys(selectedPolys(1)).vertex(vertIndex).z - - numSelectedPolys = 0 - ReDim selectedPolys(0) - - SetTextureCoords X, Y, z, 0, 0 - - Render - -End Sub - -Private Sub SetTextureCoords(X As Single, Y As Single, z As Single, tu As Single, tv As Single) - - Dim i As Integer - Dim j As Integer - Dim k As Integer - - For i = 0 To polyCount - - For j = 1 To 3 - 'if vertex is at these coords and not marked - If Int(PolyCoords(i).vertex(j).X) = Int(X) _ - And Int(PolyCoords(i).vertex(j).Y) = Int(Y) _ - And Int(Polys(i).vertex(j).z) = Int(z) _ - And vertexList(i).vertex(j) < 10 Then - 'set its tex coords to these tex coords - Polys(i).vertex(j).tu = tu - Polys(i).vertex(j).tv = tv - 'mark in vertex list - vertexList(i).vertex(j) = 10 - 'find next vertex index - k = j + 1 - If k > 3 Then k = 1 - 'check next vertex - If vertexList(i).vertex(k) < 10 Then - 'calculate new tex coords - - 'call this routine again with new coords & tex coords - SetTextureCoords PolyCoords(i).vertex(k).X, PolyCoords(i).vertex(k).Y, Polys(i).vertex(k).z, 0, 0 - End If - End If - Next - Next - - 'loop through all vertices to find vertices at this point, put into array - 'set their coords - 'set vertex list value to mark - - 'for each vertex at this point, find adjacent verts - 'calc new coords, call this and set new coords? - 'send new coords to this routine? - 'call this routine on them - -End Sub +VERSION 5.00 +Object = "{DDA53BD0-2CD0-11D4-8ED4-00E07D815373}#1.0#0"; "MBMouse.ocx" +Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" +Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx" +Begin VB.Form frmSoldatMapEditor + BackColor = &H00000000& + BorderStyle = 1 'Fixed Single + ClientHeight = 9000 + ClientLeft = 3600 + ClientTop = 3180 + ClientWidth = 12000 + ControlBox = 0 'False + DrawMode = 6 'Mask Pen Not + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Icon = "frmSoldatMapEditor.frx":0000 + KeyPreview = -1 'True + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + MousePointer = 99 'Custom + OLEDropMode = 1 'Manual + ScaleHeight = 600 + ScaleMode = 3 'Pixel + ScaleWidth = 800 + ShowInTaskbar = 0 'False + Begin VB.PictureBox picButtonGfx + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + Enabled = 0 'False + ForeColor = &H80000008& + Height = 2895 + Left = 4080 + ScaleHeight = 193 + ScaleMode = 3 'Pixel + ScaleWidth = 241 + TabIndex = 13 + TabStop = 0 'False + Top = 1200 + Width = 3615 + Visible = 0 'False + End + Begin MSComctlLib.ImageList ImageList + Left = 4080 + Top = 4200 + _ExtentX = 1005 + _ExtentY = 1005 + BackColor = -2147483643 + ImageWidth = 32 + ImageHeight = 32 + MaskColor = 16777215 + _Version = 393216 + End + Begin VB.PictureBox picStatus + Align = 2 'Align Bottom + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H00FFFFFF& + Height = 270 + Left = 0 + ScaleHeight = 18 + ScaleMode = 3 'Pixel + ScaleWidth = 800 + TabIndex = 10 + TabStop = 0 'False + Top = 8730 + Width = 12000 + Begin VB.TextBox txtZoom + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 240 + Left = 3000 + TabIndex = 14 + TabStop = 0 'False + Tag = "font1" + Top = 45 + Width = 735 + End + Begin VB.Label lblMousePosition + BackStyle = 0 'Transparent + Caption = "Position:" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 8160 + TabIndex = 20 + Tag = "font2" + Top = 45 + Width = 3735 + End + Begin VB.Label lblFileName + BackColor = &H004A3C31& + BackStyle = 0 'Transparent + Caption = "Untitled.pms" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 120 + TabIndex = 16 + Tag = "font2" + Top = 45 + Width = 2055 + End + Begin VB.Label lblZoom + BackStyle = 0 'Transparent + Caption = "Zoom:" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 2400 + TabIndex = 12 + Tag = "font2" + Top = 45 + Width = 615 + End + Begin VB.Label lblCurrentTool + BackStyle = 0 'Transparent + Caption = "Current Tool:" + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 4080 + TabIndex = 11 + Tag = "font2" + Top = 45 + Width = 3855 + End + End + Begin VB.PictureBox picMenuBar + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 0 + MousePointer = 1 'Arrow + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 800 + TabIndex = 2 + TabStop = 0 'False + Top = 375 + Width = 12000 + Begin VB.PictureBox picMenu + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + FillColor = &H00FFFFFF& + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 4 + Left = 3840 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 19 + TabStop = 0 'False + Top = 0 + Width = 960 + End + Begin VB.PictureBox picProgress + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + FillColor = &H007B614A& + ForeColor = &H80000008& + Height = 150 + Left = 9960 + ScaleHeight = 11 + ScaleMode = 0 'User + ScaleWidth = 128 + TabIndex = 15 + TabStop = 0 'False + Top = 30 + Width = 1920 + End + Begin VB.PictureBox picMenu + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + FillColor = &H00FFFFFF& + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 1920 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 9 + TabStop = 0 'False + Top = 0 + Width = 960 + End + Begin VB.PictureBox picMenu + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + FillColor = &H00FFFFFF& + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 960 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 5 + TabStop = 0 'False + Top = 0 + Width = 960 + End + Begin VB.PictureBox picMenu + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + FillColor = &H00FFFFFF& + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 3 + Left = 2880 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 4 + TabStop = 0 'False + Top = 0 + Width = 960 + End + Begin VB.PictureBox picMenu + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + FillColor = &H00FFFFFF& + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 3 + TabStop = 0 'False + Top = 0 + Width = 960 + End + End + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H00FFFFFF& + Height = 375 + Left = 0 + MousePointer = 1 'Arrow + ScaleHeight = 25 + ScaleMode = 3 'Pixel + ScaleWidth = 800 + TabIndex = 0 + Top = 0 + Width = 12000 + Begin VB.PictureBox picHelp + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + FillColor = &H80000008& + ForeColor = &H80000008& + Height = 240 + Left = 10800 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 17 + TabStop = 0 'False + Tag = "9" + ToolTipText = "Help" + Top = 0 + Width = 240 + End + Begin VB.PictureBox picMinimize + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 11280 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 8 + TabStop = 0 'False + Tag = "0" + ToolTipText = "Minimize" + Top = 0 + Width = 240 + End + Begin VB.PictureBox picMaximize + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 11520 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 7 + TabStop = 0 'False + Tag = "1" + ToolTipText = "Restore Down/Maximize" + Top = 0 + Width = 240 + End + Begin VB.PictureBox picExit + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 11760 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 6 + TabStop = 0 'False + Tag = "3" + ToolTipText = "Close" + Top = 0 + Width = 240 + End + End + Begin MSComDlg.CommonDialog commonDialog + Left = 3120 + Top = 600 + _ExtentX = 847 + _ExtentY = 847 + _Version = 393216 + CancelError = -1 'True + End + Begin VB.PictureBox picGfx + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + Enabled = 0 'False + ForeColor = &H80000008& + Height = 6735 + Left = 2520 + ScaleHeight = 449 + ScaleMode = 3 'Pixel + ScaleWidth = 97 + TabIndex = 1 + TabStop = 0 'False + Top = 1200 + Width = 1455 + Visible = 0 'False + End + Begin MSComctlLib.TreeView tvwScenery + Height = 8085 + Left = 0 + TabIndex = 18 + Tag = "font1" + Top = 600 + Width = 5730 + Visible = 0 'False + _ExtentX = 10107 + _ExtentY = 14261 + _Version = 393217 + HideSelection = 0 'False + Indentation = 423 + LabelEdit = 1 + Style = 7 + FullRowSelect = -1 'True + Appearance = 0 + MousePointer = 1 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Arial" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + OLEDragMode = 1 + End + Begin MBMouseHelper.MouseHelper MouseHelper + Left = 2520 + Top = 600 + _ExtentX = 900 + _ExtentY = 900 + End + Begin VB.Menu mnuMenu + Caption = "&File" + Index = 0 + Visible = 0 'False + Begin VB.Menu mnuNew + Caption = "&New" + Shortcut = ^N + End + Begin VB.Menu mnuOpen + Caption = "&Open..." + Shortcut = ^O + End + Begin VB.Menu mnuOpenCompiled + Caption = "O&pen Compiled..." + End + Begin VB.Menu mnuRecentFiles + Caption = "Open &Recent" + Begin VB.Menu mnuRecent + Caption = "" + Index = 0 + End + Begin VB.Menu mnuRecent + Caption = "" + Index = 1 + End + Begin VB.Menu mnuRecent + Caption = "" + Index = 2 + End + Begin VB.Menu mnuRecent + Caption = "" + Index = 3 + End + Begin VB.Menu mnuRecent + Caption = "" + Index = 4 + End + Begin VB.Menu mnuRecent + Caption = "" + Index = 5 + End + Begin VB.Menu mnuRecent + Caption = "" + Index = 6 + End + Begin VB.Menu mnuRecent + Caption = "" + Index = 7 + End + Begin VB.Menu mnuRecent + Caption = "" + Index = 8 + End + Begin VB.Menu mnuRecent + Caption = "" + Index = 9 + End + End + Begin VB.Menu mnuSep3 + Caption = "-" + End + Begin VB.Menu mnuSave + Caption = "&Save..." + Shortcut = ^S + End + Begin VB.Menu mnuSaveAs + Caption = "Save &As..." + End + Begin VB.Menu mnuSep15 + Caption = "-" + End + Begin VB.Menu mnuCompile + Caption = "&Compile to pms" + End + Begin VB.Menu mnuCompileAs + Caption = "Compile to &pms As..." + Shortcut = {F9} + End + Begin VB.Menu mnuSep10 + Caption = "-" + End + Begin VB.Menu mnuExport + Caption = "&Export..." + End + Begin VB.Menu mnuImport + Caption = "&Import..." + End + Begin VB.Menu mnuSep18 + Caption = "-" + End + Begin VB.Menu mnuRunSoldat + Caption = "&Run Soldat" + Shortcut = {F8} + End + Begin VB.Menu mnuSep1 + Caption = "-" + End + Begin VB.Menu mnuExit + Caption = "E&xit" + End + End + Begin VB.Menu mnuMenu + Caption = "Edit" + Index = 1 + Visible = 0 'False + Begin VB.Menu mnuUndo + Caption = "Undo" + Shortcut = ^Z + End + Begin VB.Menu mnuRedo + Caption = "Redo" + Shortcut = ^Y + End + Begin VB.Menu mnuSep8 + Caption = "-" + End + Begin VB.Menu mnuDuplicate + Caption = "Duplicate" + End + Begin VB.Menu mnuCopy + Caption = "Copy" + Shortcut = ^C + End + Begin VB.Menu mnuPaste + Caption = "Paste" + Shortcut = ^V + End + Begin VB.Menu mnuClear + Caption = "Clear" + Shortcut = {DEL} + End + Begin VB.Menu mnuSep32 + Caption = "-" + End + Begin VB.Menu mnuSelectAll + Caption = "Select All" + Shortcut = ^A + End + Begin VB.Menu mnuInvertSel + Caption = "Invert Selection" + Shortcut = ^I + End + Begin VB.Menu mnuDeselect + Caption = "Deselect" + Shortcut = ^D + End + Begin VB.Menu mnuSelColor + Caption = "Select by Color" + Shortcut = ^B + End + Begin VB.Menu mnuSep5 + Caption = "-" + End + Begin VB.Menu mnuArrange + Caption = "Arrange" + Begin VB.Menu mnuBringToFront + Caption = "Bring to Front" + End + Begin VB.Menu mnuBringForward + Caption = "Bring Forward" + End + Begin VB.Menu mnuSendBackward + Caption = "Send Backward" + End + Begin VB.Menu mnuSendToBack + Caption = "Send to Back" + End + End + Begin VB.Menu mnuSep12 + Caption = "-" + End + Begin VB.Menu mnuSplit + Caption = "Split at Vertex" + Shortcut = ^L + End + Begin VB.Menu mnuJoinVertices + Caption = "Join Vertices" + Shortcut = ^J + End + Begin VB.Menu mnuSnapSelected + Caption = "Snap Selected Vertices" + End + Begin VB.Menu mnuCreate + Caption = "Create with Selected" + Shortcut = ^E + End + Begin VB.Menu mnuTransform + Caption = "Transform" + Begin VB.Menu mnuRotate + Caption = "Rotate 180°" + Index = 0 + End + Begin VB.Menu mnuRotate + Caption = "Rotate 90° CW" + Index = 1 + End + Begin VB.Menu mnuRotate + Caption = "Rotate 90° CCW" + Index = 2 + End + Begin VB.Menu mnuSep6 + Caption = "-" + End + Begin VB.Menu mnuFlip + Caption = "Flip Horizontal" + Index = 0 + End + Begin VB.Menu mnuFlip + Caption = "Flip Vertical" + Index = 1 + End + End + Begin VB.Menu mnuSep20 + Caption = "-" + End + Begin VB.Menu mnuSever + Caption = "Sever Connections" + End + Begin VB.Menu mnuSep16 + Caption = "-" + End + Begin VB.Menu mnuClrSketch + Caption = "Clear sketch" + End + Begin VB.Menu mnuSep30 + Caption = "-" + End + Begin VB.Menu mnuMap + Caption = "Map Settings..." + Shortcut = ^M + End + Begin VB.Menu mnuSep21 + Caption = "-" + End + Begin VB.Menu mnuPreferences + Caption = "Preferences..." + Shortcut = ^P + End + End + Begin VB.Menu mnuMenu + Caption = "Texture" + Index = 2 + Visible = 0 'False + Begin VB.Menu mnuFixTexture + Caption = "Fix Texture" + Shortcut = ^F + End + Begin VB.Menu mnuUntexture + Caption = "Untexture" + Shortcut = ^U + End + Begin VB.Menu mnuTransformTexture + Caption = "Transform Texture" + Begin VB.Menu mnuRotateTexture + Caption = "Rotate 180°" + Index = 0 + End + Begin VB.Menu mnuRotateTexture + Caption = "Rotate 90° CW" + Index = 1 + End + Begin VB.Menu mnuRotateTexture + Caption = "Rotate 90° CCW" + Index = 2 + End + Begin VB.Menu mnuSep31 + Caption = "-" + End + Begin VB.Menu mnuFlipTexture + Caption = "Flip Horizontal" + Index = 0 + End + Begin VB.Menu mnuFlipTexture + Caption = "Flip Vertical" + Index = 1 + End + End + Begin VB.Menu mnuSep9 + Caption = "-" + End + Begin VB.Menu mnuAverage + Caption = "Average Vertex Colors" + Shortcut = ^G + End + Begin VB.Menu mnuApplyLight + Caption = "Apply Light to Vertices" + End + Begin VB.Menu mnuSep17 + Caption = "-" + End + Begin VB.Menu mnuFixedTexture + Caption = "Fixed Texture" + End + Begin VB.Menu mnuCustomX + Caption = "User Defined X" + End + Begin VB.Menu mnuCustomY + Caption = "User Defined Y" + End + End + Begin VB.Menu mnuMenu + Caption = "View" + Index = 3 + Visible = 0 'False + Begin VB.Menu mnuZoomIn + Caption = "Zoom In" + End + Begin VB.Menu mnuZoomOut + Caption = "Zoom Out" + End + Begin VB.Menu mnuFitOnScreen + Caption = "Fit on Screen" + End + Begin VB.Menu mnuActualPixels + Caption = "Actual Size" + End + Begin VB.Menu mnuResetView + Caption = "Reset View" + End + Begin VB.Menu mnuSep11 + Caption = "-" + End + Begin VB.Menu mnuGrid + Caption = "Show Grid" + End + Begin VB.Menu mnuSnapToGrid + Caption = "Snap to Grid" + Checked = -1 'True + End + Begin VB.Menu mnuSnapToVerts + Caption = "Snap to Vertices" + Checked = -1 'True + End + Begin VB.Menu mnuSep13 + Caption = "-" + End + Begin VB.Menu mnuBlendWireframe + Caption = "Blend Wireframe" + End + Begin VB.Menu mnuBlendPolys + Caption = "Blend Polys" + End + Begin VB.Menu mnuShowSceneryLayers + Caption = "Show Scenery Layers" + Begin VB.Menu mnuShowSceneryLayer + Caption = "Back" + Checked = -1 'True + Index = 0 + End + Begin VB.Menu mnuShowSceneryLayer + Caption = "Middle" + Checked = -1 'True + Index = 1 + End + Begin VB.Menu mnuShowSceneryLayer + Caption = "Front" + Checked = -1 'True + Index = 2 + End + End + Begin VB.Menu mnuSep14 + Caption = "-" + End + Begin VB.Menu mnuRefreshBG + Caption = "Refresh" + Shortcut = {F5} + End + End + Begin VB.Menu mnuMenu + Caption = "Window" + Index = 4 + Visible = 0 'False + Begin VB.Menu mnuWorkspace + Caption = "Workspace" + Begin VB.Menu mnuLoadSpace + Caption = "Load Workspace..." + End + Begin VB.Menu mnuSaveSpace + Caption = "Save Workspace..." + End + Begin VB.Menu mnuResetWindows + Caption = "Reset Window Locations" + End + End + Begin VB.Menu mnuShowAll + Caption = "Show All" + End + Begin VB.Menu mnuHideAll + Caption = "Hide All" + End + Begin VB.Menu mnuSep2 + Caption = "-" + End + Begin VB.Menu mnuTools + Caption = "Tools" + End + Begin VB.Menu mnuDisplay + Caption = "Display" + End + Begin VB.Menu mnuPalette + Caption = "Palette" + End + Begin VB.Menu mnuWaypoints + Caption = "Waypoints" + End + Begin VB.Menu mnuScenery + Caption = "Scenery" + End + Begin VB.Menu mnuInfo + Caption = "Properties" + End + Begin VB.Menu mnuTexture + Caption = "Texture" + End + End + Begin VB.Menu mnuObjects + Caption = "Objects" + Visible = 0 'False + Begin VB.Menu mnuSpawn + Caption = "Player Spawn" + Index = 0 + End + Begin VB.Menu mnuSpawn + Caption = "Alpha Team" + Index = 1 + End + Begin VB.Menu mnuSpawn + Caption = "Bravo Team" + Index = 2 + End + Begin VB.Menu mnuSpawn + Caption = "Charlie Team" + Index = 3 + End + Begin VB.Menu mnuSpawn + Caption = "Delta Team" + Index = 4 + End + Begin VB.Menu mnuSpawn + Caption = "Alpha Flag" + Index = 5 + End + Begin VB.Menu mnuSpawn + Caption = "Bravo Flag" + Index = 6 + End + Begin VB.Menu mnuSpawn + Caption = "Grenade Kit" + Index = 7 + End + Begin VB.Menu mnuSpawn + Caption = "Medikit" + Index = 8 + End + Begin VB.Menu mnuSpawn + Caption = "Cluster Grenades" + Index = 9 + End + Begin VB.Menu mnuSpawn + Caption = "Vest" + Index = 10 + End + Begin VB.Menu mnuSpawn + Caption = "Flame" + Index = 11 + End + Begin VB.Menu mnuSpawn + Caption = "Berserker" + Index = 12 + End + Begin VB.Menu mnuSpawn + Caption = "Predator" + Index = 13 + End + Begin VB.Menu mnuSpawn + Caption = "Point Match Flag" + Index = 14 + End + Begin VB.Menu mnuSpawn + Caption = "Rambo Bow" + Index = 15 + End + Begin VB.Menu mnuSpawn + Caption = "Stat Gun" + Index = 16 + End + Begin VB.Menu mnuSepObj + Caption = "-" + End + Begin VB.Menu mnuCollider + Caption = "Collider" + End + Begin VB.Menu mnuSepObj2 + Caption = "-" + End + Begin VB.Menu mnuGostek + Caption = "Gostek" + End + End + Begin VB.Menu mnuPolyTypes + Caption = "Polygon Types" + Visible = 0 'False + Begin VB.Menu mnuPolyType + Caption = "Normal" + Checked = -1 'True + Index = 0 + End + Begin VB.Menu mnuPolyType + Caption = "Only Bullets Collide" + Index = 1 + End + Begin VB.Menu mnuPolyType + Caption = "Only Player Collides" + Index = 2 + End + Begin VB.Menu mnuPolyType + Caption = "Doesn't Collide" + Index = 3 + End + Begin VB.Menu mnuPolyType + Caption = "Ice" + Index = 4 + End + Begin VB.Menu mnuPolyType + Caption = "Deadly" + Index = 5 + End + Begin VB.Menu mnuPolyType + Caption = "Bloody Deadly" + Index = 6 + End + Begin VB.Menu mnuPolyType + Caption = "Hurts" + Index = 7 + End + Begin VB.Menu mnuPolyType + Caption = "Regenerates" + Index = 8 + End + Begin VB.Menu mnuPolyType + Caption = "Lava" + Index = 9 + End + Begin VB.Menu mnuPolyType + Caption = "Red Bullets Collides" + Index = 10 + End + Begin VB.Menu mnuPolyType + Caption = "Red Players Collide" + Index = 11 + End + Begin VB.Menu mnuPolyType + Caption = "Blue Bullets Collides" + Index = 12 + End + Begin VB.Menu mnuPolyType + Caption = "Blue Players Collide" + Index = 13 + End + Begin VB.Menu mnuPolyType + Caption = "Yellow Bullets Collides" + Index = 14 + End + Begin VB.Menu mnuPolyType + Caption = "Yellow Players Collide" + Index = 15 + End + Begin VB.Menu mnuPolyType + Caption = "Green Bullets Collides" + Index = 16 + End + Begin VB.Menu mnuPolyType + Caption = "Green Players Collide" + Index = 17 + End + Begin VB.Menu mnuPolyType + Caption = "Bouncy" + Index = 18 + End + Begin VB.Menu mnuPolyType + Caption = "Explosive" + Index = 19 + End + Begin VB.Menu mnuPolyType + Caption = "Hurts Flaggers" + Index = 20 + End + Begin VB.Menu mnuPolyType + Caption = "Flagger Collides" + Index = 21 + End + Begin VB.Menu mnuPolyType + Caption = "Non-Flagger Collides" + Index = 22 + End + Begin VB.Menu mnuPolyType + Caption = "Flag Collides" + Index = 23 + End + Begin VB.Menu mnuPolyType + Caption = "Background" + Index = 24 + End + Begin VB.Menu mnuPolyType + Caption = "Background Transition" + Index = 25 + End + Begin VB.Menu mnuSep19 + Caption = "-" + End + Begin VB.Menu mnuQuad + Caption = "Textured Quad" + End + End + Begin VB.Menu mnuMove + Caption = "Move" + Visible = 0 'False + Begin VB.Menu mnuSetRCenter + Caption = "Set Reference Point" + End + Begin VB.Menu mnuCenterRCenter + Caption = "Center Reference Point" + End + Begin VB.Menu mnuFixedRCenter + Caption = "Fixed Reference Point" + Checked = -1 'True + End + End + Begin VB.Menu mnuWaypoint + Caption = "Waypoint" + Visible = 0 'False + Begin VB.Menu mnuWayType + Caption = "Left" + Index = 0 + End + Begin VB.Menu mnuWayType + Caption = "Right" + Index = 1 + End + Begin VB.Menu mnuWayType + Caption = "Up" + Index = 2 + End + Begin VB.Menu mnuWayType + Caption = "Down" + Index = 3 + End + Begin VB.Menu mnuWayType + Caption = "Fly" + Index = 4 + End + End + Begin VB.Menu mnuScen + Caption = "Scenery" + Visible = 0 'False + Begin VB.Menu mnuScenTrans + Caption = "Rotate" + Index = 0 + End + Begin VB.Menu mnuScenTrans + Caption = "Scale" + Index = 1 + End + Begin VB.Menu mnuScenSep + Caption = "-" + End + Begin VB.Menu mnuScenLevel + Caption = "Back" + Checked = -1 'True + Index = 0 + End + Begin VB.Menu mnuScenLevel + Caption = "Middle" + Index = 1 + End + Begin VB.Menu mnuScenLevel + Caption = "Front" + Index = 2 + End + End + Begin VB.Menu mnuScenTree + Caption = "Scenery Tree" + Visible = 0 'False + Begin VB.Menu mnuScenList + Caption = "" + End + Begin VB.Menu mnuScenRemove + Caption = "Remove from List" + End + End + Begin VB.Menu mnuVertexSelect + Caption = "VertexSelect" + Visible = 0 'False + Begin VB.Menu mnuVSelDuplicate + Caption = "Duplicate" + End + Begin VB.Menu mnuVSelCopy + Caption = "Copy" + End + Begin VB.Menu mnuVSelPaste + Caption = "Paste" + End + Begin VB.Menu mnuVSelClear + Caption = "Clear" + End + Begin VB.Menu mnuVSel0 + Caption = "-" + End + Begin VB.Menu mnuVSelArrange + Caption = "Arrange" + Begin VB.Menu mnuVSelBringToFront + Caption = "Bring To Front" + End + Begin VB.Menu mnuVSelBringForward + Caption = "Bring Forward" + End + Begin VB.Menu mnuVSelSendBackward + Caption = "Send Backward" + End + Begin VB.Menu mnuVSelSendToBack + Caption = "Send To Back" + End + End + Begin VB.Menu mnuVSelTransform + Caption = "Transform" + Begin VB.Menu mnuVSelRotate + Caption = "Rotate 180°" + Index = 0 + End + Begin VB.Menu mnuVSelRotate + Caption = "Rotate 90° CW" + Index = 1 + End + Begin VB.Menu mnuVSelRotate + Caption = "Rotate 90° CCW" + Index = 2 + End + Begin VB.Menu mnuVSelSep1 + Caption = "-" + End + Begin VB.Menu mnuVSelFlip + Caption = "Flip Horizontal" + Index = 0 + End + Begin VB.Menu mnuVSelFlip + Caption = "Flip Vertical" + Index = 1 + End + End + End +End +Attribute VB_Name = "frmSoldatMapEditor" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Dim DX As DirectX8 +Dim D3D As Direct3D8 +Dim D3DDevice As Direct3DDevice8 +Dim DI As DirectInput8 +Dim DIDevice As DirectInputDevice8 +Dim DIState As DIKEYBOARDSTATE + +Const BufferSize As Long = 10 + +Dim hEvent As Long +Implements DirectXEvent8 + +Dim D3DX As D3DX8 +Dim mapTexture As Direct3DTexture8 +Dim particleTexture As Direct3DTexture8 +Dim patternTexture As Direct3DTexture8 +Dim objectsTexture As Direct3DTexture8 +Dim lineTexture As Direct3DTexture8 +Dim pathTexture As Direct3DTexture8 +Dim rCenterTexture As Direct3DTexture8 +Dim sketchTexture As Direct3DTexture8 + +Dim renderTarget As Direct3DTexture8 +Dim renderSurface As Direct3DSurface8 +Dim backBuffer As Direct3DSurface8 + +Dim scenerySprite As D3DXSprite + +Const ColorKey As Long = &HFF00FF00 + +Const FVF As Long = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE +Const FVF2 As Long = D3DFVF_XYZ + + +'types + +Private Type TImageInfo + Width As Integer + miplevels As Integer + Height As Integer + depth As Integer +End Type + +Private Type TColor + red As Byte + green As Byte + blue As Byte +End Type + +Private Type TVertexData + vertex(1 To 3) As Byte + polyType As Byte + color(1 To 3) As TColor +End Type + +Private Type TTriangle + vertex(1 To 3) As D3DVECTOR2 +End Type + +Private Type TLightSource + selected As Byte + color As TColor + intensity As Single + range As Integer + X As Single + Y As Single + z As Single +End Type + + +'map types + +Private Type TCustomVertex + X As Single + Y As Single + z As Single + rhw As Single + Color As Long + tu As Single + tv As Single +End Type +Private Type TSketchVertex + X As Single + Y As Single + z As Single +End Type +Private Type TSketchLine + vertex(1 To 2) As TSketchVertex +End Type +Private Type TVertexHit + X As Single 'sin of angle + Y As Single 'cos of angle + z As Single '0 +End Type +Private Type TPolyHit + vertex(1 To 3) As TVertexHit +End Type +Private Type TPolygon + vertex(1 To 3) As TCustomVertex + Perp As TPolyHit +End Type +Private Type TLine + vertex(1 To 2) As TCustomVertex +End Type + +Private Type TProp + active As Boolean + Style As Integer + Width As Long + Height As Long + X As Single + Y As Single + rotation As Single + ScaleX As Single + ScaleY As Single + alpha As Long + Color As Long + level As Long +End Type + +Private Type TScenery + Style As Integer + Translation As D3DVECTOR2 + rotation As Single + Scaling As D3DVECTOR2 + alpha As Byte + Color As Long + level As Byte + selected As Byte + screenTr As D3DVECTOR2 +End Type + +Private Type TSpawnPoint + active As Long 'Boolean + X As Single + Y As Single + Team As Long +End Type + +Private Type TSaveSpawnPoint + active As Long 'Boolean + X As Long + Y As Long + Team As Long +End Type + +Private Type TCollider + active As Long 'Boolean + X As Single + Y As Single + radius As Single +End Type + +Private Type TOptions + mapName(0 To 38) As Byte 'String * 39 + textureName(0 To 24) As Byte 'String * 25 + BackgroundColor As Long + BackgroundColor2 As Long + StartJet As Long + GrenadePacks As Byte + Medikits As Byte + Weather As Byte + Steps As Byte + MapRandomID As Long 'Integer +End Type + +Private Type TMapFile_Polygon + Poly As TPolygon + polyType As Byte +End Type + +Private Type TMapFile_Scenery + sceneryName(0 To 50) As Byte + Date As Long +End Type + +Private Type TextureData + Width As Integer + Height As Integer + reScale As D3DVECTOR2 + Texture As Direct3DTexture8 +End Type + +Private Type TNewWaypoint + active As Long + id As Long + X As Long + Y As Long + left As Byte + right As Byte + up As Byte + down As Byte + m2 As Byte + pathNum As Byte + special As Byte + crap(1 To 5) As Byte + connectionsNum As Long + Connections(1 To 20) As Long +End Type + +Private Type TWaypoint + tempIndex As Integer + selected As Boolean + X As Single + Y As Single + wayType(0 To 4) As Boolean + special As Byte + pathNum As Byte + numConnections As Byte +End Type + +Private Type TConnection + point1 As Integer + point2 As Integer +End Type + + +Dim Version As Long +Dim Polys() As TPolygon +Dim PolyCoords() As TTriangle + +Dim Scenery() As TScenery +Dim SceneryTextures() As TextureData + +Dim Spawns() As TSpawnPoint +Dim Colliders() As TCollider +Dim Waypoints() As TWaypoint +Dim Connections() As TConnection + +Dim Lights() As TLightSource + +Dim Options As TOptions +Dim polyCount As Long + +Dim sceneryCount As Long, sceneryElements As Long +Dim spawnPoints As Long, colliderCount As Long +Dim waypointCount As Long, conCount As Integer +Dim lightCount As Integer + +Public mapTitle As String, textureFile As String +Dim maxX As Single, maxY As Single, minX As Single, minY As Single + +Dim bgPolys(1 To 4) As TCustomVertex +Dim bgPolyCoords(1 To 4) As D3DVECTOR2 +Dim bgColors(1 To 2) As TColor + +Const MAX_POLYS As Integer = 4000 +Const MAX_ZOOM As Single = 16 +Const MIN_ZOOM As Single = 0.03125 + +Const TOOL_MOVE As Byte = 0 +Const TOOL_CREATE As Byte = 1 +Const TOOL_VSELECT As Byte = 2 +Const TOOL_PSELECT As Byte = 3 +Const TOOL_VCOLOR As Byte = 4 +Const TOOL_PCOLOR As Byte = 5 +Const TOOL_TEXTURE As Byte = 6 +Const TOOL_SCENERY As Byte = 7 +Const TOOL_WAYPOINT As Byte = 8 +Const TOOL_OBJECTS As Byte = 9 +Const TOOL_CLRPICKER As Byte = 10 +Const TOOL_SKETCH As Byte = 11 +Const TOOL_LIGHTS As Byte = 12 +Const TOOL_DEPTHMAP As Byte = 13 + +Const TOOL_HAND As Byte = 14 +Const TOOL_VSELADD As Byte = 15 +Const TOOL_VSELSUB As Byte = 16 +Const TOOL_PSELADD As Byte = 17 +Const TOOL_PSELSUB As Byte = 18 +Const TOOL_SCALE As Byte = 19 +Const TOOL_ROTATE As Byte = 20 +Const TOOL_CONNECT As Byte = 21 +Const TOOL_QUAD As Byte = 22 +Const TOOL_PIXPICKER As Byte = 23 +Const TOOL_LITPICKER As Byte = 24 +Const TOOL_ERASER As Byte = 25 +Const TOOL_SMUDGE As Byte = 26 +Const TOOL_NULL As Byte = 255 + +Const KEY_SHIFT As Byte = 1 +Const KEY_CTRL As Byte = 2 +Const KEY_ALT As Byte = 4 + + +Dim sketch() As TSketchLine +Dim sketchLines As Integer +Dim selectedSketch(1 To 2) As Integer + +Dim circleOn As Boolean +Dim leftMouseDown As Boolean + +Dim initialized As Boolean, initialized2 As Boolean +Dim acquired As Boolean +Dim selectionChanged As Boolean + +Dim clrPolys As Boolean, clrWireframe As Boolean +Dim sslBack As Boolean, sslMid As Boolean, sslFront As Boolean +Public backClr As Long, pointClr As Long, selectionClr As Long, gridClr As Long, gridClr2 As Long +Public polyBlendSrc As Long, polyBlendDest As Long, wireBlendSrc As Long, wireBlendDest As Long +Public soldatDir As String, uncompDir As String, prefabDir As String +Public gridSpacing As Integer, gridDivisions As Integer +Public gridOp1 As Byte, gridOp2 As Byte +Dim noRedraw As Boolean + +Public sceneryVerts As Boolean, topmost As Boolean + +Public formHeight As Integer, formWidth As Integer, formLeft As Integer, formTop As Integer + +Dim polyClr As TColor +Dim opacity As Single +Dim blendMode As Integer + +Dim scrollCoords(1 To 2) As D3DVECTOR2 'coordinates for scrolling +Dim mouseCoords As D3DVECTOR2 'coordinates of mouse +Dim moveCoords(1 To 2) As D3DVECTOR2 'coordinates for moving vertices +Dim selectedCoords(1 To 2) As D3DVECTOR2 'coordinates of selected area +Dim selectedPolys() As Integer 'list of selected polys and verts +Dim vertexList() As TVertexData 'list of polys with selected verts +Dim numVerts As Integer 'number of current vertex being created +Dim numCorners As Integer 'number of corner of scenery being created + +Dim numSelectedPolys As Integer +Dim numSelectedScenery As Integer 'number of currently selected scenery +Dim numSelColliders As Integer +Dim numSelSpawns As Integer +Dim numSelWaypoints As Integer +Dim numSelLights As Integer + +Public xTexture As Integer, yTexture As Integer +Dim creatingQuad As Boolean + +Dim currentFileName As String +Dim prompt As Boolean + +Dim toolAction As Boolean +Dim spaceDown As Boolean + +Dim currentScenery As String + +Dim zoomFactor As Single +Dim pointRadius As Integer +Dim snapRadius As Integer, clrRadius As Integer +Dim ohSnap As Boolean, snapToGrid As Boolean, fixedTexture As Boolean +Dim showBG As Boolean, showPolys As Boolean, showTexture As Boolean, showWireframe As Boolean +Dim showPoints As Boolean, showScenery As Boolean, showObjects As Boolean, showGrid As Boolean +Dim showWaypoints As Boolean, showPath1 As Boolean, showPath2 As Boolean +Dim showSketch As Boolean, showLights As Boolean +Dim currentTool As Byte, currentFunction As Byte +Dim particleSize As Single +Dim colorMode As Byte +Dim eraseCircle As Boolean, eraseLines As Boolean + +Dim polyType As Byte +Dim PolyTypeClrs(0 To 25) As Long + +Public shiftDown As Boolean, ctrlDown As Boolean, altDown As Boolean + +Dim rCenter As D3DVECTOR2 +Dim selRect(3) As D3DVECTOR2 'RECT + +Dim xGridLines() As TLine +Dim yGridLines() As TLine +Dim inc As Single + +Dim scaleDiff As D3DVECTOR2 +Dim rDiff As Single + +Dim gostek As D3DVECTOR2 + +Dim imageInfo As TImageInfo +Dim textureDesc As D3DSURFACE_DESC + +Dim noneSelected As Boolean + +Dim currentUndo As Integer, numUndo As Integer, numRedo As Integer +Dim max_undo As Integer +Dim lastCompiled As String + +Dim currentWaypoint As Integer + +Dim objTexSize As D3DVECTOR2 + +Private Sub Form_Load() + + On Error GoTo ErrorHandler + + Dim i As Integer + Dim temp As String + Dim err As String + + initialized = False + + loadINI + loadWorkspace + loadColors + + err = "Error setting colors" + Me.SetColors + Me.Show + + err = "Error setting directories" + If Len(Dir$(uncompDir)) = 0 Or uncompDir = "" Then + uncompDir = appPath & "\Maps\" + End If + + If Len(Dir$(prefabDir)) = 0 Or prefabDir = "" Then + prefabDir = appPath & "\Prefabs\" + End If + + 'if given directory doesn't exist, change to default + If Len(Dir$(soldatDir & "Textures\")) = 0 Or soldatDir = "" Then + temp = GetSoldatDir + If temp <> "" Then + soldatDir = temp + temp = "" + End If + End If + + frmTools.initTool currentTool + + initGfx + + err = "Error loading cursors" + loadCursors + + err = "Error initializing values" + + 'init values + scrollCoords(2).X = -Me.ScaleWidth / 2 + scrollCoords(2).Y = -Me.ScaleHeight / 2 + pointRadius = 4 + particleSize = pointRadius * 2 + zoomFactor = 1 + scaleDiff.X = 1 + scaleDiff.Y = 1 + sslBack = True + sslMid = True + sslFront = True + + PolyTypeClrs(0) = selectionClr + + ReDim Scenery(0) + ReDim Preserve SceneryTextures(0) + ReDim Spawns(0) + ReDim Colliders(0) + + ReDim sketch(0) + + sketch(0).vertex(1).z = 1 + sketch(0).vertex(2).z = 1 + + Colliders(0).radius = clrRadius + + err = "Error initializing color picker" + + frmColor.picClr.Cls + frmColor.InitClr polyClr.red, polyClr.green, polyClr.blue + + err = "Error setting current tool icon (" & currentTool & ")" + + currentFunction = currentTool + + err = "Error initializing grid" + initGrid + + err = "Error initializing D3D" + initialized2 = False + Init + err = "Error initializing DInput" + InitDInput + + err = "Error setting up palette windows" + + 'show windows + frmTaskBar.Show + frmTools.Show 0, frmSoldatMapEditor + frmPalette.Show 0, frmSoldatMapEditor + frmDisplay.Show 0, frmSoldatMapEditor + frmWaypoints.Show 0, frmSoldatMapEditor + frmScenery.Show 0, frmSoldatMapEditor + frmInfo.Show 0, frmSoldatMapEditor + frmTexture.Show 0, frmSoldatMapEditor + + 'set window settings + frmDisplay.Visible = mnuDisplay.Checked + frmWaypoints.Visible = mnuWaypoints.Checked + frmPalette.Visible = mnuPalette.Checked + frmTools.Visible = mnuTools.Checked + frmScenery.Visible = mnuScenery.Checked + frmInfo.Visible = mnuInfo.Checked + frmTexture.Visible = mnuTexture.Checked + + frmPalette.refreshPalette clrRadius, opacity, blendMode, colorMode + frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue + frmDisplay.setLayer 0, showBG + frmDisplay.setLayer 1, showPolys + frmDisplay.setLayer 2, showTexture + frmDisplay.setLayer 3, showWireframe + frmDisplay.setLayer 4, showPoints + frmDisplay.setLayer 5, showScenery + frmDisplay.setLayer 6, showObjects + frmDisplay.setLayer 7, showWaypoints + frmDisplay.setLayer 8, showGrid + frmDisplay.setLayer 9, showLights + frmDisplay.setLayer 10, showSketch + + mnuFixedTexture.Checked = fixedTexture + mnuSnapToGrid.Checked = snapToGrid + mnuSnapToVerts.Checked = ohSnap + + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + + frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" + commonDialog.Flags = cdlOFNOverwritePrompt Or cdlOFNPathMustExist Or cdlOFNFileMustExist + + err = "Error parsing command line args" + + temp = Command$ + If right(temp, 1) = """" Then + temp = left(temp, Len(temp) - 1) + temp = right(temp, Len(temp) - 1) + End If + + newMap + If LCase$(right(temp, 4)) = ".pms" Then + If Dir$(temp) <> "" Then + LoadFile temp + ElseIf Dir$(appPath & "\Maps\" & temp) <> "" Then + LoadFile appPath & "\Maps\" & temp + ElseIf Dir$(soldatDir & "Maps\" & temp) <> "" Then + LoadFile soldatDir & "Maps\" & temp + End If + End If + + err = "Error acquiring input device" + + Me.SetFocus + DIDevice.Acquire + acquired = True + + Exit Sub + +ErrorHandler: + + MsgBox "Error loading" & vbNewLine & err & vbNewLine & Error$ + +End Sub + +Private Sub SetCursor(Index As Integer) + + On Error GoTo ErrorHandler + + Me.MouseIcon = frmSoldatMapEditor.ImageList.ListImages(Index).Picture + + Exit Sub + +ErrorHandler: + + MsgBox "Error setting cursor" & vbNewLine & Error$ + +End Sub + +Public Sub loadCursors() + + On Error GoTo ErrorHandler + + ImageList.ListImages.Clear + + 'load cursors + ImageList.ListImages.Add TOOL_MOVE + 1, "move", LoadPicture(appPath & "\" & gfxDir & "\cursors\move.cur") + ImageList.ListImages.Add TOOL_CREATE + 1, "create", LoadPicture(appPath & "\" & gfxDir & "\cursors\create.cur") + ImageList.ListImages.Add TOOL_VSELECT + 1, "vselect", LoadPicture(appPath & "\" & gfxDir & "\cursors\vselect.cur") + ImageList.ListImages.Add TOOL_PSELECT + 1, "pselect", LoadPicture(appPath & "\" & gfxDir & "\cursors\pselect.cur") + ImageList.ListImages.Add TOOL_VCOLOR + 1, "vcolor", LoadPicture(appPath & "\" & gfxDir & "\cursors\vcolor.cur") + ImageList.ListImages.Add TOOL_PCOLOR + 1, "pcolor", LoadPicture(appPath & "\" & gfxDir & "\cursors\pcolor.cur") + ImageList.ListImages.Add TOOL_TEXTURE + 1, "texture", LoadPicture(appPath & "\" & gfxDir & "\cursors\texture.cur") + ImageList.ListImages.Add TOOL_SCENERY + 1, "scenery", LoadPicture(appPath & "\" & gfxDir & "\cursors\scenery.cur") + ImageList.ListImages.Add TOOL_WAYPOINT + 1, "waypoint", LoadPicture(appPath & "\" & gfxDir & "\cursors\waypoint.cur") + ImageList.ListImages.Add TOOL_OBJECTS + 1, "objects", LoadPicture(appPath & "\" & gfxDir & "\cursors\objects.cur") + ImageList.ListImages.Add TOOL_CLRPICKER + 1, "clrpicker", LoadPicture(appPath & "\" & gfxDir & "\cursors\clrpicker.cur") + ImageList.ListImages.Add TOOL_SKETCH + 1, "sketch", LoadPicture(appPath & "\" & gfxDir & "\cursors\sketch.cur") + ImageList.ListImages.Add TOOL_LIGHTS + 1, "lights", LoadPicture(appPath & "\" & gfxDir & "\cursors\light.cur") + ImageList.ListImages.Add TOOL_DEPTHMAP + 1, "depthmap", LoadPicture(appPath & "\" & gfxDir & "\cursors\depthmap.cur") + + ImageList.ListImages.Add TOOL_HAND + 1, "hand", LoadPicture(appPath & "\" & gfxDir & "\cursors\hand.cur") + ImageList.ListImages.Add TOOL_VSELADD + 1, "vseladd", LoadPicture(appPath & "\" & gfxDir & "\cursors\vseladd.cur") + ImageList.ListImages.Add TOOL_VSELSUB + 1, "vselsub", LoadPicture(appPath & "\" & gfxDir & "\cursors\vselsub.cur") + ImageList.ListImages.Add TOOL_PSELADD + 1, "pseladd", LoadPicture(appPath & "\" & gfxDir & "\cursors\pseladd.cur") + ImageList.ListImages.Add TOOL_PSELSUB + 1, "pselsub", LoadPicture(appPath & "\" & gfxDir & "\cursors\pselsub.cur") + ImageList.ListImages.Add TOOL_SCALE + 1, "scale", LoadPicture(appPath & "\" & gfxDir & "\cursors\scale.cur") + ImageList.ListImages.Add TOOL_ROTATE + 1, "rotate", LoadPicture(appPath & "\" & gfxDir & "\cursors\rotate.cur") + ImageList.ListImages.Add TOOL_CONNECT + 1, "connect", LoadPicture(appPath & "\" & gfxDir & "\cursors\connect.cur") + ImageList.ListImages.Add TOOL_QUAD + 1, "quad", LoadPicture(appPath & "\" & gfxDir & "\cursors\quad.cur") + ImageList.ListImages.Add TOOL_PIXPICKER + 1, "pixpicker", LoadPicture(appPath & "\" & gfxDir & "\cursors\pixpicker.cur") + ImageList.ListImages.Add TOOL_LITPICKER + 1, "litpicker", LoadPicture(appPath & "\" & gfxDir & "\cursors\litpicker.cur") + ImageList.ListImages.Add TOOL_ERASER + 1, "eraser", LoadPicture(appPath & "\" & gfxDir & "\cursors\eraser.cur") + ImageList.ListImages.Add TOOL_SMUDGE + 1, "smudge", LoadPicture(appPath & "\" & gfxDir & "\cursors\smudge.cur") + + ImageList.ListImages.Item(TOOL_MOVE + 1).Tag = "Move Selection" + ImageList.ListImages.Item(TOOL_CREATE + 1).Tag = "Create Polygons" + ImageList.ListImages.Item(TOOL_VSELECT + 1).Tag = "Select Vertices" + ImageList.ListImages.Item(TOOL_PSELECT + 1).Tag = "Select Polygons" + ImageList.ListImages.Item(TOOL_VCOLOR + 1).Tag = "Color Vertices" + ImageList.ListImages.Item(TOOL_PCOLOR + 1).Tag = "Color Polygons" + ImageList.ListImages.Item(TOOL_TEXTURE + 1).Tag = "Transform Texture" + ImageList.ListImages.Item(TOOL_SCENERY + 1).Tag = "Create Scenery" + ImageList.ListImages.Item(TOOL_WAYPOINT + 1).Tag = "Create Waypoints" + ImageList.ListImages.Item(TOOL_OBJECTS + 1).Tag = "Place Spawn Points or Colliders" + ImageList.ListImages.Item(TOOL_CLRPICKER + 1).Tag = "Pick a Vertex Color" + ImageList.ListImages.Item(TOOL_SKETCH + 1).Tag = "Sketch" + ImageList.ListImages.Item(TOOL_LIGHTS + 1).Tag = "Create Lights" + ImageList.ListImages.Item(TOOL_DEPTHMAP + 1).Tag = "Edit Depth Map" + + ImageList.ListImages.Item(TOOL_HAND + 1).Tag = "Scroll Map" + ImageList.ListImages.Item(TOOL_VSELADD + 1).Tag = "Add to Selection" + ImageList.ListImages.Item(TOOL_VSELSUB + 1).Tag = "Subtract from Selection" + ImageList.ListImages.Item(TOOL_PSELADD + 1).Tag = "Add to Selection" + ImageList.ListImages.Item(TOOL_PSELSUB + 1).Tag = "Subtract from Selection" + ImageList.ListImages.Item(TOOL_SCALE + 1).Tag = "Scale Selection" + ImageList.ListImages.Item(TOOL_ROTATE + 1).Tag = "Rotate Selection" + ImageList.ListImages.Item(TOOL_CONNECT + 1).Tag = "Connect Waypoints" + ImageList.ListImages.Item(TOOL_QUAD + 1).Tag = "Create Quad" + ImageList.ListImages.Item(TOOL_PIXPICKER + 1).Tag = "Pick a pixel color" + ImageList.ListImages.Item(TOOL_LITPICKER + 1).Tag = "Pick a Lit Vertex Color" + ImageList.ListImages.Item(TOOL_ERASER + 1).Tag = "Erase Lines" + ImageList.ListImages.Item(TOOL_SMUDGE + 1).Tag = "Move Lines" + + Exit Sub + +ErrorHandler: + + MsgBox "Error loading cursors" & vbNewLine & Error$ + +End Sub + +Public Sub initGfx() + + Dim i As Integer + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_main.bmp") + + picGfx.Picture = LoadPicture(appPath & "\" & gfxDir & "\tool_gfx.bmp") + picButtonGfx.Picture = LoadPicture(appPath & "\" & gfxDir & "\button_gfx.bmp") + + 'draw control box buttons + mouseEvent2 picExit, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picMaximize, 0, 0, BUTTON_SMALL, (Me.WindowState = 0), BUTTON_UP + mouseEvent2 picMinimize, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + mouseEvent2 picHelp, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + + 'draw menu buttons + For i = 0 To 4 + mouseEvent2 picMenu(i), 0, 0, BUTTON_MENU, 0, BUTTON_UP + Next + +End Sub + +Private Sub centerView() + + Dim i As Integer + + If polyCount > 0 Then + For i = 1 To polyCount + Polys(i).vertex(1).X = (PolyCoords(i).vertex(1).X - scrollCoords(2).X) * zoomFactor + Polys(i).vertex(1).Y = (PolyCoords(i).vertex(1).Y - scrollCoords(2).Y) * zoomFactor + Polys(i).vertex(2).X = (PolyCoords(i).vertex(2).X - scrollCoords(2).X) * zoomFactor + Polys(i).vertex(2).Y = (PolyCoords(i).vertex(2).Y - scrollCoords(2).Y) * zoomFactor + Polys(i).vertex(3).X = (PolyCoords(i).vertex(3).X - scrollCoords(2).X) * zoomFactor + Polys(i).vertex(3).Y = (PolyCoords(i).vertex(3).Y - scrollCoords(2).Y) * zoomFactor + Next + End If + + For i = 1 To 4 + bgPolys(i).X = bgPolyCoords(i).X - scrollCoords(2).X * zoomFactor + bgPolys(i).Y = bgPolyCoords(i).Y - scrollCoords(2).Y * zoomFactor + Next + +End Sub + +Public Sub Init() + + On Error GoTo ErrorHandler + + initialized = False + noRedraw = False + selectionChanged = False + + Dim DispMode As D3DDISPLAYMODE + Dim D3DWindow As D3DPRESENT_PARAMETERS + Dim debugVal As String + + debugVal = "Error creating Direct3D objects" + + If Not initialized2 Then + Set D3DX = New D3DX8 + Set DX = New DirectX8 + Set D3D = DX.Direct3DCreate() + initialized2 = True + End If + + debugVal = "Error getting display mode" + + D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode + D3DWindow.Windowed = 1 + D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY + D3DWindow.BackBufferFormat = D3DFMT_A8R8G8B8 + + debugVal = "Error creating D3D device" + + Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3DWindow) 'Main screen turn on. + + debugVal = "Error setting render states" + + D3DDevice.SetVertexShader FVF + D3DDevice.SetRenderState D3DRS_LIGHTING, False + + D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE 'polys that are ccw + + D3DDevice.SetRenderState D3DRS_POINTSPRITE_ENABLE, 1 + D3DDevice.SetRenderState D3DRS_POINTSCALE_ENABLE, 1 + D3DDevice.SetRenderState D3DRS_POINTSIZE, FtoDW(particleSize) + + D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE + D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TEXTURE + D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAARG2, D3DTA_DIFFUSE + + Set renderTarget = D3DX.CreateTexture(D3DDevice, 256, 256, D3DX_DEFAULT, D3DUSAGE_RENDERTARGET, D3DFMT_A8R8G8B8, D3DPOOL_DEFAULT) + Set renderSurface = renderTarget.GetSurfaceLevel(0) + Set backBuffer = D3DDevice.GetBackBuffer(0, D3DBACKBUFFER_TYPE_MONO) + + debugVal = "Error creating pattern texture" + + Set patternTexture = D3DX.CreateTextureFromFile(D3DDevice, appPath & "\" & gfxDir & "\pattern.bmp") + + debugVal = "Error creating objects texture" + + '---- + Set objectsTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\objects.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, _ + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) + + objectsTexture.GetLevelDesc 0, textureDesc + + objTexSize.X = textureDesc.Width + objTexSize.Y = textureDesc.Height + + '---- + + debugVal = "Error creating scenery not found texture" + + Set SceneryTextures(0).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) + + SceneryTextures(0).Texture.GetLevelDesc 0, textureDesc + + SceneryTextures(0).Width = imageInfo.Width + SceneryTextures(0).Height = imageInfo.Height + + SceneryTextures(0).reScale.X = SceneryTextures(0).Width / textureDesc.Width + SceneryTextures(0).reScale.Y = SceneryTextures(0).Height / textureDesc.Height + + If SceneryTextures(0).reScale.X = 0 Or SceneryTextures(0).reScale.Y = 0 Then + SceneryTextures(0).reScale.X = 1 + SceneryTextures(0).reScale.Y = 1 + End If + + debugVal = "Error creating line texture" + + Set lineTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\lines.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) + + debugVal = "Error creating path texture" + + Set pathTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\path.png", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) + + debugVal = "Error creating rotation center texture" + + Set rCenterTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\rcenter.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) + + debugVal = "Error creating sketch texture" + + Set sketchTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\sketch.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) + + debugVal = "Error creating scenery sprite" + + Set scenerySprite = D3DX.CreateSprite(D3DDevice) + + debugVal = "Error creating particle texture" + + Set particleTexture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\vertex8x8.bmp", 8, 8, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, ByVal 0, ByVal 0) + + initialized = True + + Exit Sub + +ErrorHandler: + + If D3DX Is Nothing Then + MsgBox "Direct3D initialization failed" & vbNewLine & debugVal & vbNewLine & Error$ + Else + MsgBox "Direct3D initialization failed" & vbNewLine & D3DX.GetErrorString(err.Number) & vbNewLine & debugVal + End If + +End Sub + +Private Sub InitDInput() + + On Error GoTo ErrorHandler + + Dim tehValue As String + + Dim i As Long + Dim DevProp As DIPROPLONG + Dim DevInfo As DirectInputDeviceInstance8 + Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA + + tehValue = "Error creating DI device" + + Set DI = DX.DirectInputCreate + Set DIDevice = DI.CreateDevice("GUID_SysKeyboard") + + tehValue = "Error setting DI device" + + DIDevice.SetCommonDataFormat DIFORMAT_KEYBOARD + DIDevice.SetCooperativeLevel Me.hWnd, DISCL_NONEXCLUSIVE Or DISCL_FOREGROUND + + tehValue = "Error setting DI properties" + + DevProp.lHow = DIPH_DEVICE + DevProp.lData = BufferSize + DIDevice.SetProperty DIPROP_BUFFERSIZE, DevProp + + tehValue = "Error setting DI device notification" + + hEvent = DX.CreateEvent(Me) + DIDevice.SetEventNotification hEvent + + tehValue = "Error getting device info" + + Set DevInfo = DIDevice.GetDeviceInfo() + + tehValue = "Error acquiring device" + + Me.SetFocus + DIDevice.Acquire + acquired = True + + Exit Sub + +ErrorHandler: + + If tehValue <> "Error acquiring device" Then + MsgBox "DirectInput initialization failed" & vbNewLine & D3DX.GetErrorString(err.Number) & vbNewLine & tehValue + End If + +End Sub + +Public Sub resetDevice() + + On Error GoTo ErrorHandler + + Dim DispMode As D3DDISPLAYMODE + Dim D3DWindow As D3DPRESENT_PARAMETERS + Dim i As Integer + + D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode + + D3DWindow.Windowed = 1 + D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY + D3DWindow.BackBufferFormat = D3DFMT_A8R8G8B8 + + noRedraw = True + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + SaveUndo + mnuSelectAll_Click + deletePolys + + Set mapTexture = Nothing + Set particleTexture = Nothing + Set patternTexture = Nothing + Set sketchTexture = Nothing + Set lineTexture = Nothing + Set pathTexture = Nothing + Set rCenterTexture = Nothing + Set D3DDevice = Nothing + Init + For i = 1 To frmScenery.lstScenery.ListCount + RefreshSceneryTextures i + Next + + setMapTexture textureFile + + D3DDevice.SetVertexShader FVF + D3DDevice.SetRenderState D3DRS_LIGHTING, False + D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE 'polys that are ccwise + + D3DDevice.SetRenderState D3DRS_POINTSPRITE_ENABLE, 1 + D3DDevice.SetRenderState D3DRS_POINTSCALE_ENABLE, 1 + D3DDevice.SetRenderState D3DRS_POINTSIZE, FtoDW(particleSize) + + D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE + D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TEXTURE + D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAARG2, D3DTA_DIFFUSE + + initGrid + + initialized = True + + loadUndo False + loadUndo False + + noRedraw = False + + Render + + Exit Sub + +ErrorHandler: + + MsgBox "Error resetting device" & vbNewLine & D3DX.GetErrorString(err.Number) + +End Sub + +Public Sub RegainFocus() + + On Error Resume Next + + Me.SetFocus + DIDevice.Acquire + acquired = True + ctrlDown = False + altDown = False + shiftDown = False + SetCursor currentFunction + 1 + +End Sub + +Public Sub newMap() + + Dim i As Integer + + On Error GoTo ErrorHandler + + prompt = False + + Version = 11 + + commonDialog.FileName = "" + + numVerts = 0 + toolAction = False + + mapTitle = "New Soldat Map" + + Options.BackgroundColor = ARGB(255, RGB(224, 224, 224)) + Options.BackgroundColor2 = ARGB(255, RGB(32, 32, 32)) + + Options.textureName(0) = 0 + Options.MapRandomID = 0 + Options.GrenadePacks = 5 + Options.Medikits = 5 + Options.StartJet = 190 + Options.Steps = 0 + Options.Weather = 0 + + numSelectedPolys = 0 + ReDim selectedPolys(0) + ReDim vertexList(0) + + polyCount = 0 + ReDim Polys(0) + ReDim vertexList(0) + ReDim PolyCoords(0) + + sceneryCount = 0 + ReDim Scenery(0) + sceneryElements = 0 + ReDim Preserve SceneryTextures(0) + frmScenery.lstScenery.Clear + setCurrentScenery 0 + tvwScenery.Nodes.Remove "In Use" + tvwScenery.Nodes.Add "Master List", tvwFirst, "In Use", "In Use" + + spawnPoints = 0 + colliderCount = 0 + ReDim Spawns(0) + ReDim Colliders(0) + Colliders(0).radius = clrRadius + + waypointCount = 0 + ReDim Waypoints(0) + conCount = 0 + ReDim Connections(0) + + lightCount = 0 + ReDim Lights(0) + + sketchLines = 0 + ReDim Preserve sketch(0) + + bgColors(1) = makeColor(224, 224, 224) + bgColors(2) = makeColor(32, 32, 32) + + maxX = 0 + maxY = 0 + minX = 0 + minY = 0 + + bgPolys(1) = CreateCustomVertex(-640, -640, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 0, 0) + bgPolys(2) = CreateCustomVertex(-640, 640, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 0, 0) + bgPolys(3) = CreateCustomVertex(640, -640, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 0, 0) + bgPolys(4) = CreateCustomVertex(640, 640, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 0, 0) + + For i = 1 To 4 + bgPolyCoords(i).X = bgPolys(i).X + bgPolyCoords(i).Y = bgPolys(i).Y + Next + + scrollCoords(1).X = 0 + scrollCoords(1).Y = 0 + scrollCoords(2).X = -Me.ScaleWidth / 2 - 1 + scrollCoords(2).Y = -Me.ScaleHeight / 2 - 1 + zoomFactor = 1 + + setMapData + + txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" + + If Len(Dir(soldatDir & "Textures\" & textureFile)) <> 0 Then + setMapTexture textureFile + frmTexture.setTexture textureFile + Else + Set mapTexture = Nothing + End If + + currentFileName = "Untitled.pms" + lblFileName.Caption = "Untitled.pms" + + centerView + + numUndo = 0 + numRedo = 0 + currentUndo = 0 + SaveUndo + + Render + + Exit Sub + +ErrorHandler: + + MsgBox "error creating new file" & vbNewLine & Error$ + +End Sub + +Public Sub LoadFile(FileName As String) + + On Error GoTo ErrorHandler + + Dim errorVal As String + Dim fileOpen As Boolean + + Dim i As Integer, j As Integer, k As Integer + Dim temp As Long, tempString As String + + Dim polyIndex As Integer + Dim polysInSector As Integer + + Const SECTOR_NUM As Long = 25 + + Dim Scenery_New As TMapFile_Scenery + Dim newWaypoint As TNewWaypoint + Dim Prop As TProp + Dim spawn As TSaveSpawnPoint + + Dim toTGARes As Long + + prompt = False + + scrollCoords(1).X = 0 + scrollCoords(1).Y = 0 + scrollCoords(2).X = -Me.ScaleWidth / 2 + scrollCoords(2).Y = -Me.ScaleHeight / 2 + zoomFactor = 1 + toolAction = False + numVerts = 0 + + sceneryCount = 0 + sceneryElements = 0 + frmScenery.lstScenery.Clear + tvwScenery.Nodes.Remove "In Use" + tvwScenery.Nodes.Add "Master List", tvwFirst, "In Use", "In Use" + numSelectedPolys = 0 + ReDim selectedPolys(numSelectedPolys) + + currentFileName = "" + For i = 0 To Len(FileName) - 1 + If mid(FileName, Len(FileName) - i, 1) <> "\" Then + currentFileName = mid(FileName, Len(FileName) - i, 1) + currentFileName + Else + Exit For + End If + Next + + lblFileName.Caption = currentFileName + + Open FileName For Binary Access Read Lock Read As #1 + + fileOpen = True + errorVal = "Error loading polys" + + maxX = 0 + maxY = 0 + minX = 0 + minY = 0 + + Get #1, , Version + Get #1, , Options + Get #1, , polyCount + ReDim Polys(0 To polyCount) + ReDim PolyCoords(0 To polyCount) + ReDim vertexList(0 To polyCount) + + For i = 1 To polyCount + Get #1, , Polys(i) + Get #1, , vertexList(i).polyType + + For j = 1 To 3 + PolyCoords(i).vertex(j).X = Polys(i).vertex(j).X + PolyCoords(i).vertex(j).Y = Polys(i).vertex(j).Y + vertexList(i).color(j) = getRGB(Polys(i).vertex(j).Color) + If PolyCoords(i).vertex(j).X > maxX Then maxX = PolyCoords(i).vertex(j).X + If PolyCoords(i).vertex(j).X < minX Then minX = PolyCoords(i).vertex(j).X + If PolyCoords(i).vertex(j).Y > maxY Then maxY = PolyCoords(i).vertex(j).Y + If PolyCoords(i).vertex(j).Y < minY Then minY = PolyCoords(i).vertex(j).Y + Polys(i).Perp.vertex(j).z = Sqr(Polys(i).Perp.vertex(j).X ^ 2 + Polys(i).Perp.vertex(j).Y ^ 2) + Next + Next + + Get #1, , temp 'sectorsdivision + Get #1, , temp 'num sectors + + For i = -SECTOR_NUM To SECTOR_NUM + For j = -SECTOR_NUM To SECTOR_NUM + Get #1, , polysInSector 'number of polys in sector + For k = 1 To polysInSector 'for each poly in sector + Get #1, , polyIndex 'load and discard poly index + Next + Next + Next + + errorVal = "Error loading scenery" + + Get #1, , sceneryCount + + ReDim Scenery(sceneryCount) + + If sceneryCount > 0 Then + + Dim offset As Integer + offset = 0 + + For i = 1 To sceneryCount + Get #1, , Prop + + If Prop.X > 32766 Or Prop.X < -32766 Or Prop.Y > 32766 Or Prop.Y < -32766 Then + offset = offset + 1 + ElseIf Prop.Width < 0 Or Prop.Height < 0 Or Int(Prop.ScaleX * 1000) = 0 Or Int(Prop.ScaleY * 1000) = 0 Then + offset = offset + 1 + ElseIf Prop.ScaleX < -10000 Or Prop.ScaleX > 10000 Or Prop.ScaleY < -10000 Or Prop.ScaleY > 10000 Then + offset = offset + 1 + ElseIf Prop.Style < 1 Then + offset = offset + 1 + Else + Scenery(i - offset).Style = Prop.Style + Scenery(i - offset).Translation.X = Prop.X + Scenery(i - offset).Translation.Y = Prop.Y + Scenery(i - offset).screenTr.X = (Prop.X - scrollCoords(2).X) * zoomFactor + Scenery(i - offset).screenTr.Y = (Prop.Y - scrollCoords(2).Y) * zoomFactor + Scenery(i - offset).rotation = Prop.rotation + Scenery(i - offset).Scaling.X = Prop.ScaleX + Scenery(i - offset).Scaling.Y = Prop.ScaleY + If Prop.alpha < 1 Then + Scenery(i - offset).alpha = 255 + ElseIf Prop.alpha <= 255 Then + Scenery(i - offset).alpha = Prop.alpha + Else + Scenery(i - offset).alpha = 255 + End If + Scenery(i - offset).Color = Prop.Color + If Prop.level <= 255 And Prop.level >= 0 Then + Scenery(i - offset).level = Prop.level + Else + Scenery(i - offset).level = 0 + End If + Scenery(i - offset).Color = ARGB(Scenery(i - offset).alpha, Scenery(i - offset).Color) + End If + + Next + + sceneryCount = sceneryCount - offset + + End If + + ReDim Preserve Scenery(sceneryCount) + + errorVal = "Error loading scenery elements" + + offset = 0 + + Get #1, , sceneryElements + + ReDim Preserve SceneryTextures(sceneryElements) + + Dim scenIndex As Integer + Dim firstOccurence As Integer + + If sceneryElements > 0 And sceneryElements < 500 Then + + For i = 1 To sceneryElements + + tempString = "" + + Get #1, , Scenery_New + + For j = 1 To Scenery_New.sceneryName(0) + tempString = tempString & Chr$(Scenery_New.sceneryName(j)) + Next + + Dim loadName As String + + If tempString = "" Then + Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + frmScenery.lstScenery.AddItem tempString + tvwScenery.Nodes.Add "In Use", tvwChild, tempString, tempString + ElseIf checkLoaded(tempString) > -1 Then + + loadName = soldatDir & "Scenery-gfx\" & tempString + toTGARes = GifToBmp(loadName, appPath & "\Temp\gif.tga") + If right$(loadName, 4) = ".gif" Then + loadName = appPath & "\Temp\gif.tga" + End If + + If toTGARes = -1 Then + Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + Else + Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + End If + + frmScenery.lstScenery.AddItem tempString + tvwScenery.Nodes.Add "In Use", tvwChild, , tempString + ElseIf confirmExists(tempString) Then 'if scenery texture is in master list + + loadName = soldatDir & "Scenery-gfx\" & tempString + toTGARes = GifToBmp(loadName, appPath & "\Temp\gif.tga") + If right$(loadName, 4) = ".gif" Then + loadName = appPath & "\Temp\gif.tga" + End If + + If toTGARes = -1 Then + Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + Else + Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + End If + frmScenery.lstScenery.AddItem tempString + tvwScenery.Nodes.Add "In Use", tvwChild, tempString, tempString + Else + Set SceneryTextures(i).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + frmScenery.lstScenery.AddItem tempString + tvwScenery.Nodes.Add "In Use", tvwChild, tempString, tempString + End If + + SceneryTextures(i).Texture.GetLevelDesc 0, textureDesc + + SceneryTextures(i).Width = imageInfo.Width + SceneryTextures(i).Height = imageInfo.Height + SceneryTextures(i).reScale.X = SceneryTextures(i).Width / textureDesc.Width + SceneryTextures(i).reScale.Y = SceneryTextures(i).Height / textureDesc.Height + + If SceneryTextures(i).reScale.X = 0 Or SceneryTextures(i).reScale.Y = 0 Then + SceneryTextures(i).reScale.X = 1 + SceneryTextures(i).reScale.Y = 1 + End If + + Next + + For i = 1 To sceneryCount + If Scenery(i).Style > sceneryElements Then + Scenery(i).Style = sceneryElements + ElseIf Scenery(i).Style < 1 Then + Scenery(i).Style = 1 + End If + Next + + ElseIf sceneryElements <> 0 Then + 'if we got to this point it means that scenery were loaded but scenery elements are borked + 'or scenery are borked too + + sceneryElements = 0 + For i = 1 To sceneryCount + Scenery(i).Style = 0 + Next + GoTo ErrorHandler + + End If + + errorVal = "Error loading colliders" + + Get #1, , colliderCount + + ReDim Colliders(colliderCount) + + For i = 1 To colliderCount + Get #1, , Colliders(i) + Colliders(i).active = 0 + Next + + errorVal = "Error loading spawn points" + + Get #1, , spawnPoints + ReDim Spawns(spawnPoints) + + For i = 1 To spawnPoints + Get #1, , spawn + Spawns(i).X = spawn.X + Spawns(i).Y = spawn.Y + Spawns(i).Team = spawn.Team + If Spawns(i).Team > 31 Then Spawns(i).Team = 31 + Spawns(i).active = 0 + Next + + errorVal = "Error loading waypoints" + + Get #1, , waypointCount + ReDim Waypoints(waypointCount) + conCount = 0 + ReDim Connections(conCount) + + For i = 1 To waypointCount + Get #1, , newWaypoint + Waypoints(i).tempIndex = i + Waypoints(i).pathNum = newWaypoint.pathNum + If newWaypoint.connectionsNum >= 0 Then + Waypoints(i).numConnections = newWaypoint.connectionsNum + Else + Waypoints(i).numConnections = 0 + End If + Waypoints(i).special = newWaypoint.special + Waypoints(i).X = newWaypoint.X + Waypoints(i).Y = newWaypoint.Y + Waypoints(i).wayType(0) = CBool(newWaypoint.left) + Waypoints(i).wayType(1) = CBool(newWaypoint.right) + Waypoints(i).wayType(2) = CBool(newWaypoint.up) + Waypoints(i).wayType(3) = CBool(newWaypoint.down) + Waypoints(i).wayType(4) = CBool(newWaypoint.m2) + If newWaypoint.connectionsNum > 0 And newWaypoint.connectionsNum <= 20 Then + conCount = conCount + newWaypoint.connectionsNum + ReDim Preserve Connections(conCount) + For j = 1 To newWaypoint.connectionsNum + Connections(conCount - newWaypoint.connectionsNum + j).point1 = i + Connections(conCount - newWaypoint.connectionsNum + j).point2 = newWaypoint.Connections(j) + Next + End If + Next + + If Options.MapRandomID < 0 Then + + Get #1, , lightCount + ReDim Lights(lightCount) + + For i = 1 To lightCount + Get #1, , Lights(i) + Next + + Get #1, , sketchLines + ReDim Preserve sketch(sketchLines) + + For i = 1 To sketchLines + Get #1, , sketch(i) + Next + + Else + lightCount = 0 + ReDim Lights(lightCount) + sketchLines = 0 + ReDim Preserve sketch(sketchLines) + End If + + Close #1 + + errorVal = "Error reloading scenery" + + fileOpen = False + + errorVal = "Error setting map data" + + setCurrentScenery 0 + If sceneryElements > 0 Then + frmScenery.lstScenery.ListIndex = 0 + End If + + 'get map title and texture + mapTitle = "" + For i = 1 To Options.mapName(0) + mapTitle = mapTitle + Chr$(Options.mapName(i)) + Next + textureFile = "" + For i = 1 To Options.textureName(0) + textureFile = textureFile + Chr$(Options.textureName(i)) + Next + + mapTitle = "" + For i = 1 To Options.mapName(0) + mapTitle = mapTitle + Chr$(Options.mapName(i)) + Next + + 'get background colors + bgColors(1) = getRGB(Options.BackgroundColor) + bgColors(2) = getRGB(Options.BackgroundColor2) + + 'set background poly colors + bgPolys(1) = CreateCustomVertex(-maxX - 640, -maxX - 640, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 0, 0) + bgPolys(2) = CreateCustomVertex(-maxX, maxX, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 0, 1) + bgPolys(3) = CreateCustomVertex(maxX, -maxX, 1, 1, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red), 1, 0) + bgPolys(4) = CreateCustomVertex(maxX, maxX, 1, 1, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red), 1, 1) + + If (maxX - minX) > (maxY - minY) Then + bgPolys(1).X = minX - 640 + bgPolys(1).Y = Midpoint(maxY, minY) - ((maxX - minX) / 2) - 640 + bgPolys(2).X = minX - 640 + bgPolys(2).Y = Midpoint(maxY, minY) + ((maxX - minX) / 2) + 640 + bgPolys(3).X = maxX + 640 + bgPolys(3).Y = Midpoint(maxY, minY) - ((maxX - minX) / 2) - 640 + bgPolys(4).X = maxX + 640 + bgPolys(4).Y = Midpoint(maxY, minY) + ((maxX - minX) / 2) + 640 + Else + bgPolys(1).X = Midpoint(maxX, minX) - ((maxY - minY) / 2) - 640 + bgPolys(1).Y = minY - 640 + bgPolys(2).X = Midpoint(maxX, minX) - ((maxY - minY) / 2) - 640 + bgPolys(2).Y = maxY + 640 + bgPolys(3).X = Midpoint(maxX, minX) + ((maxY - minY) / 2) + 640 + bgPolys(3).Y = minY - 640 + bgPolys(4).X = Midpoint(maxX, minX) + ((maxY - minY) / 2) + 640 + bgPolys(4).Y = maxY + 640 + End If + + For i = 1 To 4 + bgPolyCoords(i).X = bgPolys(i).X + bgPolyCoords(i).Y = bgPolys(i).Y + Next + + If Len(Dir$(soldatDir & "textures\" & textureFile)) <> 0 Then + setMapTexture textureFile + frmTexture.setTexture textureFile + End If + + Colliders(0).radius = clrRadius + + setMapData + txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" + + centerView + + numUndo = 0 + numRedo = 0 + currentUndo = 0 + + If lightCount > 0 Then + frmDisplay.setLayer 9, showLights + applyLights + End If + + SaveUndo + + Render + + Exit Sub + +ErrorHandler: + + MsgBox "error loading map" & vbNewLine & Error$ & vbNewLine & errorVal + If fileOpen Then Close #1 + noRedraw = False + +End Sub + +Private Function checkLoaded(sceneryName As String) As Integer + + Dim i As Integer + + On Error GoTo ErrorHandler + + checkLoaded = -1 + + For i = 0 To frmScenery.lstScenery.ListCount - 1 + If frmScenery.lstScenery.List(i) = sceneryName Then checkLoaded = i + Next + + Exit Function + +ErrorHandler: + + MsgBox "error checking loaded scenery" & vbNewLine & Error$ + +End Function + +Private Function getMapDimensions() As String + + getMapDimensions = Int(maxX - minX) & "x" & Int(maxY - minY) + +End Function + +Private Function getMapArea() As Long + + Dim i As Integer + Dim area As Double + Dim a As Single, b As Single + Dim c As Single + Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single + + For i = 1 To polyCount + If vertexList(i).polyType <> 3 Then + x1 = (PolyCoords(i).vertex(3).X - PolyCoords(i).vertex(2).X) + y1 = (PolyCoords(i).vertex(3).Y - PolyCoords(i).vertex(2).Y) + x2 = (PolyCoords(i).vertex(1).X - PolyCoords(i).vertex(3).X) + y2 = (PolyCoords(i).vertex(1).Y - PolyCoords(i).vertex(3).Y) + a = Sqr(x1 ^ 2 + y1 ^ 2) + b = Sqr(x2 ^ 2 + y2 ^ 2) + c = GetAngle(x1, y1) - GetAngle(x2, y2) + area = area + (a * b * Sin(c) / 2) + End If + Next + + MsgBox Int(area / ((maxX - minX) * (maxY - minY)) * 100 + 0.5) & "%" + +End Function + +Public Sub setMapData() + + frmInfo.lblCount(0).Caption = polyCount + frmInfo.lblCount(1).Caption = sceneryCount & "/500 (" & sceneryElements & ")" + frmInfo.lblCount(2).Caption = spawnPoints & "/128" + frmInfo.lblCount(3).Caption = colliderCount & "/128" + frmInfo.lblCount(4).Caption = waypointCount & "/500" + frmInfo.lblCount(5).Caption = conCount + frmInfo.lblCount(6).Caption = getMapDimensions + +End Sub + +Public Sub setCurrentScenery(Optional styleVal As Integer = -1, Optional sceneryName As String = "") + + On Error GoTo ErrorHandler + + If styleVal > -1 Then + Scenery(0).Style = styleVal + End If + + If sceneryName <> "" Then + currentScenery = sceneryName + End If + + Scenery(0).alpha = opacity * 255 + Scenery(0).Color = ARGB(opacity * 255, RGB(polyClr.blue, polyClr.green, polyClr.red)) + Scenery(0).level = frmScenery.level + Scenery(0).Scaling.X = 1 + Scenery(0).Scaling.Y = 1 + Scenery(0).screenTr.X = mouseCoords.X + Scenery(0).screenTr.Y = mouseCoords.Y + Scenery(0).rotation = 0 + + Exit Sub + +ErrorHandler: + + MsgBox "Error setting current scenery" & vbNewLine & Error$ + +End Sub + +Public Sub setCurrentTexture(sceneryName As String) + + On Error GoTo ErrorHandler + + Dim loadName As String + Dim toTGARes As Long + + loadName = soldatDir & "Scenery-gfx\" & sceneryName + toTGARes = GifToBmp(loadName, appPath & "\Temp\gif.tga") + If right$(loadName, 4) = ".gif" Then + loadName = appPath & "\Temp\gif.tga" + End If + + If toTGARes = -1 Then + Set SceneryTextures(0).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + Else + Set SceneryTextures(0).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + End If + + SceneryTextures(0).Texture.GetLevelDesc 0, textureDesc + + SceneryTextures(0).Width = imageInfo.Width + SceneryTextures(0).Height = imageInfo.Height + + SceneryTextures(0).reScale.X = SceneryTextures(0).Width / textureDesc.Width + SceneryTextures(0).reScale.Y = SceneryTextures(0).Height / textureDesc.Height + + If SceneryTextures(0).reScale.X = 0 Or SceneryTextures(0).reScale.Y = 0 Then + SceneryTextures(0).reScale.X = 1 + SceneryTextures(0).reScale.Y = 1 + End If + + setCurrentScenery 0 + Scenery(0).Style = 0 + + Exit Sub + +ErrorHandler: + + MsgBox "Error creating current scenery texture" & vbNewLine & Error$ + +End Sub + +Public Sub setSceneryLevel(ByVal level As Byte) + + Scenery(0).level = level + +End Sub + +Public Sub CreateSceneryTexture(sceneryName As String) + + On Error GoTo ErrorHandler + + sceneryElements = sceneryElements + 1 + ReDim Preserve SceneryTextures(sceneryElements) + + Dim loadName As String + Dim toTGARes As Long + + loadName = soldatDir & "Scenery-gfx\" & sceneryName + toTGARes = GifToBmp(loadName, appPath & "\Temp\gif.tga") + If right$(loadName, 4) = ".gif" Then + loadName = appPath & "\Temp\gif.tga" + End If + + If toTGARes = -1 Then + Set SceneryTextures(sceneryElements).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + Else + Set SceneryTextures(sceneryElements).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + End If + + frmScenery.lstScenery.AddItem sceneryName + tvwScenery.Nodes.Add "In Use", tvwChild, sceneryName, sceneryName + + SceneryTextures(sceneryElements).Texture.GetLevelDesc 0, textureDesc + + SceneryTextures(sceneryElements).Width = imageInfo.Width + SceneryTextures(sceneryElements).Height = imageInfo.Height + + SceneryTextures(sceneryElements).reScale.X = SceneryTextures(sceneryElements).Width / textureDesc.Width + SceneryTextures(sceneryElements).reScale.Y = SceneryTextures(sceneryElements).Height / textureDesc.Height + + If SceneryTextures(sceneryElements).reScale.X = 0 Or SceneryTextures(sceneryElements).reScale.Y = 0 Then + SceneryTextures(sceneryElements).reScale.X = 1 + SceneryTextures(sceneryElements).reScale.Y = 1 + End If + + Exit Sub + +ErrorHandler: + + MsgBox "Error creating scenery texture: " & sceneryName & vbNewLine & Error$ + SceneryTextures(sceneryElements) = SceneryTextures(0) + +End Sub + +Public Sub RefreshSceneryTextures(Index As Integer) + + If frmScenery.lstScenery.ListCount = 0 Then Exit Sub + + Dim sceneryName As String + Dim scenNum As Integer + + sceneryName = frmScenery.lstScenery.List(Index - 1) + + Dim loadName As String + Dim toTGARes As Long + + loadName = soldatDir & "Scenery-gfx\" & sceneryName + toTGARes = GifToBmp(loadName, appPath & "\Temp\gif.tga") + If right$(loadName, 4) = ".gif" Then + loadName = appPath & "\Temp\gif.tga" + End If + + If toTGARes = -1 Then + Set SceneryTextures(Index).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, loadName, D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + Else + Set SceneryTextures(Index).Texture = D3DX.CreateTextureFromFileEx(D3DDevice, appPath & "\" & gfxDir & "\notfound.bmp", D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _ + D3DX_FILTER_POINT, ColorKey, imageInfo, ByVal 0) + End If + + SceneryTextures(Index).Texture.GetLevelDesc 0, textureDesc + + SceneryTextures(Index).Width = imageInfo.Width + SceneryTextures(Index).Height = imageInfo.Height + + SceneryTextures(Index).reScale.X = SceneryTextures(Index).Width / textureDesc.Width + SceneryTextures(Index).reScale.Y = SceneryTextures(Index).Height / textureDesc.Height + + If SceneryTextures(Index).reScale.X = 0 Or SceneryTextures(Index).reScale.Y = 0 Then + SceneryTextures(Index).reScale.X = 1 + SceneryTextures(Index).reScale.Y = 1 + End If + +End Sub + +Private Sub SaveFile(FileName As String) + + Dim i As Integer, j As Integer, k As Integer + Dim X As Integer, Y As Integer + + Dim xOffset As Integer, yOffset As Integer + + Dim xDiff As Single, yDiff As Single + Dim length As Single + Dim VertNum As Byte + Dim mapWidth As Long, mapHeight As Long + + Const SECTOR_NUM As Long = 25 + + Dim Polygon As TMapFile_Polygon + Dim sectorsDivision As Long + + Const zero As Integer = 0 + + Dim Scenery_New As TMapFile_Scenery + Dim newWaypoint As TNewWaypoint + Dim sceneryName As String + Dim Prop As TProp + Dim spawn As TSaveSpawnPoint + Dim tempClr As TColor + Dim connectedNum As Integer + + Dim fileOpen As Boolean + + Me.MousePointer = 11 + + 'refresh background + mnuRefreshBG_Click + + mapWidth = maxX - minX + mapHeight = maxY - minY + + Options.BackgroundColor = ARGB(255, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red)) + Options.BackgroundColor2 = ARGB(255, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red)) + 'set texture name + Options.textureName(0) = Len(textureFile) + For i = 1 To Len(textureFile) + Options.textureName(i) = Asc(mid(textureFile, i, 1)) + Next + 'set map name + Options.mapName(0) = Len(mapTitle) + If Options.mapName(0) > 38 Then Options.mapName(0) = 38 + For i = 1 To Options.mapName(0) + Options.mapName(i) = Asc(mid(mapTitle, i, 1)) + Next + + Options.MapRandomID = -1 + + If mapWidth > mapHeight Then + sectorsDivision = Int((mapWidth + 100) / 25) + Else + sectorsDivision = Int((mapHeight + 100) / 25) + End If + + Open FileName For Binary Access Write Lock Write As #1 + + fileOpen = True + + Put #1, , Version + Put #1, , Options + + 'save polys + Put #1, , polyCount + For i = 1 To polyCount + + Polygon.Poly = Polys(i) + + For j = 1 To 3 + + Polygon.Poly.vertex(j).X = PolyCoords(i).vertex(j).X + Polygon.Poly.vertex(j).Y = PolyCoords(i).vertex(j).Y + + Polygon.Poly.vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) + + VertNum = j + 1 + If VertNum > 3 Then VertNum = 1 + + xDiff = PolyCoords(i).vertex(VertNum).X - PolyCoords(i).vertex(j).X + yDiff = PolyCoords(i).vertex(j).Y - PolyCoords(i).vertex(VertNum).Y + If xDiff = 0 And yDiff = 0 Then + length = 1 + Else + length = Sqr(xDiff ^ 2 + yDiff ^ 2) + End If + Polygon.Poly.Perp.vertex(j).X = (yDiff / length) * Polygon.Poly.Perp.vertex(j).z + Polygon.Poly.Perp.vertex(j).Y = (xDiff / length) * Polygon.Poly.Perp.vertex(j).z + Polygon.Poly.Perp.vertex(j).z = 1 + + Next + + Polygon.polyType = vertexList(i).polyType + + Put #1, , Polygon + + Next + + Put #1, , sectorsDivision + Put #1, , SECTOR_NUM + + For i = -25 To 25 + For j = -25 To 25 + Put #1, , zero + Next + Next + + Put #1, , sceneryCount + + For i = 1 To sceneryCount + Prop.active = True + Prop.alpha = Scenery(i).alpha + tempClr = getRGB(Scenery(i).Color) + Prop.Color = ARGB(255, RGB(tempClr.blue, tempClr.green, tempClr.red)) + Prop.Width = SceneryTextures(Scenery(i).Style).Width + Prop.Height = SceneryTextures(Scenery(i).Style).Height + Prop.level = Scenery(i).level + Prop.rotation = Scenery(i).rotation + Prop.ScaleX = Scenery(i).Scaling.X + Prop.ScaleY = Scenery(i).Scaling.Y + Prop.X = Scenery(i).Translation.X - xOffset + Prop.Y = Scenery(i).Translation.Y - yOffset + Prop.Style = Scenery(i).Style + + Put #1, , Prop + Next + + Put #1, , sceneryElements + + For i = 1 To sceneryElements + sceneryName = frmScenery.lstScenery.List(i - 1) + Scenery_New.sceneryName(0) = Len(sceneryName) + For j = 1 To Scenery_New.sceneryName(0) + Scenery_New.sceneryName(j) = Asc(mid(sceneryName, j, 1)) + Next + Scenery_New.Date = getFileDate(sceneryName) + Put #1, , Scenery_New + Next + + Put #1, , colliderCount + + For i = 1 To colliderCount + Colliders(i).active = 1 + Put #1, , Colliders(i) + Colliders(i).active = 0 + Next + + Put #1, , spawnPoints + + For i = 1 To spawnPoints + spawn.active = 1 + spawn.X = Spawns(i).X + spawn.Y = Spawns(i).Y + spawn.Team = Spawns(i).Team + Put #1, , spawn + Spawns(i).active = 0 + Next + + Put #1, , waypointCount + + For i = 1 To waypointCount + newWaypoint.active = 1 + newWaypoint.X = Waypoints(i).X + newWaypoint.Y = Waypoints(i).Y + newWaypoint.connectionsNum = Waypoints(i).numConnections + If Waypoints(i).wayType(0) Then newWaypoint.left = 1 Else newWaypoint.left = 0 + If Waypoints(i).wayType(1) Then newWaypoint.right = 1 Else newWaypoint.right = 0 + If Waypoints(i).wayType(2) Then newWaypoint.up = 1 Else newWaypoint.up = 0 + If Waypoints(i).wayType(3) Then newWaypoint.down = 1 Else newWaypoint.down = 0 + If Waypoints(i).wayType(4) Then newWaypoint.m2 = 1 Else newWaypoint.m2 = 0 + newWaypoint.id = i + newWaypoint.pathNum = Waypoints(i).pathNum + newWaypoint.special = Waypoints(i).special + connectedNum = 0 + For j = 1 To conCount + If Connections(j).point1 = i And connectedNum < 20 Then + connectedNum = connectedNum + 1 + newWaypoint.Connections(connectedNum) = Connections(j).point2 + End If + Next + Waypoints(i).numConnections = connectedNum + newWaypoint.connectionsNum = connectedNum + Put #1, , newWaypoint + Next + + Put #1, , lightCount + + For i = 1 To lightCount + Put #1, , Lights(i) + Next + + Put #1, , sketchLines + + For i = 1 To sketchLines + Put #1, , sketch(i) + Next + + Close #1 + + fileOpen = False + + currentFileName = "" + For i = 0 To Len(FileName) - 1 + If mid(FileName, Len(FileName) - i, 1) <> "\" Then + currentFileName = mid(FileName, Len(FileName) - i, 1) + currentFileName + Else + Exit For + End If + Next + + lblFileName.Caption = currentFileName + + Me.MousePointer = 99 + + Exit Sub + +ErrorHandler: + + MsgBox "Error saving map" & vbNewLine & Error$ + If fileOpen Then + Close #1 + End If + +End Sub + +Public Sub SaveAndCompile(FileName As String) + + Dim i As Integer, j As Integer, k As Integer + Dim X As Integer, Y As Integer + + Dim xOffset As Integer, yOffset As Integer + + Dim xDiff As Single, yDiff As Single + Dim length As Single + Dim VertNum As Byte + Dim sector(1 To 256) As Integer + Dim xSecNum As Integer, ySecNum As Integer + Dim mapWidth As Integer, mapHeight As Integer + + Const SECTOR_NUM As Long = 25 + + Dim Polygon As TMapFile_Polygon + Dim sectorsDivision As Long + Dim polysInSector As Integer + + Dim Scenery_New As TMapFile_Scenery + Dim newWaypoint As TNewWaypoint + Dim sceneryName As String + Dim Prop As TProp + Dim tempClr As TColor + Dim connectedNum As Integer + + Dim newSpawnPoint As TSaveSpawnPoint + Dim newCollider As TCollider + + Dim zero As Integer + + Dim fileOpen As Boolean + + On Error GoTo ErrorHandler + + zero = 0 + + Me.MousePointer = 11 + + Randomize + + polysInSector = 0 + + newSpawnPoint.active = 1 + newCollider.active = 1 + + 'refresh background + mnuRefreshBG_Click + + 'find offsets to center map + xOffset = Int(Midpoint(maxX, minX)) + yOffset = Int(Midpoint(maxY, minY)) + + mapWidth = maxX - xOffset + mapHeight = maxY - yOffset + + Options.BackgroundColor = ARGB(255, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red)) + Options.BackgroundColor2 = ARGB(255, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red)) + 'set texture name + Options.textureName(0) = Len(textureFile) + If Options.textureName(0) > 24 Then Options.textureName(0) = 24 + For i = 1 To Options.textureName(0) + Options.textureName(i) = Asc(mid(textureFile, i, 1)) + Next + 'set map name + Options.mapName(0) = Len(mapTitle) + If Options.mapName(0) > 38 Then Options.mapName(0) = 38 + For i = 1 To Options.mapName(0) + Options.mapName(i) = Asc(mid(mapTitle, i, 1)) + Next + + 'set map random ID + Options.MapRandomID = (Rnd * 999999) + 10000 + + xSecNum = SECTOR_NUM + ySecNum = SECTOR_NUM + + If mapWidth > mapHeight Then + sectorsDivision = Int((mapWidth + 100) / 25) + ySecNum = (mapHeight + 100) / sectorsDivision + Else + sectorsDivision = Int((mapHeight + 100) / 25) + xSecNum = (mapWidth + 100) / sectorsDivision + End If + + Open FileName For Binary Access Write Lock Write As #1 + + fileOpen = True + + Put #1, , Version + Put #1, , Options + + 'save polys + Put #1, , polyCount + For i = 1 To polyCount + + Polygon.Poly = Polys(i) + Polygon.polyType = vertexList(i).polyType + + Polygon.Poly.vertex(1).X = PolyCoords(i).vertex(1).X - xOffset + Polygon.Poly.vertex(1).Y = PolyCoords(i).vertex(1).Y - yOffset + Polygon.Poly.vertex(2).X = PolyCoords(i).vertex(2).X - xOffset + Polygon.Poly.vertex(2).Y = PolyCoords(i).vertex(2).Y - yOffset + Polygon.Poly.vertex(3).X = PolyCoords(i).vertex(3).X - xOffset + Polygon.Poly.vertex(3).Y = PolyCoords(i).vertex(3).Y - yOffset + + For j = 1 To 3 + + VertNum = j + 1 + If VertNum > 3 Then VertNum = 1 + + xDiff = Polygon.Poly.vertex(VertNum).X - Polygon.Poly.vertex(j).X + yDiff = Polygon.Poly.vertex(j).Y - Polygon.Poly.vertex(VertNum).Y + If xDiff = 0 And yDiff = 0 Then + length = 1 + Else + length = Sqr(xDiff ^ 2 + yDiff ^ 2) + End If + If Polygon.polyType = 18 Then + If Polygon.Poly.Perp.vertex(j).z < 1 Then + Polygon.Poly.Perp.vertex(j).z = 1 + End If + Else + Polygon.Poly.Perp.vertex(j).z = 1 + End If + Polygon.Poly.Perp.vertex(j).X = (yDiff / length) * Polygon.Poly.Perp.vertex(j).z + Polygon.Poly.Perp.vertex(j).Y = (xDiff / length) * Polygon.Poly.Perp.vertex(j).z + Polygon.Poly.Perp.vertex(j).z = 1 + Polygon.Poly.vertex(j).z = 1 + + Next + + Put #1, , Polygon + + Next + + Put #1, , sectorsDivision + Put #1, , SECTOR_NUM + + 'generate sectors + For X = -SECTOR_NUM To SECTOR_NUM + For Y = -SECTOR_NUM To SECTOR_NUM + + polysInSector = 0 + + If X >= -xSecNum And X <= xSecNum And Y >= -ySecNum And Y <= ySecNum Then 'if sectors within range + + For i = 1 To polyCount + If vertexList(i).polyType <> 3 Then + If isInSector(i, sectorsDivision * (X - 0.5) + xOffset - 1, sectorsDivision * (Y - 0.5) + yOffset - 1, sectorsDivision + 2) Then + polysInSector = polysInSector + 1 + If polysInSector > 256 Then + polysInSector = 256 + Else + sector(polysInSector) = i + End If + End If + End If + Next + + If polysInSector > 256 Then polysInSector = 256 + + End If + + Put #1, , polysInSector + + If polysInSector > 0 Then + For k = 1 To polysInSector + Put #1, , sector(k) + Next + End If + + Next + picProgress.Line ((X + SECTOR_NUM) * 2, 0)-((X + SECTOR_NUM) * 2, 12), RGB(61, 75, 97) + picProgress.Line ((X + SECTOR_NUM) * 2 + 1, 0)-((X + SECTOR_NUM) * 2 + 1, 12), RGB(61, 75, 97) + picProgress.Refresh + Next + + picProgress.Cls + + Put #1, , sceneryCount + + For i = 1 To sceneryCount + Prop.active = True + Prop.alpha = Scenery(i).alpha + tempClr = getRGB(Scenery(i).Color) + Prop.Color = ARGB(255, RGB(tempClr.blue, tempClr.green, tempClr.red)) + Prop.Width = SceneryTextures(Scenery(i).Style).Width + Prop.Height = SceneryTextures(Scenery(i).Style).Height + Prop.level = Scenery(i).level + Prop.rotation = Scenery(i).rotation + Prop.ScaleX = Scenery(i).Scaling.X + Prop.ScaleY = Scenery(i).Scaling.Y + Prop.X = Scenery(i).Translation.X - xOffset + Prop.Y = Scenery(i).Translation.Y - yOffset + Prop.Style = Scenery(i).Style + + Put #1, , Prop + Next + + Put #1, , sceneryElements + + For i = 1 To sceneryElements + sceneryName = frmScenery.lstScenery.List(i - 1) + Scenery_New.sceneryName(0) = Len(sceneryName) + For j = 1 To Scenery_New.sceneryName(0) + Scenery_New.sceneryName(j) = Asc(mid(sceneryName, j, 1)) + Next + Scenery_New.Date = getFileDate(sceneryName) + Put #1, , Scenery_New + Next + + Put #1, , colliderCount + + For i = 1 To colliderCount + newCollider.radius = Colliders(i).radius + newCollider.X = Colliders(i).X - xOffset + newCollider.Y = Colliders(i).Y - yOffset + Put #1, , newCollider + Next + + Put #1, , spawnPoints + + For i = 1 To spawnPoints + newSpawnPoint.Team = Spawns(i).Team + newSpawnPoint.X = Spawns(i).X - xOffset + newSpawnPoint.Y = Spawns(i).Y - yOffset + Put #1, , newSpawnPoint + Next + + Put #1, , waypointCount + + For i = 1 To waypointCount + newWaypoint.active = 1 + newWaypoint.X = Waypoints(i).X - xOffset + newWaypoint.Y = Waypoints(i).Y - yOffset + newWaypoint.connectionsNum = Waypoints(i).numConnections + If Waypoints(i).wayType(0) Then newWaypoint.left = 1 Else newWaypoint.left = 0 + If Waypoints(i).wayType(1) Then newWaypoint.right = 1 Else newWaypoint.right = 0 + If Waypoints(i).wayType(2) Then newWaypoint.up = 1 Else newWaypoint.up = 0 + If Waypoints(i).wayType(3) Then newWaypoint.down = 1 Else newWaypoint.down = 0 + If Waypoints(i).wayType(4) Then newWaypoint.m2 = 1 Else newWaypoint.m2 = 0 + newWaypoint.id = i + newWaypoint.pathNum = Waypoints(i).pathNum + newWaypoint.special = Waypoints(i).special + connectedNum = 0 + For j = 1 To conCount + If Connections(j).point1 = i And connectedNum < 20 Then + connectedNum = connectedNum + 1 + newWaypoint.Connections(connectedNum) = Connections(j).point2 + End If + Next + Waypoints(i).numConnections = connectedNum + newWaypoint.connectionsNum = connectedNum + Put #1, , newWaypoint + Next + + Put #1, , zero + Put #1, , zero + Put #1, , zero + Put #1, , zero + + Close #1 + + fileOpen = False + + Me.MousePointer = 99 + SetCursor currentFunction + 1 + + Render + + Exit Sub + +ErrorHandler: + + MsgBox "Error saving/compiling map: " & Error$ + If fileOpen Then + Close #1 + End If + +End Sub + +Private Sub SaveUndo() + + On Error GoTo ErrorHandler + + Dim i As Integer, j As Integer + Dim Polygon As TPolygon + Dim FileName As String + + selectionChanged = False + + numRedo = 0 + numUndo = numUndo + 1 + If numUndo > max_undo Then + numUndo = max_undo + End If + currentUndo = currentUndo + 1 + If currentUndo > max_undo Then + currentUndo = 0 + End If + + FileName = appPath & "\undo\undo" & currentUndo & ".pwn" + + If Len(Dir(appPath & "\undo\")) = 0 Then + MkDir (appPath & "\undo\") + End If + + Open FileName For Binary Access Write Lock Write As #1 + + 'save polys + Put #1, , polyCount + For i = 1 To polyCount + Polygon = Polys(i) + For j = 1 To 3 + Polygon.vertex(j).X = PolyCoords(i).vertex(j).X + Polygon.vertex(j).Y = PolyCoords(i).vertex(j).Y + Next + Put #1, , Polygon + Put #1, , vertexList(i) + Next + + Put #1, , sceneryCount + For i = 1 To sceneryCount + Put #1, , Scenery(i) + Next + + Put #1, , colliderCount + For i = 1 To colliderCount + Put #1, , Colliders(i) + Next + + Put #1, , spawnPoints + For i = 1 To spawnPoints + Put #1, , Spawns(i) + Next + + Put #1, , lightCount + For i = 1 To lightCount + Put #1, , Lights(i) + Next + + Put #1, , waypointCount + For i = 1 To waypointCount + Put #1, , Waypoints(i) + Next + + Put #1, , conCount + For i = 1 To conCount + Put #1, , Connections(i) + Next + + Put #1, , numSelectedPolys + For i = 1 To numSelectedPolys + Put #1, , selectedPolys(i) + Next + + Put #1, , numSelectedScenery + Put #1, , numSelSpawns + Put #1, , numSelColliders + Put #1, , numSelWaypoints + + For i = 0 To 3 + Put #1, , selRect(i) + Next + + Close #1 + + Exit Sub + +ErrorHandler: + + MsgBox "Error saving undo" & vbNewLine & Error$ + +End Sub + +Private Sub loadUndo(redo As Boolean) + + Dim i As Integer, j As Integer + Dim FileName As String + Dim errorVal As String + + On Error GoTo ErrorHandler + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If toolAction = True And numVerts > 0 Then + toolAction = False + numVerts = 0 + Render + Exit Sub + End If + + currentWaypoint = 0 + + If redo Then + If numRedo < 1 Then Exit Sub + currentUndo = currentUndo + 1 + numUndo = numUndo + 1 + numRedo = numRedo - 1 + Else 'undo + If numUndo <= 1 Then Exit Sub + currentUndo = currentUndo - 1 + numUndo = numUndo - 1 + numRedo = numRedo + 1 + End If + If currentUndo < 0 Then + currentUndo = max_undo + ElseIf currentUndo > max_undo Then + currentUndo = 0 + End If + + numSelectedPolys = 0 + ReDim selectedPolys(0) + + FileName = appPath & "\undo\undo" & currentUndo & ".pwn" + + errorVal = "Error opening file" + + Open FileName For Binary Access Read Lock Read As #1 + + errorVal = "Error loading polygons" + + Get #1, , polyCount + ReDim Polys(0 To polyCount) + ReDim PolyCoords(0 To polyCount) + ReDim vertexList(0 To polyCount) + + For i = 1 To polyCount + Get #1, , Polys(i) + Get #1, , vertexList(i) + For j = 1 To 3 + PolyCoords(i).vertex(j).X = Polys(i).vertex(j).X + PolyCoords(i).vertex(j).Y = Polys(i).vertex(j).Y + Polys(i).vertex(j).X = (PolyCoords(i).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(i).vertex(j).Y = (PolyCoords(i).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + Next + Next + + errorVal = "Error loading scenery" + + Get #1, , sceneryCount + ReDim Preserve Scenery(sceneryCount) + If sceneryCount > 0 Then + For i = 1 To sceneryCount + Get #1, , Scenery(i) + Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor + Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor + Next + End If + + errorVal = "Error loading colliders" + + Get #1, , colliderCount + ReDim Preserve Colliders(colliderCount) + For i = 1 To colliderCount + Get #1, , Colliders(i) + Next + + errorVal = "Error loading spawnpoints" + + Get #1, , spawnPoints + ReDim Preserve Spawns(spawnPoints) + For i = 1 To spawnPoints + Get #1, , Spawns(i) + Next + + errorVal = "Error loading lights" + + Get #1, , lightCount + ReDim Preserve Lights(lightCount) + For i = 1 To lightCount + Get #1, , Lights(i) + Next + + errorVal = "Error loading waypoints" + + Get #1, , waypointCount + ReDim Waypoints(waypointCount) + For i = 1 To waypointCount + Get #1, , Waypoints(i) + Next + + errorVal = "Error loading connections" + + Get #1, , conCount + ReDim Connections(conCount) + For i = 1 To conCount + Get #1, , Connections(i) + Next + + errorVal = "Error loading selected polys" + + Get #1, , numSelectedPolys + ReDim selectedPolys(numSelectedPolys) + For i = 1 To numSelectedPolys + Get #1, , selectedPolys(i) + Next + + errorVal = "Error loading selected scenery" + + Get #1, , numSelectedScenery + Get #1, , numSelSpawns + Get #1, , numSelColliders + Get #1, , numSelWaypoints + + For i = 0 To 3 + Get #1, , selRect(i) + Next + + Close #1 + + errorVal = "Error loading undo state" + + setMapData + + getRCenter + + Render + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & errorVal + +End Sub + +Private Function isInSector(Index As Integer, X As Integer, Y As Integer, ByVal div As Long) As Boolean + + On Error GoTo ErrorHandler + + isInSector = False + + 'is poly outside of sector for sure + If (PolyCoords(Index).vertex(1).X < X) And (PolyCoords(Index).vertex(2).X < X) And (PolyCoords(Index).vertex(3).X < X) Then + Exit Function + ElseIf (PolyCoords(Index).vertex(1).X > X + div) And (PolyCoords(Index).vertex(2).X > X + div) And (PolyCoords(Index).vertex(3).X > X + div) Then + Exit Function + ElseIf (PolyCoords(Index).vertex(1).Y < Y) And (PolyCoords(Index).vertex(2).Y < Y) And (PolyCoords(Index).vertex(3).Y < Y) Then + Exit Function + ElseIf (PolyCoords(Index).vertex(1).Y > Y + div) And (PolyCoords(Index).vertex(2).Y > Y + div) And (PolyCoords(Index).vertex(3).Y > Y + div) Then + Exit Function + End If + + 'is vertex in sector + If isBetween(X, PolyCoords(Index).vertex(1).X, X + div) And isBetween(Y, PolyCoords(Index).vertex(1).Y, Y + div) Then + isInSector = True + Exit Function + ElseIf isBetween(X, PolyCoords(Index).vertex(2).X, X + div) And isBetween(Y, PolyCoords(Index).vertex(2).Y, Y + div) Then + isInSector = True + Exit Function + ElseIf isBetween(X, PolyCoords(Index).vertex(3).X, X + div) And isBetween(Y, PolyCoords(Index).vertex(3).Y, Y + div) Then + isInSector = True + Exit Function + End If + + 'check if sector corner is in poly + If Not isInSector Then + If pointInPoly(X, Y, Index) Then + isInSector = True + Exit Function + ElseIf pointInPoly(X + div, Y, Index) Then + isInSector = True + Exit Function + ElseIf pointInPoly(X, Y + div, Index) Then + isInSector = True + Exit Function + ElseIf pointInPoly(X + div, Y + div, Index) Then + isInSector = True + Exit Function + End If + End If + + Dim A1 As D3DVECTOR2 + Dim B1 As D3DVECTOR2 + Dim A2 As D3DVECTOR2 + Dim B2 As D3DVECTOR2 + + Dim indexA1 As Integer + Dim indexB1 As Integer + + For indexA1 = 1 To 3 + indexB1 = indexA1 + 1 + If indexB1 > 3 Then indexB1 = 1 + A1.X = PolyCoords(Index).vertex(indexA1).X + A1.Y = PolyCoords(Index).vertex(indexA1).Y + B1.X = PolyCoords(Index).vertex(indexB1).X + B1.Y = PolyCoords(Index).vertex(indexB1).Y + + A2.X = X + A2.Y = Y + B2.X = X + div + B2.Y = Y + If SegXSeg(A1, B1, A2, B2) Then 'top + isInSector = True + Exit Function + End If + A2.X = X + A2.Y = Y + div + B2.X = X + div + B2.Y = Y + div + If SegXSeg(A1, B1, A2, B2) Then 'bottom + isInSector = True + Exit Function + End If + A2.X = X + A2.Y = Y + B2.X = X + B2.Y = Y + div + If SegXSeg(A1, B1, A2, B2) Then 'left + isInSector = True + Exit Function + End If + A2.X = X + div + A2.Y = Y + B2.X = X + div + B2.Y = Y + div + If SegXSeg(A1, B1, A2, B2) Then 'right + isInSector = True + Exit Function + End If + Next + + Exit Function + +ErrorHandler: + + MsgBox "Sector error, " & Error$ + +End Function + +Private Function isInSector2(Index As Integer, X As Integer, Y As Integer, div As Long) As Integer + + Dim i As Integer, j As Integer + Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer + + Dim VertNum As Byte + + On Error GoTo ErrorHandler + + isInSector2 = False + + For j = 1 To 3 + + VertNum = j + 1 + If VertNum > 3 Then VertNum = 1 + x1 = PolyCoords(Index).vertex(j).X + x2 = PolyCoords(Index).vertex(VertNum).X + y1 = PolyCoords(Index).vertex(j).Y + y2 = PolyCoords(Index).vertex(VertNum).Y + + If segmentsIntersect(x1, y1, x2, y2, X, Y, X + div, Y) Then + isInSector2 = True + ElseIf segmentsIntersect(x1, y1, x2, y2, X, Y, X, Y + div) Then + isInSector2 = True + ElseIf segmentsIntersect(x1, y1, x2, y2, X + div, Y, X + div, Y + div) Then + isInSector2 = True + ElseIf segmentsIntersect(x1, y1, x2, y2, X, Y + div, X + div, Y + div) Then + isInSector2 = True + End If + + Next + + Exit Function + +ErrorHandler: + + MsgBox Error$ + +End Function + +Private Function SegXHorizSeg(ByRef A1 As D3DVECTOR2, ByRef B1 As D3DVECTOR2, _ + ByRef A2 As D3DVECTOR2, ByRef length As Long) As Boolean + + Dim U As D3DVECTOR2 + Dim VX As Integer + Dim D As Single + Dim epsilon As Single + + SegXHorizSeg = False + + U.X = B1.X - A1.X + U.Y = B1.Y - A1.Y + D = -U.Y * length + + If (D = 0) Then 'the poly line seg is also horizontal + Exit Function + End If + + Dim W As D3DVECTOR2 + Dim s As Single + Dim T As Single + + W.X = A1.X - A2.X + W.Y = A1.Y - A2.Y + + s = (length * W.Y) / D + If (s <= 0 Or s >= 1) Then + Exit Function + End If + + T = (U.X * W.Y - U.Y * W.X) / D + If (T <= 0 Or T >= 1) Then + Exit Function + End If + + SegXHorizSeg = True + +End Function + +Private Function SegXVertSeg(ByRef A1 As D3DVECTOR2, ByRef B1 As D3DVECTOR2, _ + ByRef A2 As D3DVECTOR2, ByRef length As Long) As Boolean + + Dim U As D3DVECTOR2 + Dim D As Single + + SegXVertSeg = False + + U.X = B1.X - A1.X 'length of poly seg x + U.Y = B1.Y - A1.Y 'y + D = U.X * length + + If (D = 0) Then 'the poly line seg is also vertical + Exit Function + End If + + Dim W As D3DVECTOR2 + Dim s As Single + Dim T As Single + + W.X = A1.X - A2.X + W.Y = A1.Y - A2.Y + + s = (-length * W.X) / D + If (s <= 0 Or s >= 1) Then + Exit Function + End If + + T = (U.X * W.Y - U.Y * W.X) / D + If (T <= 0 Or T >= 1) Then + Exit Function + End If + + SegXVertSeg = True + +End Function + +Private Function segmentsIntersect(ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer, _ + ByVal A1 As Integer, ByVal B1 As Integer, ByVal A2 As Integer, ByVal B2 As Integer) As Boolean + + On Error GoTo ErrorHandler + + Dim DX As Long + Dim dy As Long + Dim da As Long + Dim db As Long + Dim T As Single + Dim s As Single + + DX = x2 - x1 + dy = y2 - y1 + da = A2 - A1 + db = B2 - B1 + + If (da * dy - db * DX) = 0 Then + 'the segments are parallel + segmentsIntersect = False + Exit Function + End If + + s = (DX * (B1 - y1) + dy * (x1 - A1)) / (da * dy - db * DX) + T = (da * (y1 - B1) + db * (A1 - x1)) / (db * DX - da * dy) + segmentsIntersect = (s >= 0 And s <= 1 And T >= 0 And T <= 1) + + Exit Function + +ErrorHandler: + + MsgBox Error$ + +End Function + +Private Function SegXSeg(ByRef A1 As D3DVECTOR2, ByRef B1 As D3DVECTOR2, _ + ByRef A2 As D3DVECTOR2, ByRef B2 As D3DVECTOR2) As Boolean + + Dim U As D3DVECTOR2 + Dim V As D3DVECTOR2 + Dim D As Single + + SegXSeg = False + + U.X = B1.X - A1.X + U.Y = B1.Y - A1.Y + V.X = B2.X - A2.X + V.Y = B2.Y - A2.Y + D = U.X * V.Y - U.Y * V.X + + If (D = 0) Then 'the poly line seg is also horizontal + Exit Function + End If + + Dim W As D3DVECTOR2 + Dim s As Single + Dim T As Single + + W.X = A1.X - A2.X + W.Y = A1.Y - A2.Y + + s = (V.X * W.Y - V.Y * W.X) / D + If (s <= 0# Or s >= 1#) Then + Exit Function + End If + + T = (U.X * W.Y - U.Y * W.X) / D + If (T <= 0# Or T >= 1#) Then + Exit Function + End If + + SegXSeg = True + +End Function + +Private Function isBetween(p1, p2, p3) As Boolean + + isBetween = False + + If (p1 >= p2 And p2 >= p3) Or (p3 >= p2 And p2 >= p1) Then + isBetween = True + End If + +End Function + +Private Sub initGrid() + + On Error GoTo ErrorHandler + + Dim i As Integer + + Dim clrString As String + Dim clr1 As Long, clr2 As Long + + clr1 = ARGB(gridOp1, gridClr) + clr2 = ARGB(gridOp2, gridClr2) + + ReDim xGridLines(gridDivisions) + ReDim yGridLines(gridDivisions) + + xGridLines(1).vertex(1) = CreateCustomVertex(0, 0, 1, 1, clr1, 0, 0) + xGridLines(1).vertex(2) = CreateCustomVertex(Me.ScaleWidth, 0, 1, 1, clr1, 0, 0) + + yGridLines(1).vertex(1) = CreateCustomVertex(0, 0, 1, 1, clr1, 0, 0) + yGridLines(1).vertex(2) = CreateCustomVertex(0, Me.ScaleHeight, 1, 1, clr1, 0, 0) + + For i = 2 To gridDivisions + xGridLines(i).vertex(1) = CreateCustomVertex(0, 0, 1, 1, clr2, 0, 0) + xGridLines(i).vertex(2) = CreateCustomVertex(Me.ScaleWidth, 0, 1, 1, clr2, 0, 0) + yGridLines(i).vertex(1) = CreateCustomVertex(0, 0, 1, 1, clr2, 0, 0) + yGridLines(i).vertex(2) = CreateCustomVertex(0, Me.ScaleHeight, 1, 1, clr2, 0, 0) + Next + + inc = (gridSpacing / gridDivisions) + + Exit Sub + +ErrorHandler: + + MsgBox "Error initializing grid" + +End Sub + +Private Sub setGrid() + + Dim xGridOffset As Single, yGridOffset As Single + Dim i As Integer + + xGridOffset = (scrollCoords(2).X - (Int(scrollCoords(2).X / gridSpacing) * gridSpacing)) * zoomFactor + yGridOffset = (scrollCoords(2).Y - (Int(scrollCoords(2).Y / gridSpacing) * gridSpacing)) * zoomFactor + + xGridLines(1).vertex(1).Y = 0 - yGridOffset + xGridLines(1).vertex(2).Y = 0 - yGridOffset + + yGridLines(1).vertex(1).X = 0 - xGridOffset + yGridLines(1).vertex(2).X = 0 - xGridOffset + + For i = 2 To gridDivisions + xGridLines(i).vertex(1).Y = xGridLines(1).vertex(1).Y + (gridSpacing / gridDivisions) * zoomFactor * (i - 1) + xGridLines(i).vertex(2).Y = xGridLines(i).vertex(1).Y + yGridLines(i).vertex(1).X = yGridLines(1).vertex(1).X + (gridSpacing / gridDivisions) * zoomFactor * (i - 1) + yGridLines(i).vertex(2).X = yGridLines(i).vertex(1).X + Next + +End Sub + +Private Function CreateCustomVertex(ByVal X As Single, ByVal Y As Single, z As Single, rhw As Single, Color As Long, _ + tu As Single, tv As Single) As TCustomVertex + + CreateCustomVertex.X = X + CreateCustomVertex.Y = Y + CreateCustomVertex.z = z + CreateCustomVertex.rhw = rhw + CreateCustomVertex.Color = Color + CreateCustomVertex.tu = tu + CreateCustomVertex.tv = tv + +End Function + +Private Function ExModeActive() As Boolean + + Dim TestCoopRes As Long + + TestCoopRes = D3DDevice.TestCooperativeLevel + + If (TestCoopRes = D3D_OK) Then + ExModeActive = True + Else + ExModeActive = False + End If + +End Function + +Public Sub Render() + + If Not initialized Or noRedraw Then Exit Sub + + Dim i As Integer, j As Integer + Dim lineCoords(1 To 4) As TCustomVertex + Dim sceneryCoords(4) As TCustomVertex + Dim circleCoords(0 To 32) As TCustomVertex + Dim numPolys As Integer + Dim scenR As Single + Dim backtypePolys() As TPolygon + + Dim xVal As Single, yVal As Single + Dim theta As Single + Dim R As Single + + Dim srcRect As RECT + Dim rc As D3DVECTOR2 + Dim sc As D3DVECTOR2 + Dim tr As D3DVECTOR2 + Dim sVal As Integer + Dim objClr As Long + + + Dim matView As D3DMATRIX + Dim viewVector As D3DVECTOR + Dim upVector As D3DVECTOR + Dim atVector As D3DVECTOR + Dim matProj As D3DMATRIX + + upVector.Y = -1 + atVector.z = 1 + atVector.X = scrollCoords(2).X + Me.ScaleWidth / 2 / zoomFactor + atVector.Y = (scrollCoords(2).Y + Me.ScaleHeight / 2 / zoomFactor) + + viewVector.X = scrollCoords(2).X + Me.ScaleWidth / 2 / zoomFactor + viewVector.Y = (scrollCoords(2).Y + Me.ScaleHeight / 2 / zoomFactor) + viewVector.z = 0 + + D3DXMatrixLookAtLH matView, viewVector, atVector, upVector + D3DDevice.SetTransform D3DTS_VIEW, matView + + D3DXMatrixPerspectiveLH matProj, Me.ScaleWidth / zoomFactor, -Me.ScaleHeight / zoomFactor, -1, 0 + D3DDevice.SetTransform D3DTS_PROJECTION, matProj + + + rc.X = 0 + rc.Y = 0 + + srcRect.left = 0 + srcRect.Top = 0 + + For i = 1 To 4 + lineCoords(i).rhw = 1 + lineCoords(i).z = 1 + Next + + initialized = False + If ExModeActive Then 'check if in focus + initialized = True + Else + resetDevice ''''' + initialized = True + End If + + If numVerts > 0 And currentTool = TOOL_CREATE Then + numPolys = polyCount + 1 + Else + numPolys = polyCount + End If + + D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, backClr, 1#, 0 + + D3DDevice.BeginScene + '---- + + D3DDevice.setTexture 0, Nothing + + 'draw background + If showBG Then + D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, bgPolys(1), Len(bgPolys(1)) + End If + + 'Draw Polys + If showPolys And numPolys > 0 Then + If showTexture Then 'set texture + D3DDevice.setTexture 0, mapTexture + End If + + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 + D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA + D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA + D3DDevice.SetRenderState D3DRS_COLORWRITEENABLE, D3DCOLORWRITEENABLE_BLUE Or D3DCOLORWRITEENABLE_GREEN Or D3DCOLORWRITEENABLE_RED + D3DDevice.SetRenderState D3DRS_COLORWRITEENABLE, D3DCOLORWRITEENABLE_ALPHA Or D3DCOLORWRITEENABLE_BLUE Or D3DCOLORWRITEENABLE_GREEN Or D3DCOLORWRITEENABLE_RED + + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 + + If clrPolys Then + D3DDevice.SetRenderState D3DRS_SRCBLEND, polyBlendSrc + D3DDevice.SetRenderState D3DRS_DESTBLEND, polyBlendDest + End If + + For i = 1 To numPolys + If vertexList(i).polyType = 24 Or vertexList(i).polyType = 25 Then + D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(i).vertex(1), Len(Polys(1).vertex(1)) + End If + Next + + D3DDevice.SetRenderState D3DRS_SRCBLEND, polyBlendSrc + D3DDevice.SetRenderState D3DRS_DESTBLEND, polyBlendDest + + ElseIf showPolys = False And numPolys > 0 Then + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 + D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ZERO + D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE + For i = 1 To numPolys + If vertexList(i).polyType = 24 Or vertexList(i).polyType = 25 Then + D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(i).vertex(1), Len(Polys(1).vertex(1)) + End If + Next + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 0 + End If + + scenerySprite.Begin + If sceneryCount > 0 And showScenery And sslBack Then + For i = 1 To sceneryCount + If Scenery(i).level = 0 Then + sVal = Scenery(i).Style + If Scenery(i).selected = 1 Then + If scaleDiff.X <> 1 Or scaleDiff.Y <> 1 Then + xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X + yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y + theta = GetAngle(xVal, yVal) + Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + xVal = Cos(theta) * R * scaleDiff.X + yVal = -Sin(theta) * R * scaleDiff.Y + theta = GetAngle(xVal, yVal) - Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + sc.X = SceneryTextures(sVal).reScale.X * ((Cos(theta) * R) / (SceneryTextures(Scenery(i).Style).Width)) * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * (-(Sin(theta) * R) / (SceneryTextures(Scenery(i).Style).Height)) * zoomFactor + scenR = Scenery(i).rotation - rDiff + Else + sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor + scenR = Scenery(i).rotation - rDiff + End If + Else + sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor + scenR = Scenery(i).rotation + End If + srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X + srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y + scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).Color + End If + Next + End If + + If sceneryCount > 0 And showScenery And sslMid Then + For i = 1 To sceneryCount + If Scenery(i).level = 1 Then + sVal = Scenery(i).Style + If Scenery(i).selected = 1 Then + If scaleDiff.X <> 1 Or scaleDiff.Y <> 1 Then + xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X + yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y + theta = GetAngle(xVal, yVal) + Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + xVal = Cos(theta) * R * scaleDiff.X + yVal = -Sin(theta) * R * scaleDiff.Y + theta = GetAngle(xVal, yVal) - Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + sc.X = SceneryTextures(sVal).reScale.X * ((Cos(theta) * R) / (SceneryTextures(Scenery(i).Style).Width)) * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * (-(Sin(theta) * R) / (SceneryTextures(Scenery(i).Style).Height)) * zoomFactor + scenR = Scenery(i).rotation - rDiff + Else + sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor + scenR = Scenery(i).rotation - rDiff + End If + Else + sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor + scenR = Scenery(i).rotation + End If + srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X + srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y + scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).Color + End If + Next + End If + + If currentFunction = TOOL_SCENERY And Not (ctrlDown Or altDown) Then + If Scenery(0).level < 2 Then + sVal = Scenery(0).Style + sc.X = SceneryTextures(sVal).reScale.X * Scenery(0).Scaling.X * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(0).Scaling.Y * zoomFactor + srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X + srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y + scenerySprite.Draw SceneryTextures(sVal).Texture, srcRect, sc, rc, Scenery(0).rotation, Scenery(0).screenTr, Scenery(0).Color + End If + End If + + scenerySprite.End + + 'Draw Polys + If showPolys And numPolys > 0 Then + If showTexture Then 'set texture + D3DDevice.setTexture 0, mapTexture + End If + + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 + D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA + D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA + D3DDevice.SetRenderState D3DRS_COLORWRITEENABLE, D3DCOLORWRITEENABLE_BLUE Or D3DCOLORWRITEENABLE_GREEN Or D3DCOLORWRITEENABLE_RED + D3DDevice.SetRenderState D3DRS_COLORWRITEENABLE, D3DCOLORWRITEENABLE_ALPHA Or D3DCOLORWRITEENABLE_BLUE Or D3DCOLORWRITEENABLE_GREEN Or D3DCOLORWRITEENABLE_RED + + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 + + If clrPolys Then + D3DDevice.SetRenderState D3DRS_SRCBLEND, polyBlendSrc + D3DDevice.SetRenderState D3DRS_DESTBLEND, polyBlendDest + End If + + For i = 1 To numPolys + If Not (vertexList(i).polyType = 24 Or vertexList(i).polyType = 25) Then + D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(i).vertex(1), Len(Polys(1).vertex(1)) + End If + Next + + D3DDevice.SetRenderState D3DRS_SRCBLEND, polyBlendSrc + D3DDevice.SetRenderState D3DRS_DESTBLEND, polyBlendDest + + ElseIf showPolys = False And numPolys > 0 Then + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 + D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ZERO + D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE + For i = 1 To numPolys + If Not (vertexList(i).polyType = 24 Or vertexList(i).polyType = 25) Then + D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(i).vertex(1), Len(Polys(1).vertex(1)) + End If + Next + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 0 + End If + + 'draw selected polys + If numSelectedPolys > 0 And showPolys And Not (currentTool = TOOL_TEXTURE Or currentTool = TOOL_VCOLOR Or currentTool = TOOL_PCOLOR) Then + D3DDevice.setTexture 0, patternTexture + D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE + D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE + + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 + For i = 1 To numSelectedPolys + objClr = PolyTypeClrs(vertexList(selectedPolys(i)).polyType) + lineCoords(1) = Polys(selectedPolys(i)).vertex(1) + lineCoords(2) = Polys(selectedPolys(i)).vertex(2) + lineCoords(3) = Polys(selectedPolys(i)).vertex(3) + + lineCoords(1).tu = Polys(selectedPolys(i)).vertex(1).X / 128 + lineCoords(1).tv = Polys(selectedPolys(i)).vertex(1).Y / 128 + lineCoords(2).tu = Polys(selectedPolys(i)).vertex(2).X / 128 + lineCoords(2).tv = Polys(selectedPolys(i)).vertex(2).Y / 128 + lineCoords(3).tu = Polys(selectedPolys(i)).vertex(3).X / 128 + lineCoords(3).tv = Polys(selectedPolys(i)).vertex(3).Y / 128 + + lineCoords(1).Color = 0 + lineCoords(2).Color = 0 + lineCoords(3).Color = 0 + + lineCoords(1).z = 1 + lineCoords(2).z = 1 + lineCoords(3).z = 1 + lineCoords(1).rhw = 1 + lineCoords(2).rhw = 1 + lineCoords(3).rhw = 1 + If vertexList(selectedPolys(i)).vertex(1) = 1 Then lineCoords(1).Color = objClr + If vertexList(selectedPolys(i)).vertex(2) = 1 Then lineCoords(2).Color = objClr + If vertexList(selectedPolys(i)).vertex(3) = 1 Then lineCoords(3).Color = objClr + + D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, lineCoords(1), Len(lineCoords(1)) + Next + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 0 + End If + + 'draw depthmap + If showPolys And currentTool = TOOL_DEPTHMAP Then + + lineCoords(1).tu = 0 + lineCoords(1).tv = 0 + lineCoords(2).tu = 0 + lineCoords(2).tv = 0 + lineCoords(3).tu = 0 + lineCoords(3).tv = 0 + lineCoords(1).z = 1 + lineCoords(2).z = 1 + lineCoords(3).z = 1 + lineCoords(1).rhw = 1 + lineCoords(2).rhw = 1 + lineCoords(3).rhw = 1 + + D3DDevice.setTexture 0, Nothing + + For i = 1 To polyCount + + lineCoords(1) = Polys(i).vertex(1) + lineCoords(2) = Polys(i).vertex(2) + lineCoords(3) = Polys(i).vertex(3) + + If Polys(i).vertex(1).z >= 0 And Polys(i).vertex(2).z >= 0 And Polys(i).vertex(3).z >= 0 Then + lineCoords(1).Color = ARGB(255, RGB(Polys(i).vertex(1).z, Polys(i).vertex(1).z, Polys(i).vertex(1).z)) + lineCoords(2).Color = ARGB(255, RGB(Polys(i).vertex(2).z, Polys(i).vertex(2).z, Polys(i).vertex(2).z)) + lineCoords(3).Color = ARGB(255, RGB(Polys(i).vertex(3).z, Polys(i).vertex(3).z, Polys(i).vertex(3).z)) + End If + + D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, lineCoords(1), Len(lineCoords(1)) + Next + + End If + + 'draw scenery + scenerySprite.Begin + If sceneryCount > 0 And showScenery And sslFront Then + For i = 1 To sceneryCount + If Scenery(i).level = 2 Then + sVal = Scenery(i).Style + If Scenery(i).selected = 1 Then + If scaleDiff.X <> 1 Or scaleDiff.Y <> 1 Then + xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X + yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y + theta = GetAngle(xVal, yVal) + Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + xVal = Cos(theta) * R * scaleDiff.X + yVal = -Sin(theta) * R * scaleDiff.Y + theta = GetAngle(xVal, yVal) - Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + sc.X = SceneryTextures(sVal).reScale.X * ((Cos(theta) * R) / (SceneryTextures(Scenery(i).Style).Width)) * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * (-(Sin(theta) * R) / (SceneryTextures(Scenery(i).Style).Height)) * zoomFactor + scenR = Scenery(i).rotation - rDiff + Else + sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor + scenR = Scenery(i).rotation - rDiff + End If + Else + sc.X = SceneryTextures(sVal).reScale.X * Scenery(i).Scaling.X * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(i).Scaling.Y * zoomFactor + scenR = Scenery(i).rotation + End If + srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X + srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y + scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).Color + End If + Next + End If + + 'draw current scenery + If currentFunction = TOOL_SCENERY And Not (ctrlDown Or altDown) Then + If Scenery(0).level = 2 Then + sVal = Scenery(0).Style + sc.X = SceneryTextures(sVal).reScale.X * Scenery(0).Scaling.X * zoomFactor + sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(0).Scaling.Y * zoomFactor + srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X + 0 + srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y + 0 + scenerySprite.Draw SceneryTextures(sVal).Texture, srcRect, sc, rc, Scenery(0).rotation, Scenery(0).screenTr, Scenery(0).Color + End If + End If + + 'draw objects + objClr = ARGB(255, RGB(255, 255, 255)) + sc.X = 32 / (objTexSize.X / 8) + sc.Y = 32 / (objTexSize.Y / 4) + rc.X = (objTexSize.X / 8) / 2 + rc.Y = (objTexSize.Y / 4) / 2 + If showObjects Then + If spawnPoints > 0 Then + For i = 1 To spawnPoints + tr.X = Int((Spawns(i).X - scrollCoords(2).X) * zoomFactor - 15 + 0.5) + tr.Y = Int((Spawns(i).Y - scrollCoords(2).Y) * zoomFactor - 15 + 0.5) + srcRect.Top = Int(Spawns(i).Team / 8) * (objTexSize.Y / 4) + srcRect.left = (Spawns(i).Team - (Int(Spawns(i).Team / 8) * 8)) * (objTexSize.X / 8) + srcRect.right = srcRect.left + (objTexSize.X / 8) + srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) + If Spawns(i).active = 1 Then + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, ARGB(255, selectionClr) + Else + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr + End If + Next + End If + If colliderCount > 0 Then + objClr = ARGB(128, RGB(255, 255, 255)) + For i = 1 To colliderCount + sc.X = Colliders(i).radius / (objTexSize.X / 8) * zoomFactor + sc.Y = Colliders(i).radius / (objTexSize.Y / 4) * zoomFactor + tr.X = Int((Colliders(i).X - scrollCoords(2).X) * zoomFactor - (objTexSize.X / 8) / 2 * sc.X + 0.5) + tr.Y = Int((Colliders(i).Y - scrollCoords(2).Y) * zoomFactor - (objTexSize.Y / 4) / 2 * sc.Y + 0.5) + If Colliders(i).active = 1 Then + srcRect.left = 0 + srcRect.Top = (objTexSize.Y / 4) * 3 + srcRect.right = srcRect.left + (objTexSize.X / 8) + srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr + Else + srcRect.left = (objTexSize.X / 8) + srcRect.Top = (objTexSize.Y / 4) * 2 + srcRect.right = srcRect.left + (objTexSize.X / 8) + srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr + End If + Next + End If + End If + + If showLights Then + objClr = ARGB(255, RGB(255, 255, 255)) + sc.X = 32 / (objTexSize.X / 8) + sc.Y = 32 / (objTexSize.Y / 4) + rc.X = (objTexSize.X / 8) / 2 + rc.Y = (objTexSize.Y / 4) / 2 + If lightCount > 0 Then + srcRect.left = (objTexSize.X / 8) * 7 + srcRect.Top = (objTexSize.Y / 4) * 2 + srcRect.right = srcRect.left + (objTexSize.X / 8) + srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) + For i = 1 To lightCount + objClr = ARGB(255, RGB(Lights(i).color.blue, Lights(i).color.green, Lights(i).color.red)) + sc.X = 32 / (objTexSize.X / 8) + sc.Y = 32 / (objTexSize.Y / 4) + tr.X = Int((Lights(i).X - scrollCoords(2).X) * zoomFactor - 16 * sc.X + 0.5) + tr.Y = Int((Lights(i).Y - scrollCoords(2).Y) * zoomFactor - 16 * sc.Y + 0.5) + If Lights(i).selected = 1 Then + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, ARGB(255, selectionClr) + Else + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr + End If + Next + End If + End If + + 'draw current object + If currentTool = TOOL_OBJECTS And Not (ctrlDown Or altDown) Then + objClr = ARGB(128, RGB(255, 255, 255)) + If mnuGostek.Checked Then 'gostek + sc.X = 32 / (objTexSize.X / 8) * zoomFactor + sc.Y = 32 / (objTexSize.Y / 4) * zoomFactor + srcRect.left = (objTexSize.X / 8) * 2 + 1 + srcRect.Top = (objTexSize.Y / 4) * 2 + srcRect.right = srcRect.left + (objTexSize.X / 8) - 2 + srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) + tr.X = mouseCoords.X - 16 * zoomFactor + tr.Y = mouseCoords.Y - 16 * zoomFactor + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr + ElseIf mnuCollider.Checked = True Then 'collider + srcRect.left = (objTexSize.X / 8) + srcRect.Top = (objTexSize.Y / 4) * 2 + srcRect.right = srcRect.left + (objTexSize.X / 8) + srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) + sc.X = Colliders(0).radius / (objTexSize.X / 8) * zoomFactor + sc.Y = Colliders(0).radius / (objTexSize.Y / 4) * zoomFactor + tr.X = Colliders(0).X - (objTexSize.X / 8) / 2 * sc.X + tr.Y = Colliders(0).Y - (objTexSize.Y / 4) / 2 * sc.Y + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr + Else 'spawn + sc.X = 32 / (objTexSize.X / 8) + sc.Y = 32 / (objTexSize.Y / 4) + tr.X = Spawns(0).X - 15 + tr.Y = Spawns(0).Y - 15 + srcRect.Top = Int(Spawns(0).Team / 8) * (objTexSize.Y / 4) + srcRect.left = (Spawns(0).Team - (Int(Spawns(0).Team / 8) * 8)) * (objTexSize.X / 8) + srcRect.right = srcRect.left + (objTexSize.X / 8) + srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr + End If + End If + + 'draw gostek + If gostek.X <> 0 Or gostek.Y <> 0 Then + sc.X = 32 / (objTexSize.X / 8) * zoomFactor + sc.Y = 32 / (objTexSize.Y / 4) * zoomFactor + srcRect.left = ((objTexSize.X / 8) * 2) + 1 + srcRect.Top = (objTexSize.Y / 4) * 2 + srcRect.right = srcRect.left + (objTexSize.X / 8) - 2 + srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) + tr.X = (gostek.X - 16 - scrollCoords(2).X) * zoomFactor + tr.Y = (gostek.Y - 16 - scrollCoords(2).Y) * zoomFactor + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, ARGB(255, RGB(128, 128, 128)) + End If + + scenerySprite.End + + D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA + D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA + D3DDevice.setTexture 0, Nothing + + 'draw grid + If showGrid Then + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True + + setGrid + + For i = 0 To (Int((Me.ScaleWidth / gridSpacing) / zoomFactor) + 1) + If inc * zoomFactor >= 8 Then + D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, gridDivisions, xGridLines(1).vertex(1), Len(xGridLines(1).vertex(1)) + D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, gridDivisions, yGridLines(1).vertex(1), Len(yGridLines(1).vertex(1)) + ElseIf gridSpacing * zoomFactor >= 8 Then + D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, 1, xGridLines(1).vertex(1), Len(xGridLines(1).vertex(1)) + D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, 1, yGridLines(1).vertex(1), Len(yGridLines(1).vertex(1)) + End If + + For j = 1 To gridDivisions + xGridLines(j).vertex(1).Y = xGridLines(j).vertex(1).Y + gridSpacing * zoomFactor + xGridLines(j).vertex(2).Y = xGridLines(j).vertex(1).Y + yGridLines(j).vertex(1).X = yGridLines(j).vertex(1).X + gridSpacing * zoomFactor + yGridLines(j).vertex(2).X = yGridLines(j).vertex(1).X + Next + Next + End If + + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False + + If clrWireframe And (showWireframe Or showPoints) Then + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1 + D3DDevice.SetRenderState D3DRS_SRCBLEND, wireBlendSrc + D3DDevice.SetRenderState D3DRS_DESTBLEND, wireBlendDest + End If + + 'draw wireframe + If showWireframe And polyCount > 0 Then + D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME + For i = 1 To polyCount + D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(i).vertex(1), Len(Polys(1).vertex(1)) + Next + D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID + End If + + 'draw scenery boxes + sc.X = 1 + sc.Y = 1 + srcRect.right = 8 + srcRect.bottom = 8 + If sceneryCount > 0 And showScenery Then + For i = 1 To sceneryCount + + sVal = Scenery(i).Style + + sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, ARGB(255, Scenery(i).Color), 0, 0) + If Scenery(i).selected = 1 Or Scenery(i).selected = 3 Then + sceneryCoords(0).Color = ARGB(255, pointClr) + End If + sceneryCoords(1) = sceneryCoords(0) + sceneryCoords(2) = sceneryCoords(0) + sceneryCoords(3) = sceneryCoords(0) + sceneryCoords(0).X = Scenery(i).screenTr.X + sceneryCoords(0).Y = Scenery(i).screenTr.Y + + If Scenery(i).selected = 1 And ctrlDown And (scaleDiff.X <> 1 Or scaleDiff.Y <> 1) Then + xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X + yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y + theta = GetAngle(xVal, yVal) + Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + xVal = Cos(theta) * R * scaleDiff.X + yVal = -Sin(theta) * R * scaleDiff.Y + theta = GetAngle(xVal, yVal) - Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + sc.X = (Cos(theta) * R) + sc.Y = -(Sin(theta) * R) + + sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(i).rotation) * sc.X * zoomFactor + sceneryCoords(1).Y = sceneryCoords(0).Y - Sin(Scenery(i).rotation) * sc.X * zoomFactor + sceneryCoords(3).X = sceneryCoords(0).X + Sin(Scenery(i).rotation) * sc.Y * zoomFactor + sceneryCoords(3).Y = sceneryCoords(0).Y + Cos(Scenery(i).rotation) * sc.Y * zoomFactor + ElseIf Scenery(i).selected = 1 And (rDiff <> 0 Or (scaleDiff.X <> 0 Or scaleDiff.Y <> 0)) Then + sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(i).rotation - rDiff) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor + sceneryCoords(1).Y = sceneryCoords(0).Y - Sin(Scenery(i).rotation - rDiff) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor + sceneryCoords(3).X = sceneryCoords(0).X + Sin(Scenery(i).rotation - rDiff) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor + sceneryCoords(3).Y = sceneryCoords(0).Y + Cos(Scenery(i).rotation - rDiff) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor + Else + sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(i).rotation) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor + sceneryCoords(1).Y = sceneryCoords(0).Y - Sin(Scenery(i).rotation) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor + sceneryCoords(3).X = sceneryCoords(0).X + Sin(Scenery(i).rotation) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor + sceneryCoords(3).Y = sceneryCoords(0).Y + Cos(Scenery(i).rotation) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor + End If + + sceneryCoords(2).X = sceneryCoords(3).X + sceneryCoords(1).X - sceneryCoords(0).X + sceneryCoords(2).Y = sceneryCoords(3).Y + sceneryCoords(1).Y - sceneryCoords(0).Y + sceneryCoords(4) = sceneryCoords(0) + + If showWireframe Or Scenery(i).selected = 1 Or Scenery(i).selected = 3 Then + D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 4, sceneryCoords(0), Len(sceneryCoords(0)) + End If + + If showPoints Or Scenery(i).selected = 1 Or Scenery(i).selected = 3 Then + If sceneryVerts Then + D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 4, sceneryCoords(0), Len(sceneryCoords(0)) + Else + D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 1, sceneryCoords(0), Len(sceneryCoords(0)) + End If + End If + + Next + If currentTool = TOOL_SCENERY And Scenery(0).Style > 0 And Not (ctrlDown Or altDown) Then + sVal = Scenery(0).Style + sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) + sceneryCoords(1) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) + sceneryCoords(2) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) + sceneryCoords(3) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) + sceneryCoords(0).X = Scenery(0).screenTr.X + sceneryCoords(0).Y = Scenery(0).screenTr.Y + sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(0).rotation) * (SceneryTextures(sVal).Width + 0) * Scenery(0).Scaling.X * zoomFactor + sceneryCoords(1).Y = sceneryCoords(0).Y - Sin(Scenery(0).rotation) * (SceneryTextures(sVal).Width + 0) * Scenery(0).Scaling.X * zoomFactor + sceneryCoords(3).X = sceneryCoords(0).X + Sin(Scenery(0).rotation) * (SceneryTextures(sVal).Height + 0) * Scenery(0).Scaling.Y * zoomFactor + sceneryCoords(3).Y = sceneryCoords(0).Y + Cos(Scenery(0).rotation) * (SceneryTextures(sVal).Height + 0) * Scenery(0).Scaling.Y * zoomFactor + sceneryCoords(2).X = sceneryCoords(3).X + sceneryCoords(1).X - sceneryCoords(0).X + sceneryCoords(2).Y = sceneryCoords(3).Y + sceneryCoords(1).Y - sceneryCoords(0).Y + sceneryCoords(4) = sceneryCoords(0) + + D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 4, sceneryCoords(0), Len(sceneryCoords(0)) + + End If + End If + + If numVerts > 0 And currentTool = TOOL_CREATE Then + D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME + D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Polys(polyCount + 1).vertex(1), Len(Polys(polyCount + 1).vertex(1)) + D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID + End If + + D3DDevice.setTexture 0, particleTexture + + 'draw points + If showPoints And numPolys > 0 Then + D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_POINT + + For i = 1 To numPolys + lineCoords(1) = Polys(i).vertex(1) + lineCoords(2) = Polys(i).vertex(2) + lineCoords(3) = Polys(i).vertex(3) + + lineCoords(1).z = 1 + lineCoords(2).z = 1 + lineCoords(3).z = 1 + lineCoords(1).rhw = 1 + lineCoords(2).rhw = 1 + lineCoords(3).rhw = 1 + + D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 3, lineCoords(1), Len(lineCoords(1)) + Next + + D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID + End If + + If showPoints And showObjects And colliderCount > 0 Then + sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) + For i = 1 To colliderCount + sceneryCoords(0).X = (Colliders(i).X - scrollCoords(2).X) * zoomFactor + sceneryCoords(0).Y = (Colliders(i).Y - scrollCoords(2).Y) * zoomFactor + If Colliders(i).active = 1 Then + sceneryCoords(0).Color = selectionClr + Else + sceneryCoords(0).Color = ARGB(255, RGB(255, 255, 255)) + End If + D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 1, sceneryCoords(0), Len(sceneryCoords(0)) + Next + End If + + 'draw selected poly wireframes + D3DDevice.setTexture 0, Nothing + If numSelectedPolys > 0 Then + D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME + For i = 1 To numSelectedPolys + lineCoords(1) = Polys(selectedPolys(i)).vertex(1) + lineCoords(2) = Polys(selectedPolys(i)).vertex(2) + lineCoords(3) = Polys(selectedPolys(i)).vertex(3) + + lineCoords(1).z = 1: lineCoords(1).rhw = 1 + lineCoords(2).z = 1: lineCoords(2).rhw = 1 + lineCoords(3).z = 1: lineCoords(3).rhw = 1 + + If vertexList(selectedPolys(i)).vertex(1) = 1 Or vertexList(selectedPolys(i)).vertex(1) = 3 Then + lineCoords(1).Color = pointClr + End If + If vertexList(selectedPolys(i)).vertex(2) = 1 Or vertexList(selectedPolys(i)).vertex(2) = 3 Then + lineCoords(2).Color = pointClr + End If + If vertexList(selectedPolys(i)).vertex(3) = 1 Or vertexList(selectedPolys(i)).vertex(3) = 3 Then + lineCoords(3).Color = pointClr + End If + + D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, lineCoords(1), Len(lineCoords(1)) + + If showPoints Then + If vertexList(selectedPolys(i)).vertex(1) = 1 Then lineCoords(1).Color = pointClr + If vertexList(selectedPolys(i)).vertex(2) = 1 Then lineCoords(2).Color = pointClr + If vertexList(selectedPolys(i)).vertex(3) = 1 Then lineCoords(3).Color = pointClr + D3DDevice.setTexture 0, particleTexture + D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 3, lineCoords(1), Len(lineCoords(1)) + D3DDevice.setTexture 0, Nothing + End If + Next + D3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID + End If + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 0 + + 'draw selection rect + If currentTool = TOOL_MOVE And (numSelectedPolys > 0 Or numSelectedScenery > 0) And noneSelected = False Then + + objClr = &H80FFFFFF + + D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA + D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True + + D3DDevice.setTexture 0, lineTexture + + sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, objClr, 0, 0) + sceneryCoords(1) = CreateCustomVertex(0, 0, 1, 1, objClr, 0, 0) + sceneryCoords(2) = CreateCustomVertex(0, 0, 1, 1, objClr, 0, 0) + sceneryCoords(3) = CreateCustomVertex(0, 0, 1, 1, objClr, 0, 0) + + If rDiff <> 0 Then + For i = 0 To 3 + xVal = (selRect(i).X - rCenter.X) + yVal = (selRect(i).Y - rCenter.Y) + R = Sqr(xVal ^ 2 + yVal ^ 2) + theta = GetAngle(xVal, yVal) - rDiff + sceneryCoords(i).X = (rCenter.X + R * Cos(theta) - scrollCoords(2).X) * zoomFactor + sceneryCoords(i).Y = (rCenter.Y + R * -Sin(theta) - scrollCoords(2).Y) * zoomFactor + Next + ElseIf scaleDiff.X <> 1 Or scaleDiff.Y <> 1 Then + For i = 0 To 3 + sceneryCoords(i).X = (rCenter.X + ((selRect(i).X - rCenter.X) * scaleDiff.X) - scrollCoords(2).X) * zoomFactor + sceneryCoords(i).Y = (rCenter.Y + ((selRect(i).Y - rCenter.Y) * scaleDiff.Y) - scrollCoords(2).Y) * zoomFactor + Next + Else + For i = 0 To 3 + sceneryCoords(i).X = (selRect(i).X - scrollCoords(2).X) * zoomFactor + sceneryCoords(i).Y = (selRect(i).Y - scrollCoords(2).Y) * zoomFactor + Next + End If + + sceneryCoords(0).tu = 0 + sceneryCoords(0).tv = 0 + sceneryCoords(1).tu = Sqr((sceneryCoords(1).X - sceneryCoords(0).X) ^ 2 + (sceneryCoords(1).Y - sceneryCoords(0).Y) ^ 2) / 64 + sceneryCoords(1).tv = 0 + sceneryCoords(2).tu = sceneryCoords(1).tu + sceneryCoords(2).tv = Sqr((sceneryCoords(2).X - sceneryCoords(1).X) ^ 2 + (sceneryCoords(2).Y - sceneryCoords(1).Y) ^ 2) / 64 + sceneryCoords(3).tu = 0 + sceneryCoords(3).tv = sceneryCoords(2).tv + + sceneryCoords(4) = sceneryCoords(0) + + D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 4, sceneryCoords(0), Len(sceneryCoords(0)) + D3DDevice.setTexture 0, Nothing + D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 4, sceneryCoords(0), Len(sceneryCoords(0)) + + For i = 0 To 3 + sceneryCoords(i).X = Midpoint(sceneryCoords(i).X, sceneryCoords(i + 1).X) + sceneryCoords(i).Y = Midpoint(sceneryCoords(i).Y, sceneryCoords(i + 1).Y) + Next + D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 4, sceneryCoords(0), Len(sceneryCoords(0)) + + If Not mnuFixedRCenter.Checked Then + sceneryCoords(0).X = (rCenter.X - scrollCoords(2).X) * zoomFactor + sceneryCoords(0).Y = (rCenter.Y - scrollCoords(2).Y) * zoomFactor + D3DDevice.setTexture 0, rCenterTexture + D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 1, sceneryCoords(0), Len(sceneryCoords(0)) + End If + + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False + + End If + + If showWaypoints Then + objClr = &HFFFFFFFF + For i = 1 To waypointCount + If (Waypoints(i).pathNum = 1 And frmWaypoints.showPaths <> 2) Or (Waypoints(i).pathNum = 2 And frmWaypoints.showPaths <> 1) Then + If Waypoints(i).selected = True Then + If Waypoints(i).pathNum = 1 Then + srcRect.left = (objTexSize.X / 8) * 5 + Else + srcRect.left = (objTexSize.X / 8) * 6 + End If + Else + If Waypoints(i).pathNum = 1 Then + srcRect.left = (objTexSize.X / 8) * 3 + Else + srcRect.left = (objTexSize.X / 8) * 4 + End If + End If + sc.X = 32 / (objTexSize.X / 8) + sc.Y = 32 / (objTexSize.Y / 4) + srcRect.Top = (objTexSize.Y / 4) * 2 + srcRect.right = srcRect.left + (objTexSize.X / 8) + srcRect.bottom = srcRect.Top + (objTexSize.Y / 4) + tr.X = Int((Waypoints(i).X - scrollCoords(2).X) * zoomFactor - 15 + 0.5) + tr.Y = Int((Waypoints(i).Y - scrollCoords(2).Y) * zoomFactor - 15 + 0.5) + scenerySprite.Draw objectsTexture, srcRect, sc, rc, 0, tr, objClr + End If + Next + + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True + D3DDevice.setTexture 0, pathTexture + For i = 1 To conCount + If (Waypoints(Connections(i).point1).pathNum = 1 And frmWaypoints.showPaths <> 2) Or (Waypoints(Connections(i).point1).pathNum = 2 And frmWaypoints.showPaths <> 1) _ + Or (Waypoints(Connections(i).point2).pathNum = 1 And frmWaypoints.showPaths <> 2) Or (Waypoints(Connections(i).point2).pathNum = 2 And frmWaypoints.showPaths <> 1) Then + lineCoords(1).X = (Waypoints(Connections(i).point1).X - scrollCoords(2).X) * zoomFactor + lineCoords(1).Y = (Waypoints(Connections(i).point1).Y - scrollCoords(2).Y) * zoomFactor + lineCoords(2).X = (Waypoints(Connections(i).point2).X - scrollCoords(2).X) * zoomFactor + lineCoords(2).Y = (Waypoints(Connections(i).point2).Y - scrollCoords(2).Y) * zoomFactor + If Waypoints(Connections(i).point2).wayType(2) Then + lineCoords(1).Color = &HFFFFFF22 + lineCoords(2).Color = &HFFFFFF22 + ElseIf Waypoints(Connections(i).point2).wayType(3) Then + lineCoords(1).Color = &HFF22FFFF + lineCoords(2).Color = &HFF22FFFF + ElseIf Waypoints(Connections(i).point2).wayType(0) Then + lineCoords(1).Color = &HFF22FF22 + lineCoords(2).Color = &HFF22FF22 + ElseIf Waypoints(Connections(i).point2).wayType(1) Then + lineCoords(1).Color = &HFFFF2222 + lineCoords(2).Color = &HFFFF2222 + ElseIf Waypoints(Connections(i).point2).wayType(4) Then + lineCoords(1).Color = &HFFFFFFFF + lineCoords(2).Color = &HFFFFFFFF + Else + lineCoords(1).Color = &HFF000000 + lineCoords(2).Color = &HFF000000 + End If + lineCoords(1).tu = 0 + lineCoords(1).tv = 0 + lineCoords(2).tu = 1 + lineCoords(2).tv = 0 + + D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 1, lineCoords(1), Len(lineCoords(1)) + End If + Next + + If currentWaypoint > 0 Then + lineCoords(1).X = (Waypoints(currentWaypoint).X - scrollCoords(2).X) * zoomFactor + lineCoords(1).Y = (Waypoints(currentWaypoint).Y - scrollCoords(2).Y) * zoomFactor + lineCoords(2).X = mouseCoords.X + lineCoords(2).Y = mouseCoords.Y + If mnuWayType(2).Checked Then + lineCoords(1).Color = &HFFFFFF22 + lineCoords(2).Color = &HFFFFFF22 + ElseIf mnuWayType(3).Checked Then + lineCoords(1).Color = &HFF22FFFF + lineCoords(2).Color = &HFF22FFFF + ElseIf mnuWayType(0).Checked Then + lineCoords(1).Color = &HFF22FF22 + lineCoords(2).Color = &HFF22FF22 + ElseIf mnuWayType(1).Checked Then + lineCoords(1).Color = &HFFFF2222 + lineCoords(2).Color = &HFFFF2222 + ElseIf mnuWayType(4).Checked Then + lineCoords(1).Color = &HFFFFFFFF + lineCoords(2).Color = &HFFFFFFFF + Else + lineCoords(1).Color = &HFF000000 + lineCoords(2).Color = &HFF000000 + End If + lineCoords(1).tu = 0 + lineCoords(1).tv = 0 + lineCoords(2).tu = 1 + lineCoords(2).tv = 0 + + D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 1, lineCoords(1), Len(lineCoords(1)) + End If + + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False + End If + + If showSketch Then + D3DDevice.SetVertexShader FVF2 + D3DDevice.setTexture 0, sketchTexture + If sketchLines > 0 Then + D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, sketchLines, sketch(1).vertex(1), Len(sketch(1).vertex(1)) + End If + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False + If currentFunction = TOOL_SKETCH And shiftDown Then + D3DDevice.DrawPrimitiveUP D3DPT_LINELIST, 1, sketch(0).vertex(1), Len(sketch(0).vertex(1)) + End If + D3DDevice.SetVertexShader FVF + End If + + D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_INVDESTCOLOR + D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True + + 'draw circle + If circleOn Then + For i = 0 To 32 + circleCoords(i).Color = ARGB(255, RGB(255, 255, 255)) + circleCoords(i).X = mouseCoords.X + zoomFactor * clrRadius * Math.Cos(pi * i / 16) + circleCoords(i).Y = mouseCoords.Y + zoomFactor * clrRadius * Math.Sin(pi * i / 16) + Next + D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 32, circleCoords(0), Len(circleCoords(0)) + End If + + 'vertex selection -------- + If currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB Then + If toolAction Then + circleCoords(0).Color = ARGB(255, RGB(255, 255, 255)) + circleCoords(1).Color = ARGB(255, RGB(255, 255, 255)) + circleCoords(2).Color = ARGB(255, RGB(255, 255, 255)) + circleCoords(3).Color = ARGB(255, RGB(255, 255, 255)) + circleCoords(4).Color = ARGB(255, RGB(255, 255, 255)) + circleCoords(0).X = selectedCoords(1).X + circleCoords(1).X = mouseCoords.X + circleCoords(2).X = mouseCoords.X + circleCoords(3).X = selectedCoords(1).X + circleCoords(4).X = selectedCoords(1).X + circleCoords(0).Y = selectedCoords(1).Y + circleCoords(1).Y = selectedCoords(1).Y + circleCoords(2).Y = mouseCoords.Y + circleCoords(3).Y = mouseCoords.Y + circleCoords(4).Y = selectedCoords(1).Y + D3DDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 4, circleCoords(0), Len(circleCoords(0)) + End If + End If + + D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False + + + D3DDevice.EndScene + + D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0 + + eraseCircle = False + + Exit Sub + +ErrorHandler: + + MsgBox "Error Rendering with Direct3D" & vbNewLine & D3DX.GetErrorString(err.Number) + +End Sub + +Private Function getRGB(DecValue As Long) As TColor + + Dim hexValue As String + + hexValue = Hex$(Val(DecValue)) + + If Len(hexValue) < 6 Then + hexValue = String$(6 - Len(hexValue), "0") + hexValue + End If + + getRGB.blue = CLng("&H" + right$(hexValue, 2)) + hexValue = left$(hexValue, Len(hexValue) - 2) + getRGB.green = CLng("&H" + right$(hexValue, 2)) + hexValue = left$(hexValue, Len(hexValue) - 2) + getRGB.red = CLng("&H" + right$(hexValue, 2)) + +End Function + +Private Function getAlpha(tehColor As Long) As Byte + + Dim hexValue As String + + hexValue = Hex$(Val(tehColor)) + + If Len(hexValue) <= 6 Then + getAlpha = 0 + Else + If Len(hexValue) < 8 Then + hexValue = String$(8 - Len(hexValue), "0") + hexValue + End If + getAlpha = CLng("&H" + left$(hexValue, 2)) + End If + +End Function + +Private Function ARGB(ByVal alphaVal As Byte, clrVal As Long) As Long + + Dim clrString As String + + clrString = Hex$(clrVal) + If Len(clrString) < 6 Then + clrString = String$(6 - Len(clrString), "0") & clrString + ElseIf Len(clrString) > 6 Then + clrString = right$(clrString, 6) + End If + If Len(Hex$(alphaVal)) = 1 Then + clrString = "0" + Hex$(alphaVal) & clrString + ElseIf Len(Hex$(alphaVal)) = 2 Then + clrString = Hex$(alphaVal) & clrString + End If + ARGB = CLng("&H" & clrString) + +End Function + +Private Function makeColor(red As Byte, green As Byte, blue As Byte) As TColor + + makeColor.red = red + makeColor.green = green + makeColor.blue = blue + +End Function + +Function FtoDW(f As Single) As Long + + Dim buf As D3DXBuffer + Dim l As Long + Set buf = D3DX.CreateBuffer(4) + D3DX.BufferSetData buf, 0, 4, 1, f + D3DX.BufferGetData buf, 0, 4, 1, l + FtoDW = l + +End Function + +Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) + + Dim i As Long + Dim hotKeyPressed As Integer, wayptKeyPressed As Integer, layerKeyPressed As Integer + Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA + Static tempFunction As Byte + + On Error GoTo ErrorHandler + + If DIDevice Is Nothing Then Exit Sub + + If eventid = hEvent Then + + DIDevice.GetDeviceStateKeyboard DIState + DIDevice.GetDeviceData pBuffer, DIGDD_DEFAULT + + If tvwScenery.Visible = True Then Exit Sub + + If Screen.ActiveForm.hWnd <> Me.hWnd Or Me.ActiveControl = txtZoom Then Exit Sub + + If DIState.Key(DIK_SPACE) = 128 And Not spaceDown Then + circleOn = False + spaceDown = True + scrollCoords(1).X = mouseCoords.X + scrollCoords(1).Y = mouseCoords.Y + SetCursor TOOL_HAND + 1 + Exit Sub + ElseIf (DIState.Key(DIK_LSHIFT) = 128 Or DIState.Key(DIK_RSHIFT) = 128) And Not shiftDown Then + circleOn = False + shiftDown = True + Select Case currentTool + Case Is = TOOL_VSELECT 'add verts + currentFunction = TOOL_VSELADD + Case Is = TOOL_PSELECT 'add polys + currentFunction = TOOL_PSELADD + Case Is = TOOL_WAYPOINT + currentFunction = TOOL_CONNECT + Case Is = TOOL_CLRPICKER + currentFunction = TOOL_PIXPICKER + Case Is = TOOL_SKETCH + sketch(0).vertex(1).X = mouseCoords.X / zoomFactor + scrollCoords(2).X + sketch(0).vertex(1).Y = mouseCoords.Y / zoomFactor + scrollCoords(2).Y + End Select + SetCursor currentFunction + 1 + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + Exit Sub + ElseIf (DIState.Key(DIK_LCONTROL) = 128 Or DIState.Key(DIK_RCONTROL) = 128) And Not ctrlDown Then + circleOn = False + ctrlDown = True + Select Case currentTool + Case Is = TOOL_MOVE + currentFunction = TOOL_SCALE + If altDown Then + ApplyTransform True + End If + toolAction = False + Case Is = TOOL_SKETCH + currentFunction = TOOL_SMUDGE + circleOn = True + Case Is > TOOL_MOVE + currentFunction = TOOL_MOVE + If currentTool <> TOOL_CREATE Then + toolAction = False + End If + End Select + Render + SetCursor currentFunction + 1 + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + Exit Sub + ElseIf (DIState.Key(DIK_LALT) = 128 Or DIState.Key(DIK_RALT) = 128) And Not altDown Then + circleOn = False + altDown = True + Select Case currentTool + Case Is = TOOL_MOVE + currentFunction = TOOL_ROTATE + If toolAction Then + If ctrlDown Then + ApplyTransform False + End If + toolAction = False + End If + Case Is = TOOL_VSELECT 'subtract verts + currentFunction = TOOL_VSELSUB + Case Is = TOOL_PSELECT 'subtract polys + currentFunction = TOOL_PSELSUB + Case Is = TOOL_VCOLOR 'color picker + currentFunction = TOOL_CLRPICKER + Case Is = TOOL_PCOLOR 'color picker + currentFunction = TOOL_CLRPICKER + Case Is = TOOL_DEPTHMAP + currentFunction = TOOL_CLRPICKER + Case Is = TOOL_CLRPICKER + currentFunction = TOOL_LITPICKER + Case Is = TOOL_SKETCH + currentFunction = TOOL_ERASER + circleOn = True + Case Else + currentFunction = TOOL_VSELECT + End Select + If currentFunction = TOOL_TEXTURE Then toolAction = False + If currentFunction = TOOL_VCOLOR Or currentFunction = TOOL_DEPTHMAP Then circleOn = True + Render + SetCursor currentFunction + 1 + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + Exit Sub + End If + + hotKeyPressed = -1 + For i = 0 To 13 + If (DIState.Key(frmTools.getHotKey(i))) Then hotKeyPressed = i + Next + wayptKeyPressed = -1 + For i = 0 To 4 + If (DIState.Key(frmWaypoints.getWayptKey(i))) Then wayptKeyPressed = i + Next + layerKeyPressed = -1 + For i = 0 To 7 + If (DIState.Key(frmDisplay.getLayerKey(i))) Then layerKeyPressed = i + Next + + 'key up -------- + If (pBuffer(0).lData = 0) Then + + If ((pBuffer(0).lOfs = DIK_RSHIFT Or pBuffer(0).lOfs = DIK_LSHIFT) And shiftDown) Then + shiftDown = False + currentFunction = currentTool + If currentFunction = TOOL_SKETCH Then + toolAction = False + Render + ElseIf currentFunction = TOOL_MOVE Then + If altDown Then + currentFunction = TOOL_ROTATE + ElseIf ctrlDown Then + currentFunction = TOOL_SCALE + End If + End If + ElseIf ((pBuffer(0).lOfs = DIK_RCONTROL Or pBuffer(0).lOfs = DIK_LCONTROL) And ctrlDown) Then + ctrlDown = False + If currentTool = TOOL_VSELECT Then + toolAction = False + ElseIf currentTool = TOOL_MOVE Then + ApplyTransform False + ElseIf currentTool = TOOL_SCENERY Then + Scenery(0).screenTr.X = mouseCoords.X + Scenery(0).screenTr.Y = mouseCoords.Y + Scenery(0).Translation.X = mouseCoords.X + Scenery(0).Translation.Y = mouseCoords.Y + ElseIf currentTool = TOOL_OBJECTS Then + Spawns(0).X = mouseCoords.X + Spawns(0).Y = mouseCoords.Y + ElseIf currentTool = TOOL_DEPTHMAP Then + circleOn = True + ElseIf currentTool = TOOL_VCOLOR Then + circleOn = True + ElseIf currentTool = TOOL_SKETCH Then + circleOn = False + End If + Render + currentFunction = currentTool + ElseIf ((pBuffer(0).lOfs = DIK_RALT Or pBuffer(0).lOfs = DIK_LALT) And altDown) Then + altDown = False + If currentTool = TOOL_MOVE Then + ApplyTransform True + ElseIf currentTool = TOOL_SCENERY Then + Scenery(0).screenTr.X = mouseCoords.X + Scenery(0).screenTr.Y = mouseCoords.Y + Scenery(0).Translation.X = mouseCoords.X + Scenery(0).Translation.Y = mouseCoords.Y + ElseIf currentTool = TOOL_OBJECTS Then + Spawns(0).X = mouseCoords.X + Spawns(0).Y = mouseCoords.Y + ElseIf currentTool = TOOL_DEPTHMAP Then + circleOn = True + ElseIf currentTool = TOOL_VCOLOR Then + circleOn = True + ElseIf currentTool = TOOL_SKETCH Then + circleOn = False + End If + Render + currentFunction = currentTool + ElseIf (pBuffer(0).lOfs = DIK_SPACE And spaceDown) Then 'scrolling + spaceDown = False + End If + + SetCursor currentFunction + 1 + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + + End If + + If ctrlDown Then 'shortcut + + If DIState.Key(DIK_EQUALS) = 128 Then 'ctrl++ + Zoom getZoomDir(2) '2 + ElseIf DIState.Key(DIK_MINUS) = 128 Then 'ctrl+- + Zoom getZoomDir(0.5) '0.5 + ElseIf DIState.Key(DIK_0) = 128 Then 'ctrl+0 + zoomFactor = 1 + scrollCoords(2).X = -ScaleWidth / 2 + scrollCoords(2).Y = -ScaleHeight / 2 + Zoom 1 + ElseIf DIState.Key(MapVirtualKey(78, 0)) = 128 Then 'ctrl+n + mnuNew_Click + ElseIf DIState.Key(MapVirtualKey(79, 0)) = 128 Then 'ctrl+o + mnuOpen_Click + ElseIf DIState.Key(MapVirtualKey(83, 0)) = 128 And shiftDown Then 'ctrl+shift+s + mnuSaveAs_Click + ElseIf DIState.Key(MapVirtualKey(83, 0)) = 128 Then 'ctrl+s + mnuSave_Click + ElseIf DIState.Key(MapVirtualKey(69, 0)) = 128 Then 'ctrl+e + mnuCreate_Click + ElseIf DIState.Key(MapVirtualKey(86, 0)) = 128 Then 'ctrl+v + mnuPaste_Click + ElseIf DIState.Key(MapVirtualKey(67, 0)) = 128 Then 'ctrl+c + mnuCopy_Click + ElseIf DIState.Key(MapVirtualKey(90, 0)) = 128 Then 'ctrl+z + loadUndo False + ElseIf DIState.Key(MapVirtualKey(89, 0)) = 128 Then 'ctrl+y + loadUndo True + ElseIf DIState.Key(MapVirtualKey(65, 0)) = 128 Then 'ctrl+a + mnuSelectAll_Click + ElseIf DIState.Key(MapVirtualKey(68, 0)) = 128 Then 'ctrl+d + mnuDuplicate_Click + ElseIf DIState.Key(MapVirtualKey(73, 0)) = 128 Then 'ctrl+i + mnuInvertSel_Click + ElseIf DIState.Key(MapVirtualKey(66, 0)) = 128 Then 'ctrl+b + mnuSelColor_Click + ElseIf DIState.Key(MapVirtualKey(74, 0)) = 128 Then 'ctrl+j + mnuJoinVertices_Click + ElseIf DIState.Key(MapVirtualKey(85, 0)) = 128 Then 'ctrl+u + mnuUntexture_Click + ElseIf DIState.Key(MapVirtualKey(70, 0)) = 128 Then 'ctrl+f + mnuFixTexture_Click + ElseIf DIState.Key(MapVirtualKey(76, 0)) = 128 Then 'ctrl+l + mnuSplit_Click + ElseIf DIState.Key(MapVirtualKey(77, 0)) = 128 Then 'ctrl+m + mnuMap_Click + ElseIf DIState.Key(MapVirtualKey(80, 0)) = 128 Then 'ctrl+p + mnuPreferences_Click + ElseIf DIState.Key(MapVirtualKey(71, 0)) = 128 Then 'ctrl+g + AverageVertices + ElseIf DIState.Key(DIK_APOSTROPHE) = 128 Then 'ctrl+' + mnuGrid_Click + ElseIf DIState.Key(MapVirtualKey(84, 0)) = 128 Then 'ctrl+t + AutoTexture + End If + + Else + + If hotKeyPressed > -1 And Not (shiftDown Or ctrlDown Or altDown) Then 'hotkey + setCurrentTool hotKeyPressed + frmTools.picTools_MouseDown hotKeyPressed, 1, 0, 1, 1 + ElseIf wayptKeyPressed > -1 And Not (shiftDown Or ctrlDown Or altDown) Then 'waypoint key + frmWaypoints.picType_MouseUp wayptKeyPressed, 1, 0, 0, 0 + ElseIf layerKeyPressed > -1 And Not (shiftDown Or ctrlDown Or altDown) Then 'layer key + frmDisplay.picLayer_MouseUp layerKeyPressed, 1, 0, 0, 0 + ElseIf DIState.Key(DIK_NUMPADPLUS) = 128 Then '+ + Zoom getZoomDir(2) + ElseIf DIState.Key(DIK_NUMPADMINUS) = 128 Then '- + Zoom getZoomDir(0.5) + ElseIf DIState.Key(DIK_NUMPADSTAR) = 128 Then '* + Zoom 1 / zoomFactor + ElseIf DIState.Key(DIK_DELETE) = 128 Then 'delete + deletePolys + ElseIf DIState.Key(DIK_TAB) = 128 Then 'tab + TabPressed + ElseIf (DIState.Key(DIK_ESCAPE) = 128) Then 'esc + If numVerts > 0 Or numCorners > 0 Or currentWaypoint > 0 Then + numVerts = 0 + numCorners = 0 + currentWaypoint = 0 + toolAction = False + Render + Else + mnuDeselect_Click + End If + ElseIf (DIState.Key(DIK_BACKSPACE) = 128) Then 'backspace + mnuSever_Click + ElseIf (DIState.Key(DIK_INSERT) = 128 And shiftDown) Then 'shift+insert + mnuDuplicate_Click + ElseIf (DIState.Key(DIK_HOME) = 128) Then 'Home + mnuBringToFront_Click + ElseIf (DIState.Key(DIK_END) = 128) Then 'End + mnuSendToBack_Click + ElseIf (DIState.Key(DIK_PGUP) = 128) Then 'Page Up + mnuBringForward_Click + ElseIf (DIState.Key(DIK_PGDN) = 128) Then 'Page Down + mnuSendBackward_Click + ElseIf (DIState.Key(DIK_F1) = 128) Then 'F1 + RunHelp + ElseIf (DIState.Key(DIK_F5) = 128) Then 'F5 + mnuRefreshBG_Click + ElseIf (DIState.Key(DIK_F8) = 128) Then 'F8 + mnuRunSoldat_Click + ElseIf (DIState.Key(DIK_F9) = 128) Then 'F9 + mnuCompileAs_Click + ElseIf (DIState.Key(DIK_F4) = 128 And altDown) Then 'alt+F4 + mnuExit_Click + ElseIf (DIState.Key(DIK_LBRACKET) = 128) Then '[ + If currentTool = 0 Then + setCurrentTool TOOL_DEPTHMAP + Else + setCurrentTool currentTool - 1 + End If + frmTools.picTools_MouseDown CInt(currentTool), 1, 0, 1, 1 + ElseIf (DIState.Key(DIK_RBRACKET) = 128) Then '] + If currentTool = TOOL_DEPTHMAP Then + setCurrentTool TOOL_MOVE + Else + setCurrentTool currentTool + 1 + End If + frmTools.picTools_MouseDown CInt(currentTool), 1, 0, 1, 1 + ElseIf (DIState.Key(DIK_LEFT) = 128 Or DIState.Key(DIK_UP) = 128 Or DIState.Key(DIK_RIGHT) = 128 Or DIState.Key(DIK_DOWN) = 128) Then 'arrow keys + Dim n As Single + moveCoords(1).X = 0 + moveCoords(1).Y = 0 + If shiftDown Then + n = gridSpacing / gridDivisions * zoomFactor + Else + n = zoomFactor + End If + If currentTool = TOOL_TEXTURE And numSelectedPolys > 0 Then + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + If DIState.Key(DIK_LEFT) = 128 Then 'left + StretchingTexture -n, 0 + ElseIf DIState.Key(DIK_UP) = 128 Then 'up + StretchingTexture 0, -n + ElseIf DIState.Key(DIK_RIGHT) = 128 Then 'right + StretchingTexture n, 0 + ElseIf DIState.Key(DIK_DOWN) = 128 Then 'down + StretchingTexture 0, n + End If + SaveUndo + Else + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + If DIState.Key(DIK_LEFT) = 128 Then 'left + Moving -n, 0 + ElseIf DIState.Key(DIK_UP) = 128 Then 'up + Moving 0, -n + ElseIf DIState.Key(DIK_RIGHT) = 128 Then 'right + Moving n, 0 + ElseIf DIState.Key(DIK_DOWN) = 128 Then 'down + Moving 0, n + End If + SaveUndo + End If + End If + + End If + + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + + End If + + Exit Sub + +ErrorHandler: + + If err.Number = DIERR_INPUTLOST Then + acquired = False + ElseIf err.Number = DIERR_NOTACQUIRED Then + Else + MsgBox "DirectInput error" & vbNewLine & D3DX.GetErrorString(err.Number) + End If + +End Sub + +Private Sub TabPressed() + + Dim scenNum As Integer + Dim tempSel As Byte + Dim i As Integer + + If numSelectedPolys = 1 And numSelectedScenery = 0 Then + + If vertexList(selectedPolys(1)).vertex(1) + vertexList(selectedPolys(1)).vertex(2) + vertexList(selectedPolys(1)).vertex(3) = 3 Then + vertexList(selectedPolys(1)).vertex(1) = 0 + vertexList(selectedPolys(1)).vertex(2) = 0 + vertexList(selectedPolys(1)).vertex(3) = 0 + If Not shiftDown Then + If selectedPolys(1) = polyCount Then + selectedPolys(1) = 1 + Else + selectedPolys(1) = selectedPolys(1) + 1 + End If + Else + Beep + If selectedPolys(1) = 1 Then + selectedPolys(1) = polyCount + Else + selectedPolys(1) = selectedPolys(1) - 1 + End If + End If + vertexList(selectedPolys(1)).vertex(1) = 1 + vertexList(selectedPolys(1)).vertex(2) = 1 + vertexList(selectedPolys(1)).vertex(3) = 1 + Else + tempSel = vertexList(selectedPolys(1)).vertex(1) + vertexList(selectedPolys(1)).vertex(1) = vertexList(selectedPolys(1)).vertex(2) + vertexList(selectedPolys(1)).vertex(2) = vertexList(selectedPolys(1)).vertex(3) + vertexList(selectedPolys(1)).vertex(3) = tempSel + End If + + Render + + ElseIf numSelectedScenery = 1 And numSelectedPolys = 0 Then + + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + scenNum = i + End If + Next + Scenery(scenNum).selected = 0 + If Not shiftDown Then + If scenNum = sceneryCount Then + Scenery(1).selected = 1 + Else + Scenery(scenNum + 1).selected = 1 + End If + Else + If scenNum = 1 Then + Scenery(sceneryCount).selected = 1 + Else + Scenery(scenNum - 1).selected = 1 + End If + End If + + Render + + End If + + getInfo + +End Sub + +Private Sub findDragPoint(X As Single, Y As Single) + + Dim i As Integer, j As Integer, k As Integer + Dim midCoords As D3DVECTOR2 + + 'check if user moused down on corner drag point of sel rect + For i = 0 To 3 + j = i + 2 + If j > 3 Then + j = i - 2 + End If + If nearCoord((selRect(i).X - scrollCoords(2).X) * zoomFactor, moveCoords(1).X, 8) And _ + nearCoord((selRect(i).Y - scrollCoords(2).Y) * zoomFactor, moveCoords(1).Y, 8) Then + If mnuFixedRCenter.Checked Then + rCenter.X = selRect(j).X + rCenter.Y = selRect(j).Y + End If + moveCoords(1).X = (selRect(i).X - scrollCoords(2).X) * zoomFactor + moveCoords(1).Y = (selRect(i).Y - scrollCoords(2).Y) * zoomFactor + X = moveCoords(1).X + Y = moveCoords(1).Y + toolAction = True + End If + Next + + If toolAction = False Then + For i = 0 To 3 + j = i + 2 + If j > 3 Then + j = i - 2 + End If + k = i + 1 + If k > 3 Then + k = 0 + End If + midCoords.X = Midpoint(selRect(i).X, selRect(k).X) + midCoords.Y = Midpoint(selRect(i).Y, selRect(k).Y) + k = i - 1 + If k < 0 Then + k = 3 + End If + If nearCoord((midCoords.X - scrollCoords(2).X) * zoomFactor, moveCoords(1).X, 8) And _ + nearCoord((midCoords.Y - scrollCoords(2).Y) * zoomFactor, moveCoords(1).Y, 8) Then + If mnuFixedRCenter.Checked Then + rCenter.X = Midpoint(selRect(j).X, selRect(k).X) + rCenter.Y = Midpoint(selRect(j).Y, selRect(k).Y) + End If + moveCoords(1).X = (midCoords.X - scrollCoords(2).X) * zoomFactor + moveCoords(1).Y = (midCoords.Y - scrollCoords(2).Y) * zoomFactor + X = moveCoords(1).X + Y = moveCoords(1).Y + toolAction = True + End If + Next + Render + End If + + +End Sub + +Private Sub findDragPoint2(X As Single, Y As Single) + + Dim i As Integer, j As Integer, k As Integer + Dim midCoords As D3DVECTOR2 + + toolAction = checkDragPoint(selRect(0).X, selRect(0).Y, selRect(2).X, selRect(2).Y) + If Not toolAction Then toolAction = checkDragPoint(selRect(1).X, selRect(1).Y, selRect(3).X, selRect(3).Y) + If Not toolAction Then toolAction = checkDragPoint(selRect(2).X, selRect(2).Y, selRect(0).X, selRect(0).Y) + If Not toolAction Then toolAction = checkDragPoint(selRect(3).X, selRect(3).Y, selRect(1).X, selRect(1).Y) + + midCoords.X = Midpoint(selRect(0).X, selRect(1).X) + midCoords.Y = Midpoint(selRect(0).Y, selRect(1).Y) + If Not toolAction Then toolAction = checkDragPoint(midCoords.X, midCoords.Y, Midpoint(selRect(2).X, selRect(3).X), Midpoint(selRect(2).Y, selRect(3).Y)) + midCoords.X = Midpoint(selRect(1).X, selRect(2).X) + midCoords.Y = Midpoint(selRect(1).Y, selRect(2).Y) + If Not toolAction Then toolAction = checkDragPoint(midCoords.X, midCoords.Y, Midpoint(selRect(3).X, selRect(0).X), Midpoint(selRect(3).Y, selRect(0).Y)) + midCoords.X = Midpoint(selRect(2).X, selRect(3).X) + midCoords.Y = Midpoint(selRect(2).Y, selRect(3).Y) + If Not toolAction Then toolAction = checkDragPoint(midCoords.X, midCoords.Y, Midpoint(selRect(0).X, selRect(1).X), Midpoint(selRect(0).Y, selRect(1).Y)) + midCoords.X = Midpoint(selRect(3).X, selRect(0).X) + midCoords.Y = Midpoint(selRect(3).Y, selRect(0).Y) + If Not toolAction Then toolAction = checkDragPoint(midCoords.X, midCoords.Y, Midpoint(selRect(1).X, selRect(2).X), Midpoint(selRect(1).Y, selRect(2).Y)) + +End Sub + +Private Function checkDragPoint(x1 As Single, y1 As Single, x2 As Single, y2 As Single) As Boolean + + If nearCoord((x1 - scrollCoords(2).X) * zoomFactor, moveCoords(1).X, 8) And nearCoord((y1 - scrollCoords(2).Y) * zoomFactor, moveCoords(1).Y, 8) Then + If mnuFixedRCenter.Checked Then + rCenter.X = x2 + rCenter.Y = y2 + End If + moveCoords(1).X = (x1 - scrollCoords(2).X) * zoomFactor + moveCoords(1).Y = (y1 - scrollCoords(2).Y) * zoomFactor + checkDragPoint = True + End If + +End Function + +Private Sub Form_DblClick() + + If currentTool = TOOL_CREATE Then 'poly creation + + toolAction = True + + ElseIf currentTool = TOOL_VSELECT Then 'vertex selection + + toolAction = True + + selectedCoords(1).X = MouseHelper.CursorX - (Me.left / Screen.TwipsPerPixelX) - 1 + selectedCoords(1).Y = MouseHelper.CursorY - (Me.Top / Screen.TwipsPerPixelY) - 1 + selectedCoords(2).X = selectedCoords(1).X + selectedCoords(2).Y = selectedCoords(1).Y + + Render + + End If + +End Sub + +Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + Dim i As Integer, j As Integer, k As Integer + + On Error GoTo ErrorHandler + + If acquired = False Then + DIDevice.Acquire + acquired = True + End If + + If Button = 2 Then 'popup menus + If currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD Then + Me.PopupMenu mnuPolyTypes + ElseIf currentTool = TOOL_MOVE Then + mouseCoords.X = X + mouseCoords.Y = Y + Me.PopupMenu mnuMove + ElseIf currentTool = TOOL_PSELECT Or currentTool = TOOL_VSELECT Then + Me.PopupMenu mnuVertexSelect + ElseIf currentFunction = TOOL_SCENERY Then + If tvwScenery.Visible = False Then + If Me.WindowState = vbMaximized Then + tvwScenery.left = mouseCoords.X + If mouseCoords.Y + tvwScenery.Height > Me.ScaleHeight - 17 Then + tvwScenery.Top = Me.ScaleHeight - tvwScenery.Height - 17 + Else + tvwScenery.Top = mouseCoords.Y + End If + Else + tvwScenery.left = 0 + tvwScenery.Top = 41 + End If + End If + tvwScenery.Visible = Not tvwScenery.Visible + ElseIf currentFunction = TOOL_OBJECTS Then + Me.PopupMenu mnuObjects, , X, Y + Render + ElseIf currentFunction = TOOL_WAYPOINT Then + Me.PopupMenu mnuWaypoint, , X, Y + End If + ElseIf Button = 4 Then + scrollCoords(1).X = X + scrollCoords(1).Y = Y + SetCursor TOOL_HAND + 1 + Else + If tvwScenery.Visible Then tvwScenery.Visible = False + End If + + If Button <> 1 Then Exit Sub + + If spaceDown Then + + scrollCoords(1).X = X + scrollCoords(1).Y = Y + + ElseIf currentFunction = TOOL_MOVE Then 'move + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + toolAction = True + MouseDownMove X, Y + + ElseIf currentFunction = TOOL_ROTATE Or currentFunction = TOOL_SCALE Then 'scaling/rotation + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + moveCoords(1).X = X + moveCoords(1).Y = Y + moveCoords(2).X = X + moveCoords(2).Y = Y + + findDragPoint2 X, Y + + ElseIf (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) Then 'poly creation + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If Shift = 0 Then + If Not (showPolys Or showWireframe Or showPoints) Then + showPolys = True + frmDisplay.setLayer 1, True + End If + toolAction = True + ElseIf Shift = KEY_SHIFT Then 'constrained + If Not (showPolys Or showWireframe Or showPoints) Then + showPolys = True + End If + toolAction = True + End If + + ElseIf currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB Then 'vertex selection + + toolAction = True + selectedCoords(1).X = X + selectedCoords(1).Y = Y + selectedCoords(2).X = X + selectedCoords(2).Y = Y + + ElseIf currentFunction = TOOL_PSELECT Or currentFunction = TOOL_PSELADD Or currentFunction = TOOL_PSELSUB Then 'poly selection + + polySelection X, Y + + ElseIf currentFunction = TOOL_VCOLOR Then 'vertex color + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + toolAction = True + If colorMode > 0 Then + VertexColoring X, Y + Else + PrecisionColoring X, Y + End If + + ElseIf currentFunction = TOOL_PCOLOR Then 'poly color + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + ColorFill X, Y + + ElseIf currentFunction = TOOL_TEXTURE Then 'texture + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If Shift = 0 Then + toolAction = True + MouseDownMove X, Y + ElseIf Shift = KEY_SHIFT Then 'constrained + toolAction = True + moveCoords(2).X = X + moveCoords(2).Y = Y + moveCoords(1).X = X + moveCoords(1).Y = Y + End If + + ElseIf currentFunction = TOOL_SCENERY Then + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If Not showScenery Then + showScenery = True + frmDisplay.setLayer 5, showScenery + End If + toolAction = True + + ElseIf currentFunction = TOOL_CLRPICKER Then 'color picker + + If currentTool = TOOL_DEPTHMAP Then + depthPicker X, Y + ElseIf currentTool = TOOL_SCENERY Then + Else + ColorPicker X, Y + End If + + ElseIf currentFunction = TOOL_PIXPICKER Then + + Dim tempClr As TColor + tempClr = getRGB(GetPixel(Me.hDC, X, Y)) + If frmPalette.Enabled = False Then + frmColor.InitClr tempClr.blue, tempClr.green, tempClr.red + Else + polyClr.red = tempClr.blue + polyClr.green = tempClr.green + polyClr.blue = tempClr.red + Scenery(0).Color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) + frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue + End If + + ElseIf currentFunction = TOOL_LITPICKER Then + + lightPicker X, Y + + ElseIf currentFunction = TOOL_OBJECTS Then 'objects + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If Not showObjects And Not mnuGostek.Checked Then + showObjects = True + frmDisplay.setLayer 6, showObjects + End If + If mnuGostek.Checked Then + gostek.X = X / zoomFactor + scrollCoords(2).X + gostek.Y = Y / zoomFactor + scrollCoords(2).Y + ElseIf Not mnuCollider.Checked Then + spawnPoints = spawnPoints + 1 + ReDim Preserve Spawns(spawnPoints) + + Spawns(spawnPoints).Team = Spawns(0).Team + Spawns(spawnPoints).X = X / zoomFactor + scrollCoords(2).X + Spawns(spawnPoints).Y = Y / zoomFactor + scrollCoords(2).Y + + If showGrid And snapToGrid Then + Spawns(spawnPoints).X = Int((Spawns(spawnPoints).X + inc / 2) / inc) * inc + Spawns(spawnPoints).Y = Int((Spawns(spawnPoints).Y + inc / 2) / inc) * inc + End If + Else + colliderCount = colliderCount + 1 + ReDim Preserve Colliders(colliderCount) + + Colliders(colliderCount).radius = Colliders(0).radius + Colliders(colliderCount).X = X / zoomFactor + scrollCoords(2).X + Colliders(colliderCount).Y = Y / zoomFactor + scrollCoords(2).Y + + If showGrid And snapToGrid Then + Colliders(colliderCount).X = Int((Colliders(colliderCount).X + inc / 2) / inc) * inc + Colliders(colliderCount).Y = Int((Colliders(colliderCount).Y + inc / 2) / inc) * inc + End If + End If + Render + toolAction = True + + ElseIf currentFunction = TOOL_WAYPOINT Then 'waypoints + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If Not showWaypoints Then + showWaypoints = True + frmDisplay.setLayer 7, showWaypoints + End If + + If frmWaypoints.showPaths = 1 And frmWaypoints.wayptPath = 1 Or frmWaypoints.showPaths = 2 And frmWaypoints.wayptPath = 0 Then + frmWaypoints.picShow_MouseUp 0, 1, 0, 0, 0 + mouseEvent2 frmWaypoints.picShow(0), 0, 0, BUTTON_SMALL, True, BUTTON_UP + End If + + mnuDeselect_Click + + waypointCount = waypointCount + 1 + ReDim Preserve Waypoints(waypointCount) + + Waypoints(waypointCount).selected = True + numSelWaypoints = numSelWaypoints + 1 + + Waypoints(waypointCount).X = X / zoomFactor + scrollCoords(2).X + Waypoints(waypointCount).Y = Y / zoomFactor + scrollCoords(2).Y + + Waypoints(waypointCount).pathNum = frmWaypoints.wayptPath + 1 + + For i = 0 To 4 + Waypoints(waypointCount).wayType(i) = mnuWayType(i).Checked + Next + + If currentWaypoint > 0 Then 'connecting waypoints + conCount = conCount + 1 + ReDim Preserve Connections(conCount) + Connections(conCount).point1 = currentWaypoint + Connections(conCount).point2 = waypointCount + Waypoints(waypointCount).numConnections = Waypoints(waypointCount).numConnections + 1 + currentWaypoint = waypointCount + End If + getInfo + Render + toolAction = True + + ElseIf currentFunction = TOOL_CONNECT Then + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + toolAction = True + + ElseIf currentFunction = TOOL_DEPTHMAP Then + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + EditDepthMap X, Y + + toolAction = True + + ElseIf currentFunction = TOOL_LIGHTS Then + + CreateLight X, Y + + ElseIf currentFunction = TOOL_SKETCH Then + + If Shift = 0 Then 'freeform + startSketch X, Y + toolAction = True + ElseIf Shift = 1 Then + showSketch = True + frmDisplay.setLayer 10, showSketch + End If + + ElseIf currentFunction = TOOL_ERASER Then + + If eraseSketch(X / zoomFactor + scrollCoords(2).X, Y / zoomFactor + scrollCoords(2).Y) = 1 Then + Render + End If + toolAction = True + + ElseIf currentFunction = TOOL_SMUDGE Then + + moveCoords(2).X = X + moveCoords(2).Y = Y + moveCoords(1).X = X + moveCoords(1).Y = Y + toolAction = True + + End If + + Exit Sub + +ErrorHandler: + + MsgBox Error$ + +End Sub + +Private Sub CreateLight(X As Single, Y As Single) + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + showLights = True + frmDisplay.setLayer 9, showLights + + lightCount = lightCount + 1 + ReDim Preserve Lights(lightCount) + Lights(lightCount).X = X / zoomFactor + scrollCoords(2).X + Lights(lightCount).Y = Y / zoomFactor + scrollCoords(2).Y + Lights(lightCount).z = 255 + Lights(lightCount).color = polyClr + Lights(lightCount).intensity = opacity + Lights(lightCount).range = 0 + + If showGrid And snapToGrid Then + Lights(lightCount).X = Int((Lights(lightCount).X + inc / 2) / inc) * inc + Lights(lightCount).Y = Int((Lights(lightCount).Y + inc / 2) / inc) * inc + End If + + applyLights + SaveUndo + Render + +End Sub + +Private Sub applyLights(Optional toSel As Boolean = False) + + Dim i As Integer, j As Integer, k As Integer + + Dim lightDir As D3DVECTOR + Dim polyNormal As D3DVECTOR + Dim v1 As D3DVECTOR, v2 As D3DVECTOR + Dim mag As Single + Dim diffuseFactor As Single + Dim totalDiffuse As Single + + Dim clr As TColor + + Dim rVal As Integer, gVal As Integer, bVal As Integer + + If lightCount = 0 Then Exit Sub + + For i = 1 To polyCount + + 'get poly vectors + v1.X = PolyCoords(i).vertex(1).X - PolyCoords(i).vertex(2).X + v1.Y = PolyCoords(i).vertex(1).Y - PolyCoords(i).vertex(2).Y + v1.z = Polys(i).vertex(1).z - Polys(i).vertex(2).z + + v2.X = PolyCoords(i).vertex(1).X - PolyCoords(i).vertex(3).X + v2.Y = PolyCoords(i).vertex(1).Y - PolyCoords(i).vertex(3).Y + v2.z = Polys(i).vertex(1).z - Polys(i).vertex(3).z + + 'get poly normal + polyNormal.X = (v1.Y * v2.z) - (v1.z * v2.Y) + polyNormal.Y = (v1.z * v2.X) - (v1.X * v2.z) + polyNormal.z = (v1.X * v2.Y) - (v1.Y * v2.X) + + 'normalize poly normal + mag = Sqr(polyNormal.X ^ 2 + polyNormal.Y ^ 2 + polyNormal.z ^ 2) + If mag > 0 Then + polyNormal.X = polyNormal.X / mag + polyNormal.Y = polyNormal.Y / mag + polyNormal.z = polyNormal.z / mag + End If + + For j = 1 To 3 + + If (vertexList(i).vertex(j) = 1 And toSel) Or toSel = False Then + + For k = 1 To lightCount + + 'get light dir vector + lightDir.X = Lights(k).X - PolyCoords(i).vertex(j).X + lightDir.Y = Lights(k).Y - PolyCoords(i).vertex(j).Y + lightDir.z = Lights(k).z - Polys(i).vertex(j).z + 'normalize light dir + mag = Sqr(lightDir.X ^ 2 + lightDir.Y ^ 2 + lightDir.z ^ 2) + If mag > 0 Then + lightDir.X = lightDir.X / mag + lightDir.Y = lightDir.Y / mag + lightDir.z = lightDir.z / mag + End If + 'get angle between light dir and poly normal (dot product) + diffuseFactor = (polyNormal.X * lightDir.X) + (polyNormal.Y * lightDir.Y) + (polyNormal.z * lightDir.z) + If diffuseFactor < 0 Then diffuseFactor = 0 + + If Lights(k).range = 0 Then 'normal + mag = 1 + Else 'range > 0 + If mag > 0 Then + If mag <= Lights(k).range Then + mag = 1 - mag / Lights(k).range + Else 'vertex is out of range + mag = 0 + End If + Else + mag = 0 + End If + End If + + 'calculate final color components + rVal = rVal + (Lights(k).color.red * diffuseFactor) * mag + gVal = gVal + (Lights(k).color.green * diffuseFactor) * mag + bVal = bVal + (Lights(k).color.blue * diffuseFactor) * mag + + totalDiffuse = totalDiffuse + diffuseFactor + + Next + + totalDiffuse = totalDiffuse / lightCount + + clr = vertexList(i).color(j) + rVal = rVal + clr.red + gVal = gVal + clr.green + bVal = bVal + clr.blue + + If rVal > 255 Then rVal = 255 + If gVal > 255 Then gVal = 255 + If bVal > 255 Then bVal = 255 + + Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(Int(bVal), Int(gVal), Int(rVal))) + + rVal = 0 + gVal = 0 + bVal = 0 + totalDiffuse = 0 + + End If + + Next + + Next + + Render + +End Sub + +Private Sub applyLightsToVert(pIndex As Integer, vIndex As Integer) + + On Error GoTo ErrorHandler + + If lightCount <= 0 Or Not showLights Then Exit Sub + + Dim k As Integer + Dim lightDir As D3DVECTOR + Dim polyNormal As D3DVECTOR + Dim v1 As D3DVECTOR, v2 As D3DVECTOR + Dim mag As Single + Dim diffuseFactor As Single + Dim totalDiffuse As Single + Dim clr As TColor + Dim rVal As Integer, gVal As Integer, bVal As Integer + + 'get poly vectors + v1.X = PolyCoords(pIndex).vertex(1).X - PolyCoords(pIndex).vertex(2).X + v1.Y = PolyCoords(pIndex).vertex(1).Y - PolyCoords(pIndex).vertex(2).Y + v1.z = Polys(pIndex).vertex(1).z - Polys(pIndex).vertex(2).z + + v2.X = PolyCoords(pIndex).vertex(1).X - PolyCoords(pIndex).vertex(3).X + v2.Y = PolyCoords(pIndex).vertex(1).Y - PolyCoords(pIndex).vertex(3).Y + v2.z = Polys(pIndex).vertex(1).z - Polys(pIndex).vertex(3).z + + 'get poly normal + polyNormal.X = (v1.Y * v2.z) - (v1.z * v2.Y) + polyNormal.Y = (v1.z * v2.X) - (v1.X * v2.z) + polyNormal.z = (v1.X * v2.Y) - (v1.Y * v2.X) + + 'normalize poly normal + mag = Sqr(polyNormal.X ^ 2 + polyNormal.Y ^ 2 + polyNormal.z ^ 2) + If mag > 0 Then + polyNormal.X = polyNormal.X / mag + polyNormal.Y = polyNormal.Y / mag + polyNormal.z = polyNormal.z / mag + End If + + For k = 1 To lightCount + + 'get light dir vector + lightDir.X = Lights(k).X - PolyCoords(pIndex).vertex(vIndex).X + lightDir.Y = Lights(k).Y - PolyCoords(pIndex).vertex(vIndex).Y + lightDir.z = Lights(k).z - Polys(pIndex).vertex(vIndex).z + 'normalize light dir + mag = Sqr(lightDir.X ^ 2 + lightDir.Y ^ 2 + lightDir.z ^ 2) + If mag > 0 Then + lightDir.X = lightDir.X / mag + lightDir.Y = lightDir.Y / mag + lightDir.z = lightDir.z / mag + End If + 'get angle between light dir and poly normal (dot product) + diffuseFactor = (polyNormal.X * lightDir.X) + (polyNormal.Y * lightDir.Y) + (polyNormal.z * lightDir.z) + If diffuseFactor < 0 Then diffuseFactor = 0 + + 'calculate final color components + rVal = rVal + (Lights(k).color.red * diffuseFactor) + gVal = gVal + (Lights(k).color.green * diffuseFactor) + bVal = bVal + (Lights(k).color.blue * diffuseFactor) + + totalDiffuse = totalDiffuse + diffuseFactor + + Next + + totalDiffuse = totalDiffuse / lightCount + + clr = vertexList(pIndex).color(vIndex) + rVal = rVal + clr.red + gVal = gVal + clr.green + bVal = bVal + clr.blue + + If rVal > 255 Then rVal = 255 + If gVal > 255 Then gVal = 255 + If bVal > 255 Then bVal = 255 + + Polys(pIndex).vertex(vIndex).Color = ARGB(getAlpha(Polys(pIndex).vertex(vIndex).Color), RGB(Int(bVal), Int(gVal), Int(rVal))) + + rVal = 0 + gVal = 0 + bVal = 0 + totalDiffuse = 0 + + Exit Sub + +ErrorHandler: + + MsgBox Error$ + +End Sub + +Private Sub SnapSelection() + + Dim i As Integer, j As Integer, k As Integer, l As Integer + Dim PolyNum As Integer + + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + Polys(PolyNum).vertex(j).X = GetVertSnapCoord(PolyNum, j, 1) + Polys(PolyNum).vertex(j).Y = GetVertSnapCoord(PolyNum, j, 0) + If snapToGrid And showGrid Then + Polys(PolyNum).vertex(j).X = snapVertexToGrid(Polys(PolyNum).vertex(j).X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + Polys(PolyNum).vertex(j).Y = snapVertexToGrid(Polys(PolyNum).vertex(j).Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + End If + PolyCoords(PolyNum).vertex(j).X = Polys(PolyNum).vertex(j).X / zoomFactor + scrollCoords(2).X + PolyCoords(PolyNum).vertex(j).Y = Polys(PolyNum).vertex(j).Y / zoomFactor + scrollCoords(2).Y + End If + Next + Next + +End Sub + +Private Function GetVertSnapCoord(PolyNum As Integer, VertNum As Integer, GetXVal As Boolean) As Integer + + Dim i As Integer, j As Integer, xVal As Integer, yVal As Integer + Dim nearPoly As Integer, nearVert As Integer + Dim minDiff As Long, thisDiff As Long, prevDiff As Long + + xVal = Polys(PolyNum).vertex(VertNum).X + yVal = Polys(PolyNum).vertex(VertNum).Y + If GetXVal Then + GetVertSnapCoord = xVal + Else + GetVertSnapCoord = yVal + End If + + If ohSnap Then + nearPoly = -1 + minDiff = snapRadius ^ 2 + 1 + For i = 1 To polyCount + For j = 1 To 3 + If nearPoly = -1 Then + prevDiff = (Polys(i).vertex(j).X - xVal) ^ 2 + (Polys(i).vertex(j).Y - yVal) ^ 2 + If prevDiff < minDiff Then + nearPoly = i + nearVert = j + End If + End If + Next + Next + + If Not nearPoly = -1 Then + If GetXVal Then + GetVertSnapCoord = Polys(nearPoly).vertex(nearVert).X + Else + GetVertSnapCoord = Polys(nearPoly).vertex(nearVert).Y + End If + End If + End If + +End Function + +Private Sub AverageVerts() + + Dim i As Integer, j As Integer + Dim finalR As Integer, finalG As Integer, finalB As Integer + Dim tehClr As TColor + + For i = 1 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then + tehClr = getRGB(Polys(selectedPolys(i)).vertex(j).Color) + finalR = finalR + tehClr.red + finalG = finalG + tehClr.green + finalB = finalB + tehClr.blue + End If + Next + Next + + finalR = finalR / numSelectedPolys + finalG = finalG / numSelectedPolys + finalB = finalB / numSelectedPolys + + For i = 1 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then + Polys(selectedPolys(i)).vertex(j).Color = ARGB(getAlpha(Polys(selectedPolys(i)).vertex(j).Color), RGB(finalR, finalG, finalB)) + End If + Next + Next + +End Sub + +Private Sub AverageVertices() + + Dim i As Integer, j As Integer + Dim P As Integer, V As Integer + Dim finalR As Integer, finalG As Integer, finalB As Integer + Dim tehClr As TColor, vertexClr As TColor + Dim numVertices As Integer + Dim xVal As Single, yVal As Single + Dim connectedPolys() As Integer + Dim numConnectedPolys As Integer + + On Error GoTo ErrorHandler + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + Me.MousePointer = 11 + + If numSelectedPolys = 0 Then + + For i = 1 To polyCount + For j = 1 To 3 + If vertexList(i).vertex(j) = 0 Then + xVal = PolyCoords(i).vertex(j).X + yVal = PolyCoords(i).vertex(j).Y + finalR = 0 + finalG = 0 + finalB = 0 + For P = 1 To polyCount + For V = 1 To 3 + If nearCoord(xVal, PolyCoords(P).vertex(V).X, 2) And nearCoord(yVal, PolyCoords(P).vertex(V).Y, 2) Then + vertexList(P).vertex(V) = 1 + tehClr.red = vertexList(P).color(V).red + tehClr.green = vertexList(P).color(V).green + tehClr.blue = vertexList(P).color(V).blue + finalR = finalR + tehClr.red + finalG = finalG + tehClr.green + finalB = finalB + tehClr.blue + numConnectedPolys = numConnectedPolys + 1 + ReDim Preserve connectedPolys(numConnectedPolys) + connectedPolys(numConnectedPolys) = P + End If + Next + Next + finalR = finalR / numConnectedPolys + finalG = finalG / numConnectedPolys + finalB = finalB / numConnectedPolys + + For P = 1 To numConnectedPolys + For V = 1 To 3 + If vertexList(connectedPolys(P)).vertex(V) = 1 Then + vertexList(connectedPolys(P)).vertex(V) = 2 + vertexList(connectedPolys(P)).color(V).red = finalR + vertexList(connectedPolys(P)).color(V).green = finalG + vertexList(connectedPolys(P)).color(V).blue = finalB + Polys(connectedPolys(P)).vertex(V).Color = ARGB(getAlpha(Polys(connectedPolys(P)).vertex(V).Color), RGB(finalB, finalG, finalR)) + End If + Next + Next + numConnectedPolys = 0 + ReDim connectedPolys(0) + End If + Next + Next + + For i = 1 To polyCount + vertexList(i).vertex(1) = 0 + vertexList(i).vertex(2) = 0 + vertexList(i).vertex(3) = 0 + Next + + applyLights + + Else + + For i = 1 To polyCount + For j = 1 To 3 + If vertexList(i).vertex(j) = 1 Then + xVal = PolyCoords(i).vertex(j).X + yVal = PolyCoords(i).vertex(j).Y + finalR = 0 + finalG = 0 + finalB = 0 + For P = 1 To polyCount + For V = 1 To 3 + If nearCoord(xVal, PolyCoords(P).vertex(V).X, 2) And nearCoord(yVal, PolyCoords(P).vertex(V).Y, 2) Then + If vertexList(P).vertex(V) = 1 Then + vertexList(P).vertex(V) = 2 + tehClr.red = vertexList(P).color(V).red + tehClr.green = vertexList(P).color(V).green + tehClr.blue = vertexList(P).color(V).blue + finalR = finalR + tehClr.red + finalG = finalG + tehClr.green + finalB = finalB + tehClr.blue + numConnectedPolys = numConnectedPolys + 1 + ReDim Preserve connectedPolys(numConnectedPolys) + connectedPolys(numConnectedPolys) = P + End If + End If + Next + Next + finalR = finalR / numConnectedPolys + finalG = finalG / numConnectedPolys + finalB = finalB / numConnectedPolys + For P = 1 To numConnectedPolys + For V = 1 To 3 + If vertexList(connectedPolys(P)).vertex(V) = 2 Then + vertexList(connectedPolys(P)).vertex(V) = 3 + vertexList(connectedPolys(P)).color(V).red = finalR + vertexList(connectedPolys(P)).color(V).green = finalG + vertexList(connectedPolys(P)).color(V).blue = finalB + Polys(connectedPolys(P)).vertex(V).Color = ARGB(getAlpha(Polys(connectedPolys(P)).vertex(V).Color), RGB(finalB, finalG, finalR)) + End If + Next + Next + numConnectedPolys = 0 + ReDim connectedPolys(0) + End If + Next + Next + + For i = 1 To polyCount + For j = 1 To 3 + If vertexList(i).vertex(j) > 1 Then + vertexList(i).vertex(j) = 1 + End If + Next + Next + + applyLights True + + End If + + Me.MousePointer = 99 + + ctrlDown = False + currentFunction = currentTool + SetCursor currentFunction + 1 + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + SaveUndo + Render + + Exit Sub + +ErrorHandler: + + MsgBox "Error averaging colors" & vbNewLine & Error$ + +End Sub + +Private Sub MouseDownMove(X As Single, Y As Single) + + If numSelectedPolys + numSelectedScenery + numSelSpawns + numSelColliders + numSelWaypoints + numSelLights = 0 Then + noneSelected = True + SelNearest X, Y + End If + If snapToGrid And showGrid Then + X = snapVertexToGrid(X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + Y = snapVertexToGrid(Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + End If + moveCoords(1).X = X + moveCoords(1).Y = Y + moveCoords(2).X = X + moveCoords(2).Y = Y + +End Sub + +Private Sub SelNearest(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim addPoly As Integer, addVert As Integer, notSel As Integer + Dim currentDist As Long, shortestDist As Long + Dim xVal As Single, yVal As Single + + xVal = X / zoomFactor + scrollCoords(2).X + yVal = Y / zoomFactor + scrollCoords(2).Y + + addPoly = 0 + shortestDist = 64 ^ 2 + 1 + If showPolys Then + For i = 1 To polyCount + For j = 1 To 3 + If nearCoord(X, Polys(i).vertex(j).X, 8) And nearCoord(Y, Polys(i).vertex(j).Y, 8) Then 'move by vertex + If addPoly <> i Then + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = i + End If + vertexList(i).vertex(j) = 1 + addPoly = i + End If + Next + If (pointInPoly(X, Y, i)) And addPoly = 0 Then + For j = 1 To 3 + If nearCoord(X, Polys(i).vertex(j).X, 64) And nearCoord(Y, Polys(i).vertex(j).Y, 64) Then 'move by region + currentDist = (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + addPoly = i + addVert = j + End If + End If + Next + End If + Next + End If + + If numSelectedPolys = 0 And addPoly > 0 Then + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = addPoly + vertexList(addPoly).vertex(addVert) = 1 + End If + + If numSelectedPolys = 0 And addPoly = 0 And showScenery Then 'select scenery + For i = 1 To sceneryCount + If PointInProp(X, Y, i) And addPoly = 0 Then + Scenery(i).selected = 1 + numSelectedScenery = numSelectedScenery + 1 + addPoly = 1 + End If + Next + End If + + If addPoly = 0 And showObjects Then + notSel = 0 + shortestDist = (8 ^ 2 + 1) + For i = 1 To spawnPoints + Spawns(i).active = 0 + If nearCoord(xVal, Spawns(i).X, 8 / zoomFactor) And nearCoord(yVal, Spawns(i).Y, 8 / zoomFactor) Then + currentDist = (Spawns(i).X - xVal) ^ 2 + (Spawns(i).Y - yVal) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + notSel = i + End If + End If + Next + If notSel > 0 Then + Spawns(notSel).active = 1 + numSelSpawns = numSelSpawns + 1 + addPoly = notSel + End If + End If + + If addPoly = 0 And showObjects Then + notSel = 0 + shortestDist = 64 ^ 2 + 1 + For i = 1 To colliderCount + Colliders(i).active = 0 + If nearCoord(xVal, Colliders(i).X, Colliders(i).radius / 2) And nearCoord(yVal, Colliders(i).Y, Colliders(i).radius / 2) Then + currentDist = (Colliders(i).X - xVal) ^ 2 + (Colliders(i).Y - yVal) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + notSel = i + End If + End If + Next + If notSel > 0 Then + Colliders(notSel).active = 1 + numSelColliders = numSelColliders + 1 + addPoly = notSel + End If + + End If + + If addPoly = 0 And showWaypoints Then + + notSel = 0 + shortestDist = (8 ^ 2 + 1) + For i = 1 To waypointCount + Waypoints(i).selected = False + If nearCoord(xVal, Waypoints(i).X, 8 / zoomFactor) And nearCoord(yVal, Waypoints(i).Y, 8 / zoomFactor) Then + currentDist = (Waypoints(i).X - xVal) ^ 2 + (Waypoints(i).Y - yVal) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + notSel = i + End If + End If + Next + If notSel > 0 Then + Waypoints(notSel).selected = True + numSelWaypoints = numSelWaypoints + 1 + End If + + End If + + Render + +End Sub + +Private Sub CreatingPoly(Shift As Integer, X As Single, Y As Single) + + Dim xVal As Integer, yVal As Integer + Dim rtheta As D3DVECTOR2 + + xVal = X + yVal = Y + + If Shift = KEY_SHIFT Then + rtheta = ConstrainAngle(X - Polys(polyCount + 1).vertex(numVerts).X, Y - Polys(polyCount + 1).vertex(numVerts).Y) + xVal = Polys(polyCount + 1).vertex(numVerts).X + rtheta.X * Cos(rtheta.Y) + yVal = Polys(polyCount + 1).vertex(numVerts).Y + rtheta.X * Sin(rtheta.Y) + End If + + If snapToGrid And showGrid Then + xVal = snapVertexToGrid(xVal, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + yVal = snapVertexToGrid(yVal, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + End If + + Polys(polyCount + 1).vertex(numVerts + 1).X = xVal + Polys(polyCount + 1).vertex(numVerts + 1).Y = yVal + + PolyCoords(polyCount + 1).vertex(numVerts + 1).X = xVal / zoomFactor + scrollCoords(2).X + PolyCoords(polyCount + 1).vertex(numVerts + 1).Y = yVal / zoomFactor + scrollCoords(2).Y + + If mnuCustomX.Checked And mnuQuad.Checked Then + If creatingQuad Then + Polys(polyCount + 1).vertex(numVerts + 1).tu = (frmTexture.x1tex * 2 + 0.5) / xTexture + Else + If numVerts = 1 Or numVerts = 2 Then + Polys(polyCount + 1).vertex(numVerts + 1).tu = (frmTexture.x2tex * 2 - 0.5) / xTexture + Else + Polys(polyCount + 1).vertex(numVerts + 1).tu = (frmTexture.x1tex * 2 + 0.5) / xTexture + End If + End If + Else + Polys(polyCount + 1).vertex(numVerts + 1).tu = (xVal / zoomFactor + scrollCoords(2).X) / xTexture + End If + + If mnuCustomY.Checked And mnuQuad.Checked Then + If creatingQuad Then + Polys(polyCount + 1).vertex(numVerts + 1).tv = (frmTexture.y2tex * 2 - 0.5) / yTexture + Else + If numVerts > 1 Then + Polys(polyCount + 1).vertex(numVerts + 1).tv = (frmTexture.y2tex * 2 - 0.5) / yTexture + Else + Polys(polyCount + 1).vertex(numVerts + 1).tv = (frmTexture.y1tex * 2 + 0.5) / yTexture + End If + End If + Else + Polys(polyCount + 1).vertex(numVerts + 1).tv = (yVal / zoomFactor + scrollCoords(2).Y) / yTexture + End If + + Polys(polyCount + 1).vertex(numVerts + 1).Color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) + + Render + +End Sub + +Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + On Error GoTo ErrorHandler + + 'if not in focus and not properties in focus and not text in focus + If Screen.ActiveForm.hWnd <> Me.hWnd And Screen.ActiveForm.hWnd <> frmInfo.hWnd Then + If Not (Screen.ActiveForm.hWnd = frmPalette.hWnd And frmPalette.textControl) Then + RegainFocus + End If + End If + + mouseCoords.X = X + mouseCoords.Y = Y + + lblMousePosition.Caption = "Position: " & Round(X / zoomFactor + scrollCoords(2).X) & ", " & Round(Y / zoomFactor + scrollCoords(2).Y) + + 'draw circle + If circleOn Then + Render + End If + + If Button = 4 Or Button = 5 Then 'scrolling + Scrolling X, Y + End If + + If (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) And toolAction Then + If (Shift = 0 Or Shift = KEY_SHIFT) And numVerts > 0 Then 'poly creation + CreatingPoly Shift, X, Y + End If + ElseIf Button = 0 And currentFunction = TOOL_SCENERY Then + CreatingScenery Shift, X, Y + ElseIf Button = 0 And currentFunction = TOOL_OBJECTS And Shift < 2 Then + Spawns(0).X = X + Spawns(0).Y = Y + Colliders(0).X = X + Colliders(0).Y = Y + Render + ElseIf Button = 0 And (currentFunction = TOOL_WAYPOINT Or currentFunction = TOOL_CONNECT) And currentWaypoint > 0 Then + Render + ElseIf Button = 0 And currentFunction = TOOL_SKETCH And toolAction Then + sketch(0).vertex(2).X = X / zoomFactor + scrollCoords(2).X + sketch(0).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y + Render + End If + + If Button <> 1 Then Exit Sub + + + If spaceDown Then 'scrolling + + If currentFunction = TOOL_SCENERY And numCorners = 0 Then + Scenery(0).screenTr.X = X + Scenery(0).screenTr.Y = Y + ElseIf currentFunction = TOOL_OBJECTS Then + If Not mnuCollider.Checked Then + Spawns(0).X = X + Spawns(0).Y = Y + ElseIf mnuCollider.Checked Then + Colliders(0).X = X + Colliders(0).Y = Y + End If + End If + + Scrolling X, Y + + If Button = 5 Then + moveCoords(1).X = X + moveCoords(1).Y = Y + End If + + ElseIf currentFunction = TOOL_MOVE And toolAction Then 'moving + + If Shift = KEY_SHIFT Then 'constrained + If Abs(X - moveCoords(2).X) > Abs(Y - moveCoords(2).Y) Then + Y = moveCoords(2).Y + Else + X = moveCoords(2).X + End If + End If + Moving X, Y + + ElseIf currentFunction = TOOL_SCALE And toolAction Then 'scaling + + If Shift = KEY_CTRL Then + Scaling X, Y, False + ElseIf Shift = KEY_SHIFT + KEY_CTRL Then 'constrained scaling + Scaling X, Y, True + End If + + ElseIf currentFunction = TOOL_ROTATE And toolAction Then 'rotating + + If Shift = KEY_ALT Then + Rotating X, Y, False + ElseIf Shift = KEY_SHIFT + KEY_ALT Then 'constrained rotating + Rotating X, Y, True + End If + + ElseIf (currentFunction = TOOL_CREATE Or currentFunction = TOOL_CREATE) And toolAction Then 'poly creation -------- + + ElseIf currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB Then 'vertex selection -------- + + If toolAction Then + Render + selectedCoords(2).X = X + selectedCoords(2).Y = Y + End If + + ElseIf currentFunction = TOOL_PSELECT And toolAction Then 'poly selection + + ElseIf currentFunction = TOOL_VCOLOR And toolAction Then ' vertex coloring + + If colorMode > 0 Then + VertexColoring X, Y + End If + + ElseIf currentFunction = TOOL_PCOLOR Then 'poly coloring + + ElseIf currentFunction = TOOL_TEXTURE And toolAction Then 'texture + + If Shift = 0 Then + StretchingTexture X, Y + ElseIf Shift = KEY_SHIFT Then + If Abs(X - moveCoords(2).X) > Abs(Y - moveCoords(2).Y) Then + Y = moveCoords(2).Y + Else + X = moveCoords(2).X + End If + StretchingTexture X, Y + End If + + ElseIf currentFunction = TOOL_SCENERY Then 'scenery + + ElseIf currentFunction = TOOL_CLRPICKER Then 'color picker + + If currentTool = TOOL_DEPTHMAP Then + depthPicker X, Y + ElseIf currentTool = TOOL_SCENERY Then + + Else + ColorPicker X, Y + End If + + ElseIf currentFunction = TOOL_PIXPICKER Then 'pixel picker + + Dim tempClr As TColor + tempClr = getRGB(GetPixel(Me.hDC, X, Y)) + If frmPalette.Enabled = False Then + frmColor.InitClr tempClr.blue, tempClr.green, tempClr.red + Else + polyClr.red = tempClr.blue + polyClr.green = tempClr.green + polyClr.blue = tempClr.red + Scenery(0).Color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) + frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue + End If + + Render + + ElseIf currentFunction = TOOL_LITPICKER Then 'light picker + + ElseIf currentFunction = TOOL_OBJECTS Then 'objects + + Spawns(0).X = X + Spawns(0).Y = Y + If mnuGostek.Checked Then + gostek.X = X / zoomFactor + scrollCoords(2).X + gostek.Y = Y / zoomFactor + scrollCoords(2).Y + Render + End If + + ElseIf currentFunction = TOOL_WAYPOINT And toolAction Then 'waypoints + + ElseIf currentFunction = TOOL_DEPTHMAP And toolAction Then 'depthmap + + EditDepthMap X, Y + + ElseIf currentFunction = TOOL_SKETCH And toolAction Then 'sketch + + If Shift = 0 Then 'freeform + linkSketch X, Y + sketch(sketchLines).vertex(2).X = X / zoomFactor + scrollCoords(2).X + sketch(sketchLines).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y + Render + ElseIf Shift = KEY_SHIFT Then 'lines + sketch(0).vertex(2).X = X / zoomFactor + scrollCoords(2).X + sketch(0).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y + Render + End If + + ElseIf currentFunction = TOOL_ERASER And toolAction Then + + If eraseSketch(X / zoomFactor + scrollCoords(2).X, Y / zoomFactor + scrollCoords(2).Y) = 1 Then + Render + End If + + ElseIf currentFunction = TOOL_SMUDGE And toolAction Then + + If moveLines(X / zoomFactor + scrollCoords(2).X, Y / zoomFactor + scrollCoords(2).Y, X - moveCoords(2).X, Y - moveCoords(2).Y) = 1 Then + Render + End If + moveCoords(2).X = X + moveCoords(2).Y = Y + + End If + + Exit Sub + +ErrorHandler: + + MsgBox "form_mousemove error" & vbNewLine & Error$ + +End Sub + +Private Sub CreatingScenery(Shift As Integer, X As Single, Y As Single) + + Dim xVal As Single, yVal As Single + Dim angle As Single + + xVal = X + yVal = Y + + If snapToGrid And showGrid Then + xVal = Int(snapVertexToGrid(X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + 0.5) + yVal = Int(snapVertexToGrid(Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + 0.5) + End If + + If numCorners = 0 Then + Scenery(0).screenTr.X = xVal + Scenery(0).screenTr.Y = yVal + End If + + xVal = xVal - Int(Scenery(0).screenTr.X + 0.5) + yVal = yVal - Int(Scenery(0).screenTr.Y + 0.5) + + angle = GetAngle(xVal, yVal) + + If numCorners = 1 And toolAction Then + + If Shift = 1 Then + angle = (Int((angle * 180 / pi + 0) / 15) * 15) / 180 * pi + End If + + Scenery(0).rotation = angle + + ElseIf numCorners = 2 And toolAction Then + + angle = angle - Scenery(0).rotation + + Scenery(0).Scaling.X = (Cos(angle) * Sqr(xVal ^ 2 + yVal ^ 2)) / (SceneryTextures(Scenery(0).Style).Width) / zoomFactor + Scenery(0).Scaling.Y = -(Sin(angle) * Sqr(xVal ^ 2 + yVal ^ 2)) / (SceneryTextures(Scenery(0).Style).Height) / zoomFactor + + If Shift = 1 Then + If Scenery(0).Scaling.X < 0 Then + Scenery(0).Scaling.X = -Sqr((xVal ^ 2 + yVal ^ 2) / (SceneryTextures(Scenery(0).Style).Width ^ 2 + SceneryTextures(Scenery(0).Style).Height ^ 2)) / zoomFactor + Else + Scenery(0).Scaling.X = Sqr((xVal ^ 2 + yVal ^ 2) / (SceneryTextures(Scenery(0).Style).Width ^ 2 + SceneryTextures(Scenery(0).Style).Height ^ 2)) / zoomFactor + End If + If Scenery(0).Scaling.Y * Scenery(0).Scaling.X < 0 Then + Scenery(0).Scaling.Y = -Scenery(0).Scaling.X + Else + Scenery(0).Scaling.Y = Scenery(0).Scaling.X + End If + End If + + End If + + Render + +End Sub + +Private Function ConstrainAngle(xDiff As Integer, yDiff As Integer) As D3DVECTOR2 + + Dim theta As Single + Dim R As Single + + R = Sqr(xDiff ^ 2 + yDiff ^ 2) + If xDiff = 0 Then + If yDiff > 0 Then + theta = pi / 2 + Else + theta = 3 * pi / 2 + End If + ElseIf xDiff > 0 Then + theta = Atn(yDiff / xDiff) + ElseIf xDiff < 0 Then + theta = pi + Atn(yDiff / xDiff) + End If + + theta = (Int((theta * 180 / pi + 7.5) / 15) * 15) / 180 * pi + + ConstrainAngle.X = R + ConstrainAngle.Y = theta + +End Function + +Private Sub Scrolling(X As Single, Y As Single) + + Dim i As Integer + + scrollCoords(2).X = scrollCoords(2).X - (X - scrollCoords(1).X) / zoomFactor + scrollCoords(2).Y = scrollCoords(2).Y - (Y - scrollCoords(1).Y) / zoomFactor + + For i = 1 To polyCount 'move polys + Polys(i).vertex(1).X = Polys(i).vertex(1).X + X - scrollCoords(1).X + Polys(i).vertex(1).Y = Polys(i).vertex(1).Y + Y - scrollCoords(1).Y + Polys(i).vertex(2).X = Polys(i).vertex(2).X + X - scrollCoords(1).X + Polys(i).vertex(2).Y = Polys(i).vertex(2).Y + Y - scrollCoords(1).Y + Polys(i).vertex(3).X = Polys(i).vertex(3).X + X - scrollCoords(1).X + Polys(i).vertex(3).Y = Polys(i).vertex(3).Y + Y - scrollCoords(1).Y + Next + + For i = 1 To 4 'move background + bgPolys(i).X = bgPolys(i).X + X - scrollCoords(1).X + bgPolys(i).Y = bgPolys(i).Y + Y - scrollCoords(1).Y + Next + + For i = 1 To sceneryCount + Scenery(i).screenTr.X = Scenery(i).screenTr.X + X - scrollCoords(1).X + Scenery(i).screenTr.Y = Scenery(i).screenTr.Y + Y - scrollCoords(1).Y + Next + + If numVerts > 0 Then 'move existing vertices of poly being created + For i = 1 To 3 + Polys(polyCount + 1).vertex(i).X = Polys(polyCount + 1).vertex(i).X + X - scrollCoords(1).X + Polys(polyCount + 1).vertex(i).Y = Polys(polyCount + 1).vertex(i).Y + Y - scrollCoords(1).Y + Next + End If + + If numCorners > 0 Then + Scenery(0).screenTr.X = Scenery(0).screenTr.X + X - scrollCoords(1).X + Scenery(0).screenTr.Y = Scenery(0).screenTr.Y + Y - scrollCoords(1).Y + ElseIf currentFunction = TOOL_SCENERY And numCorners = 0 Then + Scenery(0).screenTr.X = X + Scenery(0).screenTr.Y = Y + ElseIf currentFunction = TOOL_OBJECTS Then + Spawns(0).X = X + Spawns(0).Y = Y + Colliders(0).X = X + Colliders(0).Y = Y + End If + + If (currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB) And toolAction Then + selectedCoords(1).X = selectedCoords(1).X + X - scrollCoords(1).X + selectedCoords(1).Y = selectedCoords(1).Y + Y - scrollCoords(1).Y + selectedCoords(2).X = X + selectedCoords(2).Y = Y + End If + + scrollCoords(1).X = X + scrollCoords(1).Y = Y + + Render + + If (currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB) And toolAction Then + Render + End If + +End Sub + +Private Sub Moving(ByVal X As Single, ByVal Y As Single) + + Dim i As Integer, j As Integer + Dim PolyNum As Integer + Dim xDiff As Single, yDiff As Single + Dim xVal As Single, yVal As Single + + If snapToGrid And showGrid And toolAction Then + X = snapVertexToGrid(X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + Y = snapVertexToGrid(Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + End If + + xVal = X - moveCoords(1).X + yVal = Y - moveCoords(1).Y + + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + xDiff = Polys(PolyNum).vertex(j).tu - PolyCoords(PolyNum).vertex(j).X / xTexture + yDiff = Polys(PolyNum).vertex(j).tv - PolyCoords(PolyNum).vertex(j).Y / yTexture + PolyCoords(PolyNum).vertex(j).X = PolyCoords(PolyNum).vertex(j).X + xVal / zoomFactor + PolyCoords(PolyNum).vertex(j).Y = PolyCoords(PolyNum).vertex(j).Y + yVal / zoomFactor + 'switch + Polys(PolyNum).vertex(j).X = (PolyCoords(PolyNum).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(PolyNum).vertex(j).Y = (PolyCoords(PolyNum).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + + If fixedTexture Then + Polys(PolyNum).vertex(j).tu = (Polys(PolyNum).vertex(j).X / zoomFactor + scrollCoords(2).X) / xTexture + xDiff + Polys(PolyNum).vertex(j).tv = (Polys(PolyNum).vertex(j).Y / zoomFactor + scrollCoords(2).Y) / yTexture + yDiff + End If + End If + Next + Next + + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + Scenery(i).Translation.X = Scenery(i).Translation.X + xVal / zoomFactor + Scenery(i).Translation.Y = Scenery(i).Translation.Y + yVal / zoomFactor + Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor + Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor + End If + Next + + For i = 1 To spawnPoints + If Spawns(i).active = 1 Then + Spawns(i).X = Spawns(i).X + xVal / zoomFactor + Spawns(i).Y = Spawns(i).Y + yVal / zoomFactor + End If + Next + For i = 1 To colliderCount + If Colliders(i).active = 1 Then + Colliders(i).X = Colliders(i).X + xVal / zoomFactor + Colliders(i).Y = Colliders(i).Y + yVal / zoomFactor + End If + Next + + For i = 1 To lightCount + If Lights(i).selected = 1 Then + Lights(i).X = Lights(i).X + xVal / zoomFactor + Lights(i).Y = Lights(i).Y + yVal / zoomFactor + End If + Next + + For i = 1 To waypointCount + If Waypoints(i).selected = True Then + Waypoints(i).X = Waypoints(i).X + xVal / zoomFactor + Waypoints(i).Y = Waypoints(i).Y + yVal / zoomFactor + End If + Next + + rCenter.X = rCenter.X + xVal / zoomFactor + rCenter.Y = rCenter.Y + yVal / zoomFactor + + For i = 0 To 3 + selRect(i).X = selRect(i).X + xVal / zoomFactor + selRect(i).Y = selRect(i).Y + yVal / zoomFactor + Next + + moveCoords(1).X = X + moveCoords(1).Y = Y + + getInfo + + prompt = True + + Render + +End Sub + +Private Sub Scaling(ByVal X As Single, ByVal Y As Single, constrained As Boolean) + + Dim i As Integer, j As Integer + Dim xVal As Single, yVal As Single + Dim xCenter As Single, yCenter As Single + Dim PolyNum As Integer + Dim theta As Single + + xCenter = (rCenter.X - scrollCoords(2).X) * zoomFactor + yCenter = (rCenter.Y - scrollCoords(2).Y) * zoomFactor + + If snapToGrid And showGrid Then + X = snapVertexToGrid(X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + Y = snapVertexToGrid(Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + End If + + If Not constrained Then + If moveCoords(1).X = xCenter Then + scaleDiff.X = 1 + Else + scaleDiff.X = 1 + (X - moveCoords(1).X) / (moveCoords(1).X - xCenter) + End If + If moveCoords(1).Y = yCenter Then + scaleDiff.Y = 1 + Else + scaleDiff.Y = 1 + (Y - moveCoords(1).Y) / (moveCoords(1).Y - yCenter) + End If + Else + If (moveCoords(1).X - xCenter) * (moveCoords(1).Y - yCenter) > 0 Then + scaleDiff.X = (((X - xCenter) + (Y - yCenter)) / ((moveCoords(1).X - xCenter) + (moveCoords(1).Y - yCenter))) + scaleDiff.Y = scaleDiff.X + Else + scaleDiff.X = (((X - xCenter) - (Y - yCenter)) / ((moveCoords(1).X - xCenter) - (moveCoords(1).Y - yCenter))) + scaleDiff.Y = scaleDiff.X + End If + + End If + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + Polys(PolyNum).vertex(j).X = ((rCenter.X + (PolyCoords(PolyNum).vertex(j).X - rCenter.X) * scaleDiff.X) - scrollCoords(2).X) * zoomFactor + Polys(PolyNum).vertex(j).Y = ((rCenter.Y + (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) * scaleDiff.Y) - scrollCoords(2).Y) * zoomFactor + End If + Next + Next + End If + + If numSelectedScenery > 0 Then + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + Scenery(i).screenTr.X = (rCenter.X + (Scenery(i).Translation.X - rCenter.X) * scaleDiff.X - scrollCoords(2).X) * zoomFactor + Scenery(i).screenTr.Y = (rCenter.Y + (Scenery(i).Translation.Y - rCenter.Y) * scaleDiff.Y - scrollCoords(2).Y) * zoomFactor + End If + Next + End If + + moveCoords(2).X = X + moveCoords(2).Y = Y + + frmInfo.txtScale(0).Text = Int(scaleDiff.X * 1000) / 10 + frmInfo.txtScale(1).Text = Int(scaleDiff.Y * 1000) / 10 + + prompt = True + + Render + +End Sub + +Private Sub ApplyTransform(Rotating As Boolean) + + Dim i As Integer, j As Integer + Dim pNum As Integer + Dim temp As D3DVECTOR2 + Dim tempVertex As TCustomVertex + Dim vertSel As Byte + Dim xVal As Single, yVal As Single + Dim angle As Single, theta As Single + Dim R As Single + Dim tempClr As TColor + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + For i = 1 To numSelectedPolys + pNum = selectedPolys(i) + For j = 1 To 3 + + PolyCoords(pNum).vertex(j).X = Polys(pNum).vertex(j).X / zoomFactor + scrollCoords(2).X + PolyCoords(pNum).vertex(j).Y = Polys(pNum).vertex(j).Y / zoomFactor + scrollCoords(2).Y + + If (scaleDiff.X * scaleDiff.Y < 0) Then + 'make sure polys are cw + If Not isCW(pNum) Then 'switch to make cw + temp = PolyCoords(pNum).vertex(3) + PolyCoords(pNum).vertex(3) = PolyCoords(pNum).vertex(2) + PolyCoords(pNum).vertex(2) = temp + + tempVertex = Polys(pNum).vertex(3) + Polys(pNum).vertex(3) = Polys(pNum).vertex(2) + Polys(pNum).vertex(2) = tempVertex + + vertSel = vertexList(pNum).vertex(3) + vertexList(pNum).vertex(3) = vertexList(pNum).vertex(2) + vertexList(pNum).vertex(2) = vertSel + + tempClr = vertexList(pNum).color(3) + vertexList(pNum).color(3) = vertexList(pNum).color(2) + vertexList(pNum).color(2) = tempClr + End If + End If + Next + Next + + If numSelectedScenery > 0 Then + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + + Scenery(i).Translation.X = Scenery(i).screenTr.X / zoomFactor + scrollCoords(2).X + Scenery(i).Translation.Y = Scenery(i).screenTr.Y / zoomFactor + scrollCoords(2).Y + + If Not Rotating Then + + xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X + yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y + angle = GetAngle(xVal, yVal) + Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + xVal = Cos(angle) * R * scaleDiff.X + yVal = -Sin(angle) * R * scaleDiff.Y + angle = GetAngle(xVal, yVal) - Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + Scenery(i).Scaling.X = (Cos(angle) * R) / (SceneryTextures(Scenery(i).Style).Width) + Scenery(i).Scaling.Y = -(Sin(angle) * R) / (SceneryTextures(Scenery(i).Style).Height) + + End If + + If scaleDiff.X * scaleDiff.Y < 0 And Rotating Then + Scenery(i).rotation = -(Scenery(i).rotation - rDiff) + Else + Scenery(i).rotation = (Scenery(i).rotation - rDiff) + End If + End If + Next + End If + + If Not Rotating Then + For i = 0 To 3 + selRect(i).X = rCenter.X + (selRect(i).X - rCenter.X) * scaleDiff.X + selRect(i).Y = rCenter.Y + (selRect(i).Y - rCenter.Y) * scaleDiff.Y + Next + Else + For i = 0 To 3 + xVal = (selRect(i).X - rCenter.X) + yVal = (selRect(i).Y - rCenter.Y) + R = Sqr((xVal) ^ 2 + (yVal) ^ 2) 'distance of point from rotation center + angle = GetAngle(xVal, yVal) - rDiff + selRect(i).X = rCenter.X + R * Cos(angle) + selRect(i).Y = rCenter.Y + R * -Sin(angle) + Next + End If + + scaleDiff.X = 1 + scaleDiff.Y = 1 + + rDiff = 0 + + getRCenter + + SaveUndo + + getInfo + + Render + +End Sub + +Public Sub applyScale(tehXvalue As Single, tehYvalue As Single) + + Dim i As Integer, j As Integer + Dim PolyNum As Integer + Dim vertSel As Byte + Dim temp As D3DVECTOR2 + Dim tempVertex As TCustomVertex + Dim xVal As Single, yVal As Single + Dim R As Single, angle As Single + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + scaleDiff.X = tehXvalue + scaleDiff.Y = tehYvalue + + rCenter.X = Midpoint(selRect(0).X, selRect(2).X) + rCenter.Y = Midpoint(selRect(0).Y, selRect(2).Y) + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + PolyCoords(PolyNum).vertex(j).X = (rCenter.X + (PolyCoords(PolyNum).vertex(j).X - rCenter.X) * scaleDiff.X) + PolyCoords(PolyNum).vertex(j).Y = (rCenter.Y + (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) * scaleDiff.Y) + Polys(PolyNum).vertex(j).X = (PolyCoords(PolyNum).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(PolyNum).vertex(j).Y = (PolyCoords(PolyNum).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + End If + Next + + 'make sure polys are cw + If Not isCW(PolyNum) Then 'switch to make cw + temp = PolyCoords(PolyNum).vertex(3) + PolyCoords(PolyNum).vertex(3) = PolyCoords(PolyNum).vertex(2) + PolyCoords(PolyNum).vertex(2) = temp + + tempVertex = Polys(PolyNum).vertex(3) + Polys(PolyNum).vertex(3) = Polys(PolyNum).vertex(2) + Polys(PolyNum).vertex(2) = tempVertex + + vertSel = vertexList(PolyNum).vertex(3) + vertexList(PolyNum).vertex(3) = vertexList(PolyNum).vertex(2) + vertexList(PolyNum).vertex(2) = vertSel + End If + Next + End If + + If numSelectedScenery > 0 Then + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + + Scenery(i).Translation.X = rCenter.X + (Scenery(i).Translation.X - rCenter.X) * scaleDiff.X + Scenery(i).Translation.Y = rCenter.Y + (Scenery(i).Translation.Y - rCenter.Y) * scaleDiff.Y + + Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor + Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor + + xVal = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X + yVal = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y + angle = GetAngle(xVal, yVal) + Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + xVal = Cos(angle) * R * scaleDiff.X + yVal = -Sin(angle) * R * scaleDiff.Y + angle = GetAngle(xVal, yVal) - Scenery(i).rotation + R = Sqr(xVal ^ 2 + yVal ^ 2) + + Scenery(i).Scaling.X = (Cos(angle) * R) / (SceneryTextures(Scenery(i).Style).Width) + Scenery(i).Scaling.Y = -(Sin(angle) * R) / (SceneryTextures(Scenery(i).Style).Height) + End If + Next + End If + + 'MESS! + If numSelSpawns > 0 Then + For i = 1 To spawnPoints + If Spawns(i).active = 1 Then + Spawns(i).X = rCenter.X + (Spawns(i).X - rCenter.X) * scaleDiff.X + Spawns(i).Y = rCenter.Y + (Spawns(i).Y - rCenter.Y) * scaleDiff.Y + End If + Next + End If + + If numSelColliders > 0 Then + For i = 1 To colliderCount + If Colliders(i).active = 1 Then + Colliders(i).X = rCenter.X + (Colliders(i).X - rCenter.X) * scaleDiff.X + Colliders(i).Y = rCenter.Y + (Colliders(i).Y - rCenter.Y) * scaleDiff.Y + End If + Next + End If + + If numSelLights > 0 Then + For i = 1 To lightCount + If Lights(i).selected = 1 Then + Lights(i).X = rCenter.X + (Lights(i).X - rCenter.X) * scaleDiff.X + Lights(i).Y = rCenter.Y + (Lights(i).Y - rCenter.Y) * scaleDiff.Y + End If + Next + End If + + If numSelWaypoints > 0 Then + For i = 1 To waypointCount + If Waypoints(i).selected = True Then + Waypoints(i).X = rCenter.X + (Waypoints(i).X - rCenter.X) * scaleDiff.X + Waypoints(i).Y = rCenter.Y + (Waypoints(i).Y - rCenter.Y) * scaleDiff.Y + End If + Next + End If + + scaleDiff.X = 1 + scaleDiff.Y = 1 + + getRCenter + getInfo + SaveUndo + Render + +End Sub + +Public Sub applyRotate(tehValue As Single) + + Dim R As Single, theta As Single + Dim xDiff As Single, yDiff As Single + Dim i As Integer, j As Integer + Dim PolyNum As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + rDiff = tehValue + + rCenter.X = Midpoint(selRect(0).X, selRect(2).X) + rCenter.Y = Midpoint(selRect(0).Y, selRect(2).Y) + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + xDiff = (PolyCoords(PolyNum).vertex(j).X - rCenter.X) + yDiff = (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) + + theta = rDiff + + PolyCoords(PolyNum).vertex(j).X = (Cos(theta) * xDiff - Sin(theta) * yDiff) + rCenter.X + PolyCoords(PolyNum).vertex(j).Y = (Sin(theta) * xDiff + Cos(theta) * yDiff) + rCenter.Y + + Polys(PolyNum).vertex(j).X = (PolyCoords(PolyNum).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(PolyNum).vertex(j).Y = (PolyCoords(PolyNum).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + End If + Next + Next + End If + + If numSelectedScenery > 0 Then + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + xDiff = (Scenery(i).Translation.X - rCenter.X) + yDiff = (Scenery(i).Translation.Y - rCenter.Y) + + R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center + If xDiff = 0 Then + If yDiff > 0 Then + theta = pi / 2 + Else + theta = 3 * pi / 2 + End If + ElseIf xDiff > 0 Then + theta = Atn(yDiff / xDiff) + ElseIf xDiff < 0 Then + theta = pi + Atn(yDiff / xDiff) + End If + theta = theta + rDiff + + Scenery(i).Translation.X = rCenter.X + R * Cos(theta) + Scenery(i).Translation.Y = rCenter.Y + R * Sin(theta) + + Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor + Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor + + If scaleDiff.X * scaleDiff.Y < 0 Then + Scenery(i).rotation = -(Scenery(i).rotation - rDiff) + Else + Scenery(i).rotation = (Scenery(i).rotation - rDiff) + End If + End If + Next + End If + + 'MESS! + If numSelSpawns > 0 Then + For i = 1 To spawnPoints + If Spawns(i).active = 1 Then + xDiff = (Spawns(i).X - rCenter.X) + yDiff = (Spawns(i).Y - rCenter.Y) + theta = rDiff + Spawns(i).X = (Cos(theta) * xDiff - Sin(theta) * yDiff) + rCenter.X + Spawns(i).Y = (Sin(theta) * xDiff + Cos(theta) * yDiff) + rCenter.Y + End If + Next + End If + + If numSelColliders > 0 Then + For i = 1 To colliderCount + If Colliders(i).active = 1 Then + xDiff = (Colliders(i).X - rCenter.X) + yDiff = (Colliders(i).Y - rCenter.Y) + theta = rDiff + Colliders(i).X = (Cos(theta) * xDiff - Sin(theta) * yDiff) + rCenter.X + Colliders(i).Y = (Sin(theta) * xDiff + Cos(theta) * yDiff) + rCenter.Y + End If + Next + End If + + If numSelLights > 0 Then + For i = 1 To lightCount + If Lights(i).selected = 1 Then + xDiff = (Lights(i).X - rCenter.X) + yDiff = (Lights(i).Y - rCenter.Y) + theta = rDiff + Lights(i).X = (Cos(theta) * xDiff - Sin(theta) * yDiff) + rCenter.X + Lights(i).Y = (Sin(theta) * xDiff + Cos(theta) * yDiff) + rCenter.Y + End If + Next + End If + + If numSelWaypoints > 0 Then + For i = 1 To waypointCount + If Waypoints(i).selected = True Then + xDiff = (Waypoints(i).X - rCenter.X) + yDiff = (Waypoints(i).Y - rCenter.Y) + theta = rDiff + Waypoints(i).X = (Cos(theta) * xDiff - Sin(theta) * yDiff) + rCenter.X + Waypoints(i).Y = (Sin(theta) * xDiff + Cos(theta) * yDiff) + rCenter.Y + End If + Next + End If + + rCenter.X = selRect(0).X + rCenter.Y = selRect(0).Y + rDiff = 0 + + getRCenter + getInfo + SaveUndo + Render + +End Sub + + +Private Function GetAngle(ByVal xVal As Single, ByVal yVal As Single) As Single + + If xVal < 0 Then + GetAngle = pi - Atn(yVal / xVal) + ElseIf xVal > 0 Then + If Atn(yVal / xVal) > 0 Then + GetAngle = 2 * pi - Atn(yVal / xVal) + Else + GetAngle = -Atn(yVal / xVal) + End If + Else + If yVal > 0 Then + GetAngle = 3 * pi / 2 + Else + GetAngle = pi / 2 + End If + End If + +End Function + +Private Sub Rotating(X As Single, Y As Single, constrained As Boolean) + + Dim i As Integer, j As Integer + Dim angle As Single, oldAngle As Single + Dim xCenter As Single, yCenter As Single + Dim xDiff As Integer, yDiff As Integer + Dim PolyNum As Integer + Dim R As Single, theta As Single + + If snapToGrid And showGrid Then + X = snapVertexToGrid(X, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + Y = snapVertexToGrid(Y, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + End If + + xCenter = (rCenter.X - scrollCoords(2).X) * zoomFactor + yCenter = (rCenter.Y - scrollCoords(2).Y) * zoomFactor + If xCenter = moveCoords(1).X Then + If moveCoords(1).Y - yCenter > 0 Then + oldAngle = pi / 2 + Else + oldAngle = 3 * pi / 2 + End If + ElseIf moveCoords(1).X - xCenter > 0 Then + oldAngle = Atn((moveCoords(1).Y - yCenter) / (moveCoords(1).X - xCenter)) + ElseIf moveCoords(1).X - xCenter < 0 Then + oldAngle = pi + Atn((moveCoords(1).Y - yCenter) / (moveCoords(1).X - xCenter)) + End If + + If xCenter = X Then + If Y - yCenter > 0 Then + angle = pi / 2 + Else + angle = 3 * pi / 2 + End If + ElseIf X - xCenter > 0 Then + angle = Atn((Y - yCenter) / (X - xCenter)) + ElseIf X - xCenter < 0 Then + angle = pi + Atn((Y - yCenter) / (X - xCenter)) + End If + + rDiff = angle - oldAngle + + If constrained Then + rDiff = (Int((rDiff * 180 / pi + 7.5) / 15) * 15) / 180 * pi + End If + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + xDiff = (PolyCoords(PolyNum).vertex(j).X - rCenter.X) * zoomFactor + yDiff = (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) * zoomFactor + + R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center + If xDiff = 0 Then + If yDiff > 0 Then + theta = pi / 2 + rDiff + Else + theta = 3 * pi / 2 + rDiff + End If + ElseIf xDiff > 0 Then + theta = Atn(yDiff / xDiff) + rDiff + ElseIf xDiff < 0 Then + theta = pi + Atn(yDiff / xDiff) + rDiff + End If + + Polys(PolyNum).vertex(j).X = xCenter + R * Cos(theta) + Polys(PolyNum).vertex(j).Y = yCenter + R * Sin(theta) + End If + Next + Next + End If + + If numSelectedScenery > 0 Then + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + xDiff = (Scenery(i).Translation.X - rCenter.X) * zoomFactor + yDiff = (Scenery(i).Translation.Y - rCenter.Y) * zoomFactor + + R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center + If xDiff = 0 Then + If yDiff > 0 Then + theta = pi / 2 + rDiff + Else + theta = 3 * pi / 2 + rDiff + End If + ElseIf xDiff > 0 Then + theta = Atn(yDiff / xDiff) + rDiff + ElseIf xDiff < 0 Then + theta = pi + Atn(yDiff / xDiff) + rDiff + End If + + Scenery(i).screenTr.X = xCenter + R * Cos(theta) + Scenery(i).screenTr.Y = yCenter + R * Sin(theta) + End If + Next + End If + + If numSelWaypoints Then + For i = 1 To waypointCount + If Waypoints(i).selected Then + xDiff = (Scenery(i).Translation.X - rCenter.X) * zoomFactor + yDiff = (Scenery(i).Translation.Y - rCenter.Y) * zoomFactor + + R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center + If xDiff = 0 Then + If yDiff > 0 Then + theta = pi / 2 + rDiff + Else + theta = 3 * pi / 2 + rDiff + End If + ElseIf xDiff > 0 Then + theta = Atn(yDiff / xDiff) + rDiff + ElseIf xDiff < 0 Then + theta = pi + Atn(yDiff / xDiff) + rDiff + End If + + Scenery(i).screenTr.X = xCenter + R * Cos(theta) + Scenery(i).screenTr.Y = yCenter + R * Sin(theta) + End If + Next + End If + + moveCoords(2).X = X + moveCoords(2).Y = Y + + frmInfo.txtRotate.Text = Int(rDiff / pi * 180 * 100) / 100 + + prompt = True + + Render + +End Sub + +Private Sub PrecisionColoring(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim closestPoly As Single, closestVert As Single + Dim currentDist As Long, shortestDist As Long + Dim PolyNum As Integer + Dim destClr As TColor + Dim R As Integer + + R = clrRadius * zoomFactor + + shortestDist = R ^ 2 + 1 + If numSelectedPolys > 0 Then + + For i = 1 To numSelectedPolys 'find closest + PolyNum = selectedPolys(i) + If pointInPoly(X, Y, i) Then + For j = 1 To 3 + If nearCoord(X, Polys(PolyNum).vertex(j).X, R) And nearCoord(Y, Polys(PolyNum).vertex(j).Y, R) Then + currentDist = (Polys(PolyNum).vertex(j).X - X) ^ 2 + (Polys(PolyNum).vertex(j).Y - Y) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + closestPoly = PolyNum + closestVert = j + End If + End If + Next + End If + Next + + If closestPoly > 0 And closestVert > 0 Then + destClr = getRGB(Polys(closestPoly).vertex(closestVert).Color) + destClr = applyBlend(destClr) + Polys(closestPoly).vertex(closestVert).Color = ARGB(getAlpha(Polys(closestPoly).vertex(closestVert).Color), RGB(destClr.blue, destClr.green, destClr.red)) + vertexList(closestPoly).color(closestVert).red = destClr.red + vertexList(closestPoly).color(closestVert).green = destClr.green + vertexList(closestPoly).color(closestVert).blue = destClr.blue + End If + + Else + + For i = 1 To polyCount 'find closest + If pointInPoly(X, Y, i) Then + For j = 1 To 3 + If nearCoord(X, Polys(i).vertex(j).X, R) And nearCoord(Y, Polys(i).vertex(j).Y, R) Then + currentDist = (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + closestPoly = i + closestVert = j + End If + End If + Next + End If + Next + + If closestPoly > 0 And closestVert > 0 Then + destClr = getRGB(Polys(closestPoly).vertex(closestVert).Color) + destClr = applyBlend(destClr) + Polys(closestPoly).vertex(closestVert).Color = ARGB(getAlpha(Polys(closestPoly).vertex(closestVert).Color), RGB(destClr.blue, destClr.green, destClr.red)) + vertexList(closestPoly).color(closestVert).red = destClr.red + vertexList(closestPoly).color(closestVert).green = destClr.green + vertexList(closestPoly).color(closestVert).blue = destClr.blue + End If + + End If + + prompt = True + + Render + +End Sub + +Private Sub VertexColoring(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim pNum As Integer + Dim destClr As TColor + Dim R As Integer + Dim colored As Boolean + + R = clrRadius * zoomFactor + + If numSelectedPolys > 0 And (showPolys Or showWireframe Or showPoints) Then + + For i = 1 To numSelectedPolys + pNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(pNum).vertex(j) = 1 Then + If nearCoord(X, Polys(pNum).vertex(j).X, R) And nearCoord(Y, Polys(pNum).vertex(j).Y, R) Then + If (Polys(pNum).vertex(j).X - X) ^ 2 + (Polys(pNum).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then + destClr = getRGB(Polys(pNum).vertex(j).Color) + destClr = applyBlend(destClr) + Polys(pNum).vertex(j).Color = ARGB(getAlpha(Polys(pNum).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) + vertexList(pNum).color(j).red = destClr.red + vertexList(pNum).color(j).green = destClr.green + vertexList(pNum).color(j).blue = destClr.blue + If lightCount > 0 Then applyLightsToVert pNum, j + If colorMode = 1 Then vertexList(pNum).vertex(j) = 3 + colored = True + End If + End If + End If + Next + Next + + ElseIf (showPolys Or showWireframe Or showPoints) And numSelectedScenery = 0 Then + + For i = 1 To polyCount + For j = 1 To 3 + If vertexList(i).vertex(j) = 0 Then + If nearCoord(X, Polys(i).vertex(j).X, R) And nearCoord(Y, Polys(i).vertex(j).Y, R) Then + If (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then + destClr = getRGB(Polys(i).vertex(j).Color) + destClr = applyBlend(destClr) + Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) + vertexList(i).color(j).red = destClr.red + vertexList(i).color(j).green = destClr.green + vertexList(i).color(j).blue = destClr.blue + If lightCount > 0 Then applyLightsToVert i, j + If colorMode = 1 Then vertexList(i).vertex(j) = 2 + colored = True + End If + End If + End If + Next + Next + + End If + + If numSelectedScenery > 0 And showScenery Then + + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + If nearCoord(X, Scenery(i).screenTr.X, R) And nearCoord(Y, Scenery(i).screenTr.Y, R) Then + If (Scenery(i).screenTr.X - X) ^ 2 + (Scenery(i).screenTr.Y - Y) ^ 2 <= R ^ 2 Then + destClr = getRGB(Scenery(i).Color) + destClr = applyBlend(destClr) + Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) + If colorMode = 1 Then Scenery(i).selected = 3 + colored = True + End If + End If + End If + Next + + ElseIf showScenery And numSelectedPolys = 0 Then + + For i = 1 To sceneryCount + If Scenery(i).selected = 0 Then + If nearCoord(X, Scenery(i).screenTr.X, R) And nearCoord(Y, Scenery(i).screenTr.Y, R) Then + If (Scenery(i).screenTr.X - X) ^ 2 + (Scenery(i).screenTr.Y - Y) ^ 2 <= R ^ 2 Then + destClr = getRGB(Scenery(i).Color) + destClr = applyBlend(destClr) + Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) + If colorMode = 1 Then Scenery(i).selected = 2 + colored = True + End If + End If + End If + Next + + End If + + If colored Then + prompt = True + Render + End If + +End Sub + +Private Sub EditDepthMap(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim pNum As Integer + Dim destClr As TColor + Dim R As Integer + Dim edited As Boolean + + R = clrRadius * zoomFactor + + If numSelectedPolys > 0 And (showPolys Or showWireframe Or showPoints) Then + + For i = 1 To numSelectedPolys + pNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(pNum).vertex(j) = 1 Then + If nearCoord(X, Polys(pNum).vertex(j).X, R) And nearCoord(Y, Polys(pNum).vertex(j).Y, R) Then + If (Polys(pNum).vertex(j).X - X) ^ 2 + (Polys(pNum).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then + Polys(pNum).vertex(j).z = Polys(pNum).vertex(j).z * (1 - opacity) + polyClr.red * opacity + If colorMode = 1 Then vertexList(pNum).vertex(j) = 3 + edited = True + End If + End If + End If + Next + Next + + ElseIf (showPolys Or showWireframe Or showPoints) And numSelectedScenery = 0 Then + + For i = 1 To polyCount + For j = 1 To 3 + If vertexList(i).vertex(j) = 0 Then + If nearCoord(X, Polys(i).vertex(j).X, R) And nearCoord(Y, Polys(i).vertex(j).Y, R) Then + If (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then + Polys(i).vertex(j).z = Polys(i).vertex(j).z * (1 - opacity) + polyClr.red * opacity + If colorMode = 1 Then vertexList(i).vertex(j) = 2 + edited = True + End If + End If + End If + Next + Next + + End If + + If edited Then + prompt = True + Render + End If + +End Sub + +Private Sub ColorPicker(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim shortestDist As Integer, currentDist As Integer + Dim pNum As Integer, vNum As Integer + Dim tempClr As TColor + + If showPolys Or showWireframe Or showPoints Then + + shortestDist = 32 ^ 2 + 1 + For i = 1 To polyCount + If pointInPoly(X, Y, i) Then + For j = 1 To 3 + If nearCoord(X, Polys(i).vertex(j).X, 32) And nearCoord(Y, Polys(i).vertex(j).Y, 32) Then + currentDist = (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + pNum = i + vNum = j + End If + End If + Next + End If + Next + + End If + + If vNum > 0 Then 'poly color absorbed + tempClr = vertexList(pNum).color(vNum) + If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then + + ElseIf frmPalette.Enabled = False Then 'non modal + frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue + Else + polyClr = tempClr + Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) + frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue + frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue + End If + ElseIf showScenery Then 'no poly clrs absorbed, do scenery + For i = 1 To sceneryCount + If PointInProp(X, Y, i) And vNum = 0 Then + vNum = i + End If + Next + If vNum > 0 Then + tempClr = getRGB(Scenery(vNum).Color) + If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then + + ElseIf frmPalette.Enabled = False Then 'non modal + frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue + Else + polyClr = tempClr + Scenery(0).Color = ARGB(Scenery(0).alpha, Scenery(vNum).Color) + frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue + frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue + End If + End If + End If + +End Sub + +Private Sub depthPicker(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim shortestDist As Integer, currentDist As Integer + Dim pNum As Integer, vNum As Integer + + If showPolys Or showWireframe Or showPoints Then + + shortestDist = 32 ^ 2 + 1 + For i = 1 To polyCount + If pointInPoly(X, Y, i) Then + For j = 1 To 3 + If nearCoord(X, Polys(i).vertex(j).X, 32) And nearCoord(Y, Polys(i).vertex(j).Y, 32) Then + currentDist = (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + pNum = i + vNum = j + End If + End If + Next + End If + Next + + End If + + If vNum > 0 Then 'poly color absorbed + If Polys(pNum).vertex(vNum).z >= 0 And Polys(pNum).vertex(vNum).z <= 255 Then + polyClr.red = Polys(pNum).vertex(vNum).z + ElseIf Polys(pNum).vertex(vNum).z < 0 Then + polyClr.red = 0 + ElseIf Polys(pNum).vertex(vNum).z > 255 Then + polyClr.red = 255 + End If + polyClr.green = polyClr.red + polyClr.blue = polyClr.red + Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) + frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue + frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue + End If + +End Sub + +Private Sub lightPicker(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim shortestDist As Integer, currentDist As Integer + Dim pNum As Integer, vNum As Integer + Dim tempClr As TColor + + If showPolys Or showWireframe Or showPoints Then + + shortestDist = 32 ^ 2 + 1 + For i = 1 To polyCount + If pointInPoly(X, Y, i) Then + For j = 1 To 3 + If nearCoord(X, Polys(i).vertex(j).X, 32) And nearCoord(Y, Polys(i).vertex(j).Y, 32) Then + currentDist = (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + pNum = i + vNum = j + End If + End If + Next + End If + Next + + End If + + If vNum > 0 Then 'poly color absorbed + + tempClr = getRGB(Polys(pNum).vertex(vNum).Color) + If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then + + ElseIf frmPalette.Enabled = False Then 'non modal + frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue + Else + polyClr = tempClr + Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) + frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue + frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue + End If + + End If + +End Sub + +Private Sub StretchingTexture(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim PolyNum As Integer + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + Polys(PolyNum).vertex(j).tu = (Polys(PolyNum).vertex(j).tu - (X - moveCoords(1).X) / zoomFactor / xTexture) + Polys(PolyNum).vertex(j).tv = (Polys(PolyNum).vertex(j).tv - (Y - moveCoords(1).Y) / zoomFactor / yTexture) + End If + Next + Next + moveCoords(1).X = X + moveCoords(1).Y = Y + prompt = True + End If + + getInfo + + Render + +End Sub + +Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + Dim i As Integer, j As Integer + + If Button = 4 Then + SetCursor currentFunction + 1 + End If + + If Button <> 1 Then + Exit Sub + End If + + If spaceDown Then + + Render + + ElseIf currentFunction = TOOL_MOVE And toolAction Then 'snap selected vertex + + If Shift = KEY_SHIFT Then 'constrained, don't snap + Else + snapSelected X, Y + If noneSelected Then + mnuDeselect_Click + noneSelected = False + End If + End If + + If lightCount > 0 And showLights Then + If numSelLights > 0 Then + applyLights + Render + ElseIf numSelectedPolys > 0 Then + applyLights True + Render + End If + End If + + SaveUndo + + ElseIf currentFunction = TOOL_SCALE And toolAction Then 'apply scaling + + If Shift = KEY_CTRL Then + ApplyTransform False + ElseIf Shift = KEY_SHIFT + KEY_CTRL Then 'constrained scaling + ApplyTransform False + End If + + ElseIf currentFunction = TOOL_ROTATE And toolAction Then 'apply rotation + + If Shift = KEY_ALT Then + ApplyTransform True + ElseIf Shift = KEY_SHIFT + KEY_ALT Then 'constrained rotation + ApplyTransform True + End If + + ElseIf (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) And toolAction Then 'create polys + + If Shift = KEY_SHIFT And numVerts > 0 Then + X = Polys(polyCount + 1).vertex(numVerts + 1).X + Y = Polys(polyCount + 1).vertex(numVerts + 1).Y + End If + CreatePolys X, Y + + ElseIf currentFunction = TOOL_SCENERY And toolAction Then 'create scenery + + CreateScenery X, Y + + ElseIf currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB Then 'select vertices + + If toolAction Then + selectedCoords(2).X = X + selectedCoords(2).Y = Y + eraseLines = False + noRedraw = True + If selectedCoords(2).X = selectedCoords(1).X And selectedCoords(2).Y = selectedCoords(1).Y Then + regionSelection X, Y + Else + VertexSelection X, Y + End If + noRedraw = False + selectedCoords(1).X = X + selectedCoords(1).Y = Y + Render + If numSelectedPolys = 0 And numSelectedScenery = 0 And numSelLights = 0 And numSelSpawns = 0 And numSelWaypoints = 0 And numSelColliders = 1 Then + For i = 1 To colliderCount + If Colliders(i).active = 1 Then + frmPalette.txtRadius.Text = LTrim$(Str$(Colliders(i).radius)) + setRadius CInt(Colliders(i).radius) + End If + Next + End If + End If + + ElseIf currentFunction = TOOL_PSELECT And toolAction Then 'poly selection + + ElseIf currentFunction = TOOL_VCOLOR And toolAction Then 'vertex coloring + + toolAction = False + If colorMode = 1 Then + For i = 1 To polyCount + For j = 1 To 3 + If vertexList(i).vertex(j) > 1 Then + vertexList(i).vertex(j) = vertexList(i).vertex(j) - 2 + End If + Next + Next + For i = 1 To sceneryCount + If Scenery(i).selected > 1 Then + Scenery(i).selected = Scenery(i).selected - 2 + End If + Next + End If + SaveUndo + + ElseIf currentFunction = TOOL_PCOLOR And toolAction Then 'poly color + + ElseIf currentFunction = TOOL_TEXTURE And toolAction Then 'texture + + SaveUndo + + ElseIf currentFunction = TOOL_OBJECTS And toolAction Then 'objects + + SaveUndo + + ElseIf currentFunction = TOOL_WAYPOINT And toolAction Then 'waypoints + + SaveUndo + + ElseIf currentFunction = TOOL_CONNECT And toolAction Then + + CreateConnection X, Y + + ElseIf currentFunction = TOOL_SKETCH Then + + If Shift = 0 And toolAction Then 'freeform + endSketch X, Y + toolAction = False + ElseIf Shift = 1 Then 'lines + If toolAction Then + lineSketch X, Y + Else + toolAction = True + End If + sketch(0).vertex(1).X = X / zoomFactor + scrollCoords(2).X + sketch(0).vertex(1).Y = Y / zoomFactor + scrollCoords(2).Y + sketch(0).vertex(2).X = X / zoomFactor + scrollCoords(2).X + sketch(0).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y + End If + + deleteSmallLines + + ElseIf currentFunction = TOOL_ERASER Then + + toolAction = False + + ElseIf currentFunction = TOOL_DEPTHMAP Then + + toolAction = False + If colorMode = 1 Then + For i = 1 To polyCount + For j = 1 To 3 + If vertexList(i).vertex(j) > 1 Then + vertexList(i).vertex(j) = vertexList(i).vertex(j) - 2 + End If + Next + Next + End If + SaveUndo + + End If + + If currentFunction <> TOOL_CREATE And currentFunction <> TOOL_QUAD And currentFunction <> TOOL_SKETCH And currentFunction <> TOOL_SCENERY Then + If numVerts = 0 Then + toolAction = False + End If + End If + + If noneSelected Then + mnuDeselect_Click + noneSelected = False + End If + + If numSelWaypoints = 0 And frmWaypoints.Visible = True Then + frmWaypoints.ClearWaypt + End If + + selectedCoords(1).X = 0 + selectedCoords(1).Y = 0 + selectedCoords(2).X = 0 + selectedCoords(2).Y = 0 + +End Sub + +Private Sub CreateConnection(X As Single, Y As Single) + + Dim i As Integer + Dim notSel As Integer + Dim currentDist As Long, shortestDist As Long + Dim xVal As Single, yVal As Single + + xVal = X / zoomFactor + scrollCoords(2).X + yVal = Y / zoomFactor + scrollCoords(2).Y + + notSel = 0 + shortestDist = (8 ^ 2 + 1) + For i = 1 To waypointCount + If (Waypoints(i).pathNum = 1 And frmWaypoints.showPaths <> 2) Or (Waypoints(i).pathNum = 2 And frmWaypoints.showPaths <> 1) Then + If nearCoord(xVal, Waypoints(i).X, 8 / zoomFactor) And nearCoord(yVal, Waypoints(i).Y, 8 / zoomFactor) Then + currentDist = (Waypoints(i).X - xVal) ^ 2 + (Waypoints(i).Y - yVal) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + notSel = i + End If + End If + End If + Next + If notSel > 0 And currentWaypoint <> notSel Then + If currentWaypoint > 0 Then 'connecting waypoints + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + conCount = conCount + 1 + ReDim Preserve Connections(conCount) + Connections(conCount).point1 = currentWaypoint + Connections(conCount).point2 = notSel + Waypoints(currentWaypoint).numConnections = Waypoints(currentWaypoint).numConnections + 1 + SaveUndo + End If + currentWaypoint = notSel + ElseIf notSel > 0 Then + currentWaypoint = notSel + Else + currentWaypoint = 0 + For i = 1 To waypointCount + Waypoints(i).selected = False + Next + numSelWaypoints = 0 + End If + + getInfo + Render + +End Sub + +Private Sub CreatePolys(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim xVal As Single, yVal As Single + Dim shortestDist As Integer, currentDist As Long + Dim temp As D3DVECTOR2 + Dim tempVertex As TCustomVertex + + If numVerts = 0 Then + ReDim Preserve Polys(polyCount + 1) + ReDim Preserve PolyCoords(polyCount + 1) + ReDim Preserve vertexList(polyCount + 1) + vertexList(polyCount + 1).polyType = polyType + End If + numVerts = numVerts + 1 + + xVal = X + yVal = Y + + If snapToGrid And showGrid Then + xVal = snapVertexToGrid(xVal, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + yVal = snapVertexToGrid(yVal, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + PolyCoords(polyCount + 1).vertex(numVerts).X = Int(xVal / zoomFactor + scrollCoords(2).X + 0.5) + PolyCoords(polyCount + 1).vertex(numVerts).Y = Int(yVal / zoomFactor + scrollCoords(2).Y + 0.5) + ElseIf ohSnap Then 'snap + shortestDist = snapRadius ^ 2 + 1 + For i = 1 To polyCount + For j = 1 To 3 + If nearCoord(xVal, Polys(i).vertex(j).X, shortestDist) And nearCoord(yVal, Polys(i).vertex(j).Y, shortestDist) Then + currentDist = ((Polys(i).vertex(j).X - xVal) ^ 2 + (Polys(i).vertex(j).Y - yVal) ^ 2) + If currentDist < shortestDist Then + shortestDist = currentDist + xVal = Polys(i).vertex(j).X + yVal = Polys(i).vertex(j).Y + PolyCoords(polyCount + 1).vertex(numVerts).X = PolyCoords(i).vertex(j).X + PolyCoords(polyCount + 1).vertex(numVerts).Y = PolyCoords(i).vertex(j).Y + End If + End If + Next + Next + End If + + If (xVal = X And yVal = Y) Or (Not ohSnap And Not snapToGrid) Then 'no snapping occured + PolyCoords(polyCount + 1).vertex(numVerts).X = Int(xVal / zoomFactor + scrollCoords(2).X + 0.5) + PolyCoords(polyCount + 1).vertex(numVerts).Y = Int(yVal / zoomFactor + scrollCoords(2).Y + 0.5) + End If + + Polys(polyCount + 1).vertex(numVerts) = CreateCustomVertex(xVal, yVal, _ + 0, 1, ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)), _ + (xVal / zoomFactor + scrollCoords(2).X) / xTexture, (yVal / zoomFactor + scrollCoords(2).Y) / yTexture) + vertexList(polyCount + 1).color(numVerts).red = polyClr.red + vertexList(polyCount + 1).color(numVerts).green = polyClr.green + vertexList(polyCount + 1).color(numVerts).blue = polyClr.blue + + If mnuQuad.Checked And mnuCustomX.Checked Then + If creatingQuad Then + Polys(polyCount + 1).vertex(numVerts).tu = (frmTexture.x1tex * 2 + 0.5) / xTexture + Else + If numVerts = 2 Or numVerts = 3 Then + Polys(polyCount + 1).vertex(numVerts).tu = (frmTexture.x2tex * 2 - 0.5) / xTexture + Else + Polys(polyCount + 1).vertex(numVerts).tu = (frmTexture.x1tex * 2 + 0.5) / xTexture + End If + End If + End If + + If mnuQuad.Checked And mnuCustomY.Checked Then + If creatingQuad Then + Polys(polyCount + 1).vertex(numVerts).tv = (frmTexture.y2tex * 2 - 0.5) / yTexture + Else + If numVerts > 2 Then + Polys(polyCount + 1).vertex(numVerts).tv = (frmTexture.y2tex * 2 - 0.5) / yTexture + Else + Polys(polyCount + 1).vertex(numVerts).tv = (frmTexture.y1tex * 2 + 0.5) / yTexture + End If + End If + End If + + + If numVerts = 1 Then + Polys(polyCount + 1).vertex(2) = Polys(polyCount + 1).vertex(1) + Polys(polyCount + 1).vertex(numVerts + 1).X = X + Polys(polyCount + 1).vertex(numVerts + 1).Y = Y + Polys(polyCount + 1).vertex(numVerts + 2) = Polys(polyCount + 1).vertex(1) + PolyCoords(polyCount + 1).vertex(numVerts + 2) = PolyCoords(polyCount + 1).vertex(1) + ElseIf numVerts = 3 Then + numVerts = 0 + polyCount = polyCount + 1 + If Not isCW(polyCount) Then 'switch to make cw + temp = PolyCoords(polyCount).vertex(3) + PolyCoords(polyCount).vertex(3) = PolyCoords(polyCount).vertex(2) + PolyCoords(polyCount).vertex(2) = temp + + tempVertex = Polys(polyCount).vertex(3) + Polys(polyCount).vertex(3) = Polys(polyCount).vertex(2) + Polys(polyCount).vertex(2) = tempVertex + End If + toolAction = False + frmInfo.lblCount(0).Caption = polyCount + frmInfo.lblCount(6).Caption = getMapDimensions + + applyLightsToVert CInt(polyCount), 1 + applyLightsToVert CInt(polyCount), 2 + applyLightsToVert CInt(polyCount), 3 + + Polys(polyCount).Perp.vertex(1).z = 2 + Polys(polyCount).Perp.vertex(2).z = 2 + Polys(polyCount).Perp.vertex(3).z = 2 + + SaveUndo + If mnuQuad.Checked And Not creatingQuad Then + ReDim Preserve Polys(polyCount + 1) + ReDim Preserve PolyCoords(polyCount + 1) + ReDim Preserve vertexList(polyCount + 1) + vertexList(polyCount + 1).polyType = polyType + Polys(polyCount + 1).vertex(1) = Polys(polyCount).vertex(1) + Polys(polyCount + 1).vertex(2) = Polys(polyCount).vertex(3) + PolyCoords(polyCount + 1).vertex(1) = PolyCoords(polyCount).vertex(1) + PolyCoords(polyCount + 1).vertex(2) = PolyCoords(polyCount).vertex(3) + vertexList(polyCount + 1).color(1) = vertexList(polyCount).color(1) + vertexList(polyCount + 1).color(2) = vertexList(polyCount).color(3) + numVerts = 2 + Polys(polyCount + 1).vertex(3) = Polys(polyCount).vertex(3) + PolyCoords(polyCount + 1).vertex(3) = PolyCoords(polyCount).vertex(3) + toolAction = True + creatingQuad = True + ElseIf creatingQuad Then + creatingQuad = False + End If + prompt = True + End If + + Render + +End Sub + +Private Sub startSketch(X As Single, Y As Single) + + On Error GoTo ErrorHandler + + showSketch = True + frmDisplay.setLayer 10, showSketch + + sketchLines = sketchLines + 1 + ReDim Preserve sketch(sketchLines) + + sketch(sketchLines).vertex(1).X = X / zoomFactor + scrollCoords(2).X + sketch(sketchLines).vertex(1).Y = Y / zoomFactor + scrollCoords(2).Y + sketch(sketchLines).vertex(2).X = sketch(sketchLines).vertex(1).X + sketch(sketchLines).vertex(2).Y = sketch(sketchLines).vertex(1).Y + + sketch(sketchLines).vertex(1).z = 1 + sketch(sketchLines).vertex(2).z = 1 + + Render + + Exit Sub + +ErrorHandler: + + MsgBox "Error starting sketch" & vbNewLine & Error$ + +End Sub + +Private Sub lineSketch(X As Single, Y As Single) + + On Error GoTo ErrorHandler + + sketchLines = sketchLines + 1 + ReDim Preserve sketch(sketchLines) + + sketch(sketchLines).vertex(1).X = sketch(0).vertex(1).X + sketch(sketchLines).vertex(1).Y = sketch(0).vertex(1).Y + sketch(sketchLines).vertex(2).X = Int(X / zoomFactor + scrollCoords(2).X + 0.5) + sketch(sketchLines).vertex(2).Y = Int(Y / zoomFactor + scrollCoords(2).Y + 0.5) + + sketch(sketchLines).vertex(1).z = 1 + sketch(sketchLines).vertex(2).z = 1 + + Exit Sub + +ErrorHandler: + + MsgBox "Error sketching line" & vbNewLine & Error$ + +End Sub + +Private Sub linkSketch(X As Single, Y As Single) + + Dim xVal As Single, yVal As Single + + On Error GoTo ErrorHandler + + xVal = X / zoomFactor + scrollCoords(2).X + yVal = Y / zoomFactor + scrollCoords(2).Y + + If (xVal - sketch(sketchLines).vertex(1).X) ^ 2 + (yVal - sketch(sketchLines).vertex(1).Y) ^ 2 > 16 ^ 2 Then + + sketch(sketchLines).vertex(2).X = X / zoomFactor + scrollCoords(2).X + sketch(sketchLines).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y + + sketchLines = sketchLines + 1 + ReDim Preserve sketch(sketchLines) + + sketch(sketchLines).vertex(1).X = X / zoomFactor + scrollCoords(2).X + sketch(sketchLines).vertex(1).Y = Y / zoomFactor + scrollCoords(2).Y + sketch(sketchLines).vertex(2).X = X / zoomFactor + scrollCoords(2).X + sketch(sketchLines).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y + + sketch(sketchLines).vertex(1).z = 1 + sketch(sketchLines).vertex(2).z = 1 + + End If + + Exit Sub + +ErrorHandler: + + MsgBox "Error linking sketch" & vbNewLine & Error$ + +End Sub + +Private Sub endSketch(X As Single, Y As Single) + + sketch(sketchLines).vertex(2).X = X / zoomFactor + scrollCoords(2).X + sketch(sketchLines).vertex(2).Y = Y / zoomFactor + scrollCoords(2).Y + + Render + + Exit Sub +ErrorHandler: + MsgBox "Error ending sketch" & vbNewLine & Error$ + +End Sub + +Private Sub CreateScenery(X As Single, Y As Single) + + Dim xVal As Integer, yVal As Integer + Dim i As Integer + + On Error GoTo ErrorHandler + + If numCorners = 0 Then + Scenery(0).screenTr.X = X + Scenery(0).screenTr.Y = Y + End If + + numCorners = numCorners + 1 + + xVal = (Scenery(0).screenTr.X) + yVal = (Scenery(0).screenTr.Y) + + If snapToGrid And showGrid Then + + xVal = snapVertexToGrid(xVal, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + yVal = snapVertexToGrid(yVal, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + + If numCorners = 1 Then + Scenery(0).screenTr.X = xVal + Scenery(0).screenTr.Y = yVal + ElseIf numCorners = 2 Then + + End If + + End If + + If numCorners = 1 And Not frmScenery.rotateScenery Then numCorners = numCorners + 1 + If numCorners = 2 And Not frmScenery.scaleScenery Then numCorners = numCorners + 1 + + If numCorners = 3 Then + + sceneryCount = sceneryCount + 1 + ReDim Preserve Scenery(sceneryCount) + + Scenery(sceneryCount) = Scenery(0) + Scenery(sceneryCount).Translation.X = Int(Scenery(0).screenTr.X / zoomFactor + scrollCoords(2).X + 0.5) + Scenery(sceneryCount).Translation.Y = Int(Scenery(0).screenTr.Y / zoomFactor + scrollCoords(2).Y + 0.5) + + If Scenery(0).Style = 0 Then 'create scenery texture + CreateSceneryTexture currentScenery + Scenery(0).Style = sceneryElements + Scenery(sceneryCount).Style = sceneryElements + frmScenery.notClicked = True + End If + + setCurrentScenery + frmInfo.lblCount(1).Caption = sceneryCount & "/500 (" & sceneryElements & ")" + numCorners = 0 + + prompt = True + SaveUndo + + End If + + Exit Sub + +ErrorHandler: + + MsgBox "Error creating scenery" & vbNewLine & Error$ + +End Sub + +Private Sub snapSelected(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim PolyNum As Integer + Dim xVal As Single, yVal As Single + Dim temp As D3DVECTOR2 + Dim tempVertex As TCustomVertex + Dim shortestDist As Single, currentDist As Single + Dim xDiff As Single, yDiff As Single + + 'make sure polys are cw + For i = 1 To numSelectedPolys + If Not isCW(selectedPolys(i)) Then 'switch to make cw + temp = PolyCoords(selectedPolys(i)).vertex(3) + PolyCoords(selectedPolys(i)).vertex(3) = PolyCoords(selectedPolys(i)).vertex(2) + PolyCoords(selectedPolys(i)).vertex(2) = temp + + tempVertex = Polys(selectedPolys(i)).vertex(3) + Polys(selectedPolys(i)).vertex(3) = Polys(selectedPolys(i)).vertex(2) + Polys(selectedPolys(i)).vertex(2) = tempVertex + + PolyNum = vertexList(selectedPolys(i)).vertex(3) + vertexList(selectedPolys(i)).vertex(3) = vertexList(selectedPolys(i)).vertex(2) + vertexList(selectedPolys(i)).vertex(2) = PolyNum + + PolyNum = 0 + End If + Next + + 'if grid is on, snap to grid + 'else, if vert snapping is on then snap to verts + + 'find which vertex of poly is selected + PolyNum = 0 + If numSelectedPolys > 0 Then + For j = 1 To 3 + If vertexList(selectedPolys(1)).vertex(j) = 1 Then 'which vertex in poly is selected + If PolyNum > 0 And Not (snapToGrid And showGrid) Then 'if more than one vertex in poly selected + Render + Exit Sub + Else + PolyNum = j + End If + End If + Next + + xVal = (Polys(selectedPolys(1)).vertex(PolyNum).X) + yVal = (Polys(selectedPolys(1)).vertex(PolyNum).Y) + Else + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + xVal = Scenery(i).screenTr.X + yVal = Scenery(i).screenTr.Y + Exit For + End If + Next + End If + + If snapToGrid And showGrid Then + + xDiff = xVal - snapVertexToGrid(xVal, (scrollCoords(2).X - Int(scrollCoords(2).X / inc) * inc) * zoomFactor) + yDiff = yVal - snapVertexToGrid(yVal, (scrollCoords(2).Y - Int(scrollCoords(2).Y / inc) * inc) * zoomFactor) + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then 'if selected + Polys(PolyNum).vertex(j).X = Polys(PolyNum).vertex(j).X - xDiff + Polys(PolyNum).vertex(j).Y = Polys(PolyNum).vertex(j).Y - yDiff + + PolyCoords(PolyNum).vertex(j).X = Int(Polys(PolyNum).vertex(j).X / zoomFactor + scrollCoords(2).X + 0.5) + PolyCoords(PolyNum).vertex(j).Y = Int(Polys(PolyNum).vertex(j).Y / zoomFactor + scrollCoords(2).Y + 0.5) + + If fixedTexture Then + Polys(PolyNum).vertex(j).tu = PolyCoords(PolyNum).vertex(j).X / xTexture + Polys(PolyNum).vertex(j).tv = PolyCoords(PolyNum).vertex(j).Y / yTexture + End If + End If + Next + Next + End If + + If numSelectedScenery > 0 Then + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + Scenery(i).screenTr.X = Scenery(i).screenTr.X - xDiff + Scenery(i).screenTr.Y = Scenery(i).screenTr.Y - yDiff + + Scenery(i).Translation.X = Int(Scenery(i).screenTr.X / zoomFactor + scrollCoords(2).X + 0.5) + Scenery(i).Translation.Y = Int(Scenery(i).screenTr.Y / zoomFactor + scrollCoords(2).Y + 0.5) + End If + Next + End If + + If numSelSpawns > 0 Then + For i = 1 To spawnPoints + If Spawns(i).active = 1 Then + Spawns(i).X = Int((Spawns(i).X + inc / 2) / inc) * inc + Spawns(i).Y = Int((Spawns(i).Y + inc / 2) / inc) * inc + End If + Next + End If + + If numSelColliders > 0 Then + For i = 1 To colliderCount + If Colliders(i).active = 1 Then + Colliders(i).X = Int((Colliders(i).X + inc / 2) / inc) * inc + Colliders(i).Y = Int((Colliders(i).Y + inc / 2) / inc) * inc + End If + Next + End If + + If numSelLights > 0 Then + For i = 1 To lightCount + If Lights(i).selected Then + Lights(i).X = Int((Lights(i).X + inc / 2) / inc) * inc + Lights(i).Y = Int((Lights(i).Y + inc / 2) / inc) * inc + End If + Next + End If + + rCenter.X = rCenter.X - xDiff / zoomFactor + rCenter.Y = rCenter.Y - yDiff / zoomFactor + For i = 0 To 3 + selRect(i).X = selRect(i).X - xDiff / zoomFactor + selRect(i).Y = selRect(i).Y - yDiff / zoomFactor + Next + + ElseIf ohSnap And numSelectedPolys > 0 Then + + 'if vertices with different coords are selected then exit sub + If numSelectedPolys > 1 Then 'check if any different coords + For i = 2 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then 'if selected and has same coords + If Polys(selectedPolys(i)).vertex(j).X <> xVal Or Polys(selectedPolys(i)).vertex(j).Y <> yVal Then + Render + Exit Sub + End If + End If + Next + Next + End If + + 'snap + shortestDist = snapRadius ^ 2 + 1 + For i = 1 To polyCount + For j = 1 To 3 + If nearCoord(xVal, Polys(i).vertex(j).X, shortestDist) And nearCoord(yVal, Polys(i).vertex(j).Y, shortestDist) Then + currentDist = (Polys(i).vertex(j).X - xVal) ^ 2 + (Polys(i).vertex(j).Y - yVal) ^ 2 + If currentDist <= shortestDist And vertexList(i).vertex(j) = 0 Then + shortestDist = currentDist + xDiff = xVal - Polys(i).vertex(j).X + yDiff = yVal - Polys(i).vertex(j).Y + xVal = Polys(i).vertex(j).X + yVal = Polys(i).vertex(j).Y + End If + End If + Next + Next + + 'if snapping occured + If xVal <> (Polys(selectedPolys(1)).vertex(PolyNum).X) Or yVal <> (Polys(selectedPolys(1)).vertex(PolyNum).Y) Then + For i = 1 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then + Polys(selectedPolys(i)).vertex(j).X = xVal + Polys(selectedPolys(i)).vertex(j).Y = yVal + + PolyCoords(selectedPolys(i)).vertex(j).X = (xVal / zoomFactor + scrollCoords(2).X) + PolyCoords(selectedPolys(i)).vertex(j).Y = (yVal / zoomFactor + scrollCoords(2).Y) + + End If + Next + Next + rCenter.X = rCenter.X - xDiff / zoomFactor + rCenter.Y = rCenter.Y - yDiff / zoomFactor + For i = 0 To 3 + selRect(i).X = selRect(i).X - xDiff / zoomFactor + selRect(i).Y = selRect(i).Y - yDiff / zoomFactor + Next + End If + + PolyNum = 0 + + End If + + getInfo + + Render + +End Sub + +Private Sub regionSelection(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim xVal As Single, yVal As Single + Dim isSelected As Boolean + + xVal = X / zoomFactor + scrollCoords(2).X + yVal = Y / zoomFactor + scrollCoords(2).Y + + If currentFunction = TOOL_VSELECT Then + numSelectedPolys = 0 + ReDim selectedPolys(numSelectedPolys) + numSelectedScenery = 0 + numSelSpawns = 0 + numSelColliders = 0 + numSelWaypoints = 0 + numSelLights = 0 + For i = 1 To sceneryCount + Scenery(i).selected = 0 + Next + End If + + If showPolys Or showWireframe Or showPoints Then + isSelected = RegionSelPolys(X, Y) + ElseIf currentFunction = TOOL_VSELECT Then + For i = 1 To polyCount + vertexList(i).vertex(1) = 0 + vertexList(i).vertex(2) = 0 + vertexList(i).vertex(3) = 0 + Next + End If + If showObjects Then + isSelected = RegionSelObjects(xVal, yVal, isSelected) + ElseIf currentFunction = TOOL_VSELECT Then + For i = 1 To spawnPoints + Spawns(i).active = 0 + Next + For i = 1 To colliderCount + Colliders(i).active = 0 + Next + End If + If showWaypoints Then + isSelected = RegionSelWaypoints(xVal, yVal, isSelected) + Else + For i = 1 To waypointCount + Waypoints(i).selected = False + Next + End If + If showLights Then + isSelected = regionSelLights(xVal, yVal, isSelected) + ElseIf currentFunction = TOOL_VSELECT Then + For i = 1 To lightCount + Lights(i).selected = 0 + Next + End If + + currentWaypoint = 0 + + selectedCoords(1).X = 0 + selectedCoords(1).Y = 0 + selectedCoords(2).X = 0 + selectedCoords(2).Y = 0 + + getRCenter + getInfo + selectionChanged = True + Render + +End Sub + +Private Function RegionSelPolys(X As Single, Y As Single) As Boolean + + Dim i As Integer, j As Integer + Dim currentDist As Long, shortestDist As Long + Dim pIndex As Integer, vIndex As Integer + Dim selVerts As Byte, selected As Byte + Dim xVal As Single, yVal As Single + + xVal = X / zoomFactor + scrollCoords(2).X + yVal = Y / zoomFactor + scrollCoords(2).Y + + For i = 1 To polyCount + + If currentFunction = TOOL_VSELECT Then + vertexList(i).vertex(1) = 0 + vertexList(i).vertex(2) = 0 + vertexList(i).vertex(3) = 0 + End If + + If (pointInPoly(X, Y, i)) Then + shortestDist = 64 ^ 2 + 1 + For j = 1 To 3 + currentDist = (PolyCoords(i).vertex(j).X - xVal) ^ 2 + (PolyCoords(i).vertex(j).Y - yVal) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + pIndex = i + vIndex = j + End If + Next + If pIndex > 0 And vIndex > 0 Then + If (currentFunction = TOOL_VSELADD And vertexList(pIndex).vertex(vIndex) = 1) Or (currentFunction = TOOL_VSELSUB And vertexList(pIndex).vertex(vIndex) = 0) Then + pIndex = 0 + vIndex = 0 + ElseIf currentFunction <> TOOL_VSELECT Then + Exit For + End If + End If + End If + + Next + + If pIndex > 0 And vIndex > 0 Then + If currentFunction = TOOL_VSELECT Then + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = pIndex + vertexList(pIndex).vertex(vIndex) = 1 + RegionSelPolys = True + ElseIf currentFunction = TOOL_VSELADD Then + For j = 1 To 3 + selVerts = selVerts + vertexList(pIndex).vertex(j) + Next + If selVerts > 0 Then 'poly already selected + vertexList(pIndex).vertex(vIndex) = 1 + Else + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = pIndex + vertexList(pIndex).vertex(vIndex) = 1 + End If + RegionSelPolys = True + ElseIf currentFunction = TOOL_VSELSUB Then + vertexList(pIndex).vertex(vIndex) = 0 + For i = 1 To numSelectedPolys + For j = 1 To 3 + selVerts = selVerts + vertexList(selectedPolys(i)).vertex(j) + Next + If selVerts = 0 Then 'no longer selected, put last here and shorten array + selectedPolys(i) = selectedPolys(numSelectedPolys) + numSelectedPolys = numSelectedPolys - 1 + End If + selVerts = 0 + Next + ReDim Preserve selectedPolys(numSelectedPolys) + RegionSelPolys = True + End If + End If + +End Function + +Private Function RegionSelObjects(xVal As Single, yVal As Single, skipSel As Boolean) As Boolean + + Dim i As Integer, j As Integer + Dim currentDist As Long, shortestDist As Long + Dim Index As Integer + + shortestDist = (8 ^ 2 + 1) + For i = 1 To spawnPoints + If currentFunction = TOOL_VSELECT Then Spawns(i).active = 0 + If nearCoord(xVal, Spawns(i).X, 8 / zoomFactor) And nearCoord(yVal, Spawns(i).Y, 8 / zoomFactor) Then + currentDist = (Spawns(i).X - xVal) ^ 2 + (Spawns(i).Y - yVal) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + Index = i + End If + End If + Next + + If Index > 0 Then + If currentFunction = TOOL_VSELECT Then + Spawns(Index).active = 1 + numSelSpawns = numSelSpawns + 1 + skipSel = True + ElseIf currentFunction = TOOL_VSELADD Then + Spawns(Index).active = 1 + numSelSpawns = numSelSpawns + 1 + skipSel = True + ElseIf currentFunction = TOOL_VSELSUB Then + Spawns(Index).active = 0 + numSelSpawns = numSelSpawns - 1 + skipSel = True + End If + End If + + shortestDist = 64 ^ 2 + 1 + For i = 1 To colliderCount + If currentFunction = TOOL_VSELECT Then Colliders(i).active = 0 + If nearCoord(xVal, Colliders(i).X, Colliders(i).radius / 2) And nearCoord(yVal, Colliders(i).Y, Colliders(i).radius / 2) Then + currentDist = (Colliders(i).X - xVal) ^ 2 + (Colliders(i).Y - yVal) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + Index = i + End If + End If + Next + + If Index > 0 And Not skipSel Then + If currentFunction = TOOL_VSELECT Then + Colliders(Index).active = 1 + numSelColliders = numSelColliders + 1 + skipSel = True + ElseIf currentFunction = TOOL_VSELADD Then + Colliders(Index).active = 1 + numSelColliders = numSelColliders + 1 + skipSel = True + ElseIf currentFunction = TOOL_VSELSUB Then + Colliders(Index).active = 0 + numSelColliders = numSelColliders - 1 + skipSel = True + End If + End If + + RegionSelObjects = skipSel + +End Function + +Private Function regionSelLights(xVal As Single, yVal As Single, skipSel As Boolean) As Boolean + + Dim i As Integer, j As Integer + Dim currentDist As Long, shortestDist As Long + Dim Index As Integer + + shortestDist = (8 ^ 2 + 1) + For i = 1 To lightCount + If currentFunction = TOOL_VSELECT Then Lights(i).selected = 0 + If nearCoord(xVal, Lights(i).X, 8 / zoomFactor) And nearCoord(yVal, Lights(i).Y, 8 / zoomFactor) Then + currentDist = (Lights(i).X - xVal) ^ 2 + (Lights(i).Y - yVal) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + Index = i + End If + End If + Next + + If Index > 0 And Not skipSel Then + If currentFunction = TOOL_VSELECT Then + Lights(Index).selected = 1 + numSelLights = numSelLights + 1 + skipSel = True + ElseIf currentFunction = TOOL_VSELADD Then + Lights(Index).selected = 1 + numSelLights = numSelLights + 1 + skipSel = True + ElseIf currentFunction = TOOL_VSELSUB Then + Lights(Index).selected = 0 + numSelLights = numSelLights - 1 + skipSel = True + End If + End If + + regionSelLights = skipSel + +End Function + +Private Function RegionSelWaypoints(xVal As Single, yVal As Single, skipSel As Boolean) As Boolean + + Dim i As Integer, j As Integer + Dim currentDist As Long, shortestDist As Long + Dim Index As Integer + + shortestDist = (8 ^ 2 + 1) + For i = 1 To waypointCount + If currentFunction = TOOL_VSELECT Then Waypoints(i).selected = False + If (frmWaypoints.showPaths = Waypoints(i).pathNum) Or frmWaypoints.showPaths = 0 Then + If nearCoord(xVal, Waypoints(i).X, 8 / zoomFactor) And nearCoord(yVal, Waypoints(i).Y, 8 / zoomFactor) Then + currentDist = (Waypoints(i).X - xVal) ^ 2 + (Waypoints(i).Y - yVal) ^ 2 + If currentDist < shortestDist Then + shortestDist = currentDist + Index = i + End If + End If + End If + Next + + If Index > 0 And Not skipSel Then + If currentFunction = TOOL_VSELECT Then + Waypoints(Index).selected = True + numSelWaypoints = numSelWaypoints + 1 + ElseIf currentFunction = TOOL_VSELADD Then + Waypoints(Index).selected = True + numSelWaypoints = numSelWaypoints + 1 + ElseIf currentFunction = TOOL_VSELSUB Then + Waypoints(Index).selected = False + numSelWaypoints = numSelWaypoints - 1 + End If + End If + +End Function + +Private Function eraseSketch(X As Single, Y As Single) As Byte + + Dim i As Integer, j As Integer + Dim currentDist As Long, shortestDist As Long + Dim lineIndex As Integer + + On Error GoTo ErrorHandler + + eraseSketch = 0 + + shortestDist = clrRadius ^ 2 + 1 + For i = 1 To sketchLines + For j = 1 To 2 + currentDist = (X - sketch(i).vertex(j).X) ^ 2 + (Y - sketch(i).vertex(j).Y) ^ 2 + If (currentDist < shortestDist) Then + shortestDist = currentDist + lineIndex = i + End If + Next + Next + + If lineIndex > 0 Then + sketch(lineIndex) = sketch(sketchLines) + sketchLines = sketchLines - 1 + ReDim Preserve sketch(sketchLines) + Render + eraseSketch = 1 + End If + + Exit Function + +ErrorHandler: + + MsgBox "Error erasing sketch" & vbNewLine & Error$ + +End Function + +Private Function moveLines(X As Single, Y As Single, xDiff As Single, yDiff As Single) As Byte + + Dim i As Integer, j As Integer + Dim dist As Single + + On Error GoTo ErrorHandler + + xDiff = xDiff / zoomFactor + yDiff = yDiff / zoomFactor + + moveLines = 0 + + For i = 1 To sketchLines + For j = 1 To 2 + dist = (X - sketch(i).vertex(j).X) ^ 2 + (Y - sketch(i).vertex(j).Y) ^ 2 + If dist < clrRadius ^ 2 Then + sketch(i).vertex(j).X = sketch(i).vertex(j).X + xDiff * Cos((dist / (clrRadius ^ 2)) * pi / 2) + sketch(i).vertex(j).Y = sketch(i).vertex(j).Y + yDiff * Cos((dist / (clrRadius ^ 2)) * pi / 2) + moveLines = 1 + End If + Next + Next + + Exit Function + +ErrorHandler: + + MsgBox "Error moving sketch lines" & vbNewLine & Error$ + +End Function + +Private Sub deleteSmallLines() + + Dim i As Integer + + On Error GoTo ErrorHandler + + For i = 1 To sketchLines + If (Int(sketch(i).vertex(1).X + 0.5) = Int(sketch(i).vertex(2).X + 0.5)) And (Int(sketch(i).vertex(1).Y + 0.5) = Int(sketch(i).vertex(2).Y + 0.5)) Then + sketch(i) = sketch(sketchLines) + sketchLines = sketchLines - 1 + End If + Next + + ReDim Preserve sketch(sketchLines) + + Render + + Exit Sub + +ErrorHandler: + + MsgBox "Error deleting small sketch lines" & vbNewLine & Error$ + +End Sub + +Private Sub VertexSelection(X As Single, Y As Single) + + Dim i As Integer, j As Integer + + On Error GoTo ErrorHandler + + If currentFunction = TOOL_VSELECT Then + numSelectedPolys = 0 + ReDim selectedPolys(numSelectedPolys) + numSelectedScenery = 0 + numSelSpawns = 0 + numSelColliders = 0 + numSelWaypoints = 0 + ElseIf currentFunction = TOOL_VSELSUB Then + numSelectedPolys = 0 + ReDim selectedPolys(numSelectedPolys) + End If + + If showPolys Or showWireframe Or showPoints Then + VertexSelPolys + ElseIf currentFunction = TOOL_VSELECT Then + For i = 1 To polyCount + For j = 1 To 3 + vertexList(i).vertex(j) = 0 + Next + Next + End If + + If showScenery Then + VertexSelScenery + ElseIf currentFunction = TOOL_VSELECT Then + For i = 1 To sceneryCount + Scenery(i).selected = 0 + Next + End If + + If showObjects Then + VertexSelObjects + ElseIf currentFunction = TOOL_VSELECT Then + For i = 1 To spawnPoints + Spawns(i).active = 0 + Next + For i = 1 To colliderCount + Colliders(i).active = 0 + Next + End If + + If showWaypoints Then + VertexSelWaypoints + ElseIf currentFunction = TOOL_VSELECT Then + For i = 1 To waypointCount + Waypoints(i).selected = False + Next + End If + + If showLights Then + VertexSelLights + ElseIf currentFunction = TOOL_VSELECT Then + For i = 1 To lightCount + Lights(i).selected = 0 + Next + End If + + currentWaypoint = 0 + + selectedCoords(1).X = X + selectedCoords(1).Y = Y + selectedCoords(2).X = X + selectedCoords(2).Y = Y + + getRCenter + getInfo + selectionChanged = True + Render + + Exit Sub + +ErrorHandler: + + MsgBox "Error selecting vertices" & vbNewLine & Error$ + +End Sub + +Private Sub VertexSelPolys() + + Dim i As Integer, j As Integer + Dim addPoly As Integer, notSel As Integer + + If currentFunction = TOOL_VSELECT Then + + For i = 1 To polyCount + For j = 1 To 3 + vertexList(i).vertex(j) = 0 + If inSelRect(Polys(i).vertex(j).X, Polys(i).vertex(j).Y) Then + addPoly = 1 + vertexList(i).vertex(j) = 1 + End If + Next + If addPoly = 1 Then + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = i + End If + addPoly = 0 + notSel = 0 + Next + + ElseIf currentFunction = TOOL_VSELADD Then + + For i = 1 To polyCount + For j = 1 To 3 + If vertexList(i).vertex(j) = 0 Then + notSel = notSel + 1 + If inSelRect(Polys(i).vertex(j).X, Polys(i).vertex(j).Y) Then + addPoly = 1 + vertexList(i).vertex(j) = 1 + End If + End If + Next + If addPoly = 1 And notSel = 3 Then + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = i + End If + addPoly = 0 + notSel = 0 + Next + + ElseIf currentFunction = TOOL_VSELSUB Then + + For i = 1 To polyCount + For j = 1 To 3 + If vertexList(i).vertex(j) = 1 Then 'if already selected and if in range + If inSelRect(Polys(i).vertex(j).X, Polys(i).vertex(j).Y) Then + notSel = notSel + 1 + vertexList(i).vertex(j) = 0 + Else 'if already selected but not in range + addPoly = 1 + End If + End If + Next + If addPoly = 1 Then + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = i + End If + addPoly = 0 + notSel = 0 + Next + + End If + +End Sub + +Private Sub VertexSelScenery() + + Dim i As Integer, sVal As Integer + Dim sceneryCoords(3) As TCustomVertex + Dim selected(3) As Boolean + + For i = 1 To sceneryCount + sVal = Scenery(i).Style + + sceneryCoords(0).X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor + sceneryCoords(0).Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor + sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(i).rotation) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor + sceneryCoords(1).Y = sceneryCoords(0).Y - Sin(Scenery(i).rotation) * (SceneryTextures(sVal).Width) * Scenery(i).Scaling.X * zoomFactor + sceneryCoords(3).X = sceneryCoords(0).X + Sin(Scenery(i).rotation) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor + sceneryCoords(3).Y = sceneryCoords(0).Y + Cos(Scenery(i).rotation) * (SceneryTextures(sVal).Height) * Scenery(i).Scaling.Y * zoomFactor + sceneryCoords(2).X = sceneryCoords(3).X + sceneryCoords(1).X - sceneryCoords(0).X + sceneryCoords(2).Y = sceneryCoords(3).Y + sceneryCoords(1).Y - sceneryCoords(0).Y + + selected(0) = inSelRect(sceneryCoords(0).X, sceneryCoords(0).Y) + If sceneryVerts Then + selected(1) = inSelRect(sceneryCoords(1).X, sceneryCoords(1).Y) + selected(2) = inSelRect(sceneryCoords(2).X, sceneryCoords(2).Y) + selected(3) = inSelRect(sceneryCoords(3).X, sceneryCoords(3).Y) + Else + selected(1) = False + selected(2) = False + selected(3) = False + End If + + If currentFunction = TOOL_VSELECT Then + Scenery(i).selected = 0 + End If + + If showWireframe Or ((Scenery(i).level = 0 And sslBack) Or (Scenery(i).level = 1 And sslMid) Or (Scenery(i).level = 2 And sslFront)) Then + If selected(0) Or selected(1) Or selected(2) Or selected(3) Then + If currentFunction = TOOL_VSELECT Then + Scenery(i).selected = 1 + numSelectedScenery = numSelectedScenery + 1 + ElseIf currentFunction = TOOL_VSELADD Then + If Scenery(i).selected = 0 Then + numSelectedScenery = numSelectedScenery + 1 + End If + Scenery(i).selected = 1 + ElseIf currentFunction = TOOL_VSELSUB Then + If Scenery(i).selected = 1 Then + numSelectedScenery = numSelectedScenery - 1 + End If + Scenery(i).selected = 0 + End If + End If + End If + Next + +End Sub + +Private Sub VertexSelObjects() + + Dim i As Integer, j As Integer + Dim xCoord As Long, yCoord As Long + + For i = 1 To spawnPoints + xCoord = (Spawns(i).X - scrollCoords(2).X) * zoomFactor + yCoord = (Spawns(i).Y - scrollCoords(2).Y) * zoomFactor + If currentFunction = TOOL_VSELECT Then Spawns(i).active = 0 + If inSelRect(xCoord, yCoord) Then + If currentFunction = TOOL_VSELECT Then + Spawns(i).active = 1 + numSelSpawns = numSelSpawns + 1 + ElseIf currentFunction = TOOL_VSELADD And Spawns(i).active = 0 Then + numSelSpawns = numSelSpawns + 1 + Spawns(i).active = 1 + ElseIf currentFunction = TOOL_VSELSUB And Spawns(i).active = 1 Then + numSelSpawns = numSelSpawns - 1 + Spawns(i).active = 0 + End If + End If + Next + + For i = 1 To colliderCount + xCoord = (Colliders(i).X - scrollCoords(2).X) * zoomFactor + yCoord = (Colliders(i).Y - scrollCoords(2).Y) * zoomFactor + If currentFunction = TOOL_VSELECT Then Colliders(i).active = 0 + If inSelRect(xCoord, yCoord) Then + If currentFunction = TOOL_VSELECT Then + numSelColliders = numSelColliders + 1 + Colliders(i).active = 1 + ElseIf currentFunction = TOOL_VSELADD And Colliders(i).active = 0 Then + numSelColliders = numSelColliders + 1 + Colliders(i).active = 1 + ElseIf currentFunction = TOOL_VSELSUB And Colliders(i).active = 1 Then + numSelColliders = numSelColliders - 1 + Colliders(i).active = 0 + End If + End If + Next + +End Sub + +Private Sub VertexSelLights() + + Dim i As Integer, j As Integer + Dim xCoord As Long, yCoord As Long + + For i = 1 To lightCount + xCoord = (Lights(i).X - scrollCoords(2).X) * zoomFactor + yCoord = (Lights(i).Y - scrollCoords(2).Y) * zoomFactor + If currentFunction = TOOL_VSELECT Then Lights(i).selected = 0 + If inSelRect(xCoord, yCoord) Then + If currentFunction = TOOL_VSELECT Then + Lights(i).selected = 1 + numSelLights = numSelLights + 1 + ElseIf currentFunction = TOOL_VSELADD And Lights(i).selected = 0 Then + numSelLights = numSelLights + 1 + Lights(i).selected = 1 + ElseIf currentFunction = TOOL_VSELSUB And Lights(i).selected = 1 Then + numSelLights = numSelLights - 1 + Lights(i).selected = 0 + End If + End If + Next + +End Sub + +Private Sub VertexSelWaypoints() + + Dim i As Integer, j As Integer + Dim xCoord As Long, yCoord As Long + + For i = 1 To waypointCount + If (frmWaypoints.showPaths = Waypoints(i).pathNum) Or frmWaypoints.showPaths = 0 Then + xCoord = (Waypoints(i).X - scrollCoords(2).X) * zoomFactor + yCoord = (Waypoints(i).Y - scrollCoords(2).Y) * zoomFactor + If currentFunction = TOOL_VSELECT Then Waypoints(i).selected = False + If inSelRect(xCoord, yCoord) Then + If currentFunction = TOOL_VSELECT Then + Waypoints(i).selected = True + numSelWaypoints = numSelWaypoints + 1 + ElseIf currentFunction = TOOL_VSELADD And Not Waypoints(i).selected Then + numSelWaypoints = numSelWaypoints + 1 + Waypoints(i).selected = True + ElseIf currentFunction = TOOL_VSELSUB And Waypoints(i).selected Then + numSelWaypoints = numSelWaypoints - 1 + Waypoints(i).selected = False + End If + End If + End If + Next + +End Sub + +Private Sub getRCenter() + + Dim i As Integer, j As Integer + Dim setCoords As Boolean + Dim xVal As Single, yVal As Single + Dim Width As Single, Height As Single + + On Error GoTo ErrorHandler + + If numSelectedPolys > 0 Then + For j = 1 To 3 + If vertexList(selectedPolys(1)).vertex(j) = 1 Then + selRect(0).X = PolyCoords(selectedPolys(1)).vertex(j).X + selRect(0).Y = PolyCoords(selectedPolys(1)).vertex(j).Y + selRect(2).X = PolyCoords(selectedPolys(1)).vertex(j).X + selRect(2).Y = PolyCoords(selectedPolys(1)).vertex(j).Y + End If + Next + For i = 1 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then + compareRect PolyCoords(selectedPolys(i)).vertex(j).X, PolyCoords(selectedPolys(i)).vertex(j).Y + End If + Next + Next + End If + If numSelectedScenery > 0 Then + setCoords = False + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + + If Not setCoords And numSelectedPolys = 0 Then + setCoords = True + selRect(0).X = Scenery(i).Translation.X + selRect(0).Y = Scenery(i).Translation.Y + selRect(2).X = Scenery(i).Translation.X + selRect(2).Y = Scenery(i).Translation.Y + End If + compareRect Scenery(i).Translation.X, Scenery(i).Translation.Y + + Width = SceneryTextures(Scenery(i).Style).Width * Scenery(i).Scaling.X + Height = SceneryTextures(Scenery(i).Style).Height * Scenery(i).Scaling.Y + + xVal = Scenery(i).Translation.X + (Cos(Scenery(i).rotation) * Width) + (Sin(Scenery(i).rotation) * Height) + yVal = Scenery(i).Translation.Y - (Sin(Scenery(i).rotation) * Width) + (Cos(Scenery(i).rotation) * Height) + + compareRect xVal, yVal + + End If + Next + End If + + If numSelWaypoints > 0 Then + setCoords = False + For i = 1 To waypointCount + If Waypoints(i).selected Then + If Not setCoords And numSelectedPolys = 0 And numSelectedScenery = 0 Then + setCoords = True + selRect(0).X = Waypoints(i).X + selRect(0).Y = Waypoints(i).Y + selRect(2).X = Waypoints(i).X + selRect(2).Y = Waypoints(i).Y + End If + compareRect Waypoints(i).X, Waypoints(i).Y + End If + Next + End If + + If numSelColliders > 0 Then + setCoords = False + For i = 1 To colliderCount + If Colliders(i).active Then + If Not setCoords And numSelectedPolys = 0 And numSelectedScenery = 0 Then + setCoords = True + selRect(0).X = Colliders(i).X + selRect(0).Y = Colliders(i).Y + selRect(2).X = Colliders(i).X + selRect(2).Y = Colliders(i).Y + End If + compareRect Colliders(i).X, Colliders(i).Y + End If + Next + End If + + If numSelSpawns > 0 Then + setCoords = False + For i = 1 To spawnPoints + If Spawns(i).active Then + If Not setCoords And numSelectedPolys = 0 And numSelectedScenery = 0 Then + setCoords = True + selRect(0).X = Spawns(i).X + selRect(0).Y = Spawns(i).Y + selRect(2).X = Spawns(i).X + selRect(2).Y = Spawns(i).Y + End If + compareRect Spawns(i).X, Spawns(i).Y + End If + Next + End If + + If numSelLights > 0 Then + setCoords = False + For i = 1 To lightCount + If Lights(i).selected Then + If Not setCoords And numSelectedPolys = 0 And numSelectedScenery = 0 Then + setCoords = True + selRect(0).X = Lights(i).X + selRect(0).Y = Lights(i).Y + selRect(2).X = Lights(i).X + selRect(2).Y = Lights(i).Y + End If + compareRect Lights(i).X, Lights(i).Y + End If + Next + End If + + selRect(1).X = selRect(2).X + selRect(1).Y = selRect(0).Y + selRect(3).X = selRect(0).X + selRect(3).Y = selRect(2).Y + + If mnuFixedRCenter.Checked Then + rCenter.X = Midpoint(selRect(0).X, selRect(2).X) + rCenter.Y = Midpoint(selRect(0).Y, selRect(2).Y) + End If + + Exit Sub + +ErrorHandler: + + MsgBox Error$ + +End Sub + +Private Sub compareRect(ByVal xVal As Integer, ByVal yVal As Integer) + + If xVal < selRect(0).X Then selRect(0).X = xVal + If xVal > selRect(2).X Then selRect(2).X = xVal + If yVal < selRect(0).Y Then selRect(0).Y = yVal + If yVal > selRect(2).Y Then selRect(2).Y = yVal + +End Sub + +Private Sub vertexSelAlt(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim xDist As Integer, yDist As Integer + Dim xCenter As Integer, yCenter As Integer + Dim addPoly As Integer, notSel As Integer + + xDist = (X - selectedCoords(1).X) / 2 'x distance from coord + yDist = (Y - selectedCoords(1).Y) / 2 'y distance from coord + + xCenter = X - xDist + yCenter = Y - yDist + + numSelectedPolys = 0 + ReDim selectedPolys(numSelectedPolys) + + For i = 1 To polyCount + For j = 1 To 3 + 'if in range + If nearCoord(xCenter, Polys(i).vertex(j).X, Abs(xDist)) And nearCoord(yCenter, Polys(i).vertex(j).Y, Abs(yDist)) Then + If vertexList(i).vertex(j) = 0 Then + vertexList(i).vertex(j) = 1 + addPoly = 1 + Else + vertexList(i).vertex(j) = 0 + End If + ElseIf vertexList(i).vertex(j) = 1 Then + addPoly = 1 + End If + Next + If addPoly = 1 Then + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = i + End If + addPoly = 0 + Next + + selectedCoords(1).X = X + selectedCoords(1).Y = Y + selectedCoords(2).X = X + selectedCoords(2).Y = Y + + Render + +End Sub + +Private Sub polySelection(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim addPoly As Integer + Dim shortestDist As Integer + Dim firstClicked As Integer + Dim foundSelected As Integer + + addPoly = 0 + If currentFunction = TOOL_PSELECT Then 'select polys (destroy and remake) + + ReDim selectedPolys(0) + numSelectedPolys = 0 + numSelectedScenery = 0 + + If showPolys Or showWireframe Or showPoints Then + shortestDist = 16 ^ 2 + 1 + For i = 1 To polyCount + If (pointInPoly(X, Y, i)) And addPoly = 0 Then 'if in poly and no other poly selected + If firstClicked = 0 Then + firstClicked = i + End If + 'not selected and after selected + If foundSelected > 0 And (vertexList(i).vertex(1) + vertexList(i).vertex(1) + vertexList(i).vertex(1) < 3) Then + vertexList(i).vertex(1) = 1 + vertexList(i).vertex(2) = 1 + vertexList(i).vertex(3) = 1 + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = i + addPoly = 1 + 'not selected, not found + ElseIf (vertexList(i).vertex(1) + vertexList(i).vertex(1) + vertexList(i).vertex(1) < 3) Then + Else 'poly is selected + foundSelected = i + vertexList(i).vertex(1) = 0 + vertexList(i).vertex(2) = 0 + vertexList(i).vertex(3) = 0 + End If + Else + vertexList(i).vertex(1) = 0 + vertexList(i).vertex(2) = 0 + vertexList(i).vertex(3) = 0 + End If + Next + End If + + If addPoly = 0 And firstClicked > 0 Then + vertexList(firstClicked).vertex(1) = 1 + vertexList(firstClicked).vertex(2) = 1 + vertexList(firstClicked).vertex(3) = 1 + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = firstClicked + addPoly = 1 + End If + + If showScenery And addPoly = 0 Then + For i = 1 To sceneryCount + Scenery(i).selected = 0 + If showWireframe Or ((Scenery(i).level = 0 And sslBack) Or (Scenery(i).level = 1 And sslMid) Or (Scenery(i).level = 2 And sslFront)) Then + If PointInProp(X, Y, i) And addPoly = 0 Then + Scenery(i).selected = 1 + numSelectedScenery = numSelectedScenery + 1 + addPoly = 1 + End If + End If + Next + Else + For i = 1 To sceneryCount + Scenery(i).selected = 0 + Next + End If + + If showObjects Then + For i = 1 To spawnPoints + Spawns(i).active = 0 + Next + numSelSpawns = 0 + For i = 1 To colliderCount + Colliders(i).active = 0 + Next + numSelColliders = 0 + End If + If showLights Then + For i = 1 To lightCount + Lights(i).selected = 0 + Next + numSelLights = 0 + End If + If showWaypoints Then + For i = 1 To waypointCount + If (frmWaypoints.showPaths = Waypoints(i).pathNum) Or frmWaypoints.showPaths = 0 Then + Waypoints(i).selected = False + End If + Next + numSelWaypoints = 0 + End If + + ElseIf currentFunction = TOOL_PSELADD Then 'add polys + + addPoly = 0 + If showPolys Or showWireframe Or showPoints Then + For i = 1 To polyCount + If pointInPoly(X, Y, i) And vertexList(i).vertex(1) = 0 And addPoly = 0 Then 'if in poly and not already selected + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = i + vertexList(i).vertex(1) = 1 + vertexList(i).vertex(2) = 1 + vertexList(i).vertex(3) = 1 + addPoly = 1 + End If + Next + End If + + If showScenery And addPoly = 0 Then + For i = 1 To sceneryCount + If Scenery(i).selected = 0 And addPoly = 0 Then + If PointInProp(X, Y, i) Then + Scenery(i).selected = 1 + numSelectedScenery = numSelectedScenery + 1 + addPoly = 1 + End If + End If + Next + End If + + ElseIf currentFunction = TOOL_PSELSUB Then 'subtract polys + + ReDim selectedPolys(1) + numSelectedPolys = 0 + + If showPolys Or showWireframe Or showPoints Then + For i = 1 To polyCount + If vertexList(i).vertex(1) = 1 Then 'if poly already selected + If (pointInPoly(X, Y, i)) And addPoly = 0 Then 'if poly clicked + vertexList(i).vertex(1) = 0 + vertexList(i).vertex(2) = 0 + vertexList(i).vertex(3) = 0 + addPoly = 1 + Else + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = i + End If + End If + Next + End If + + If showScenery And addPoly = 0 Then + For i = 1 To sceneryCount + If Scenery(i).selected = 1 And addPoly = 0 Then + If PointInProp(X, Y, i) Then + Scenery(i).selected = 0 + numSelectedScenery = numSelectedScenery - 1 + addPoly = 1 + End If + End If + Next + End If + + End If + + getRCenter + getInfo + selectionChanged = True + Render + +End Sub + +Private Function PointInProp(ByVal X As Single, ByVal Y As Single, Index As Integer) As Boolean + + Dim xDiff As Long, yDiff As Long + Dim theta As Single + Dim R As Single + + On Error GoTo ErrorHandler + + PointInProp = False + + xDiff = (X - Scenery(Index).screenTr.X) + yDiff = (Y - Scenery(Index).screenTr.Y) + + R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from scenery rotation center + If xDiff = 0 Then + If yDiff > 0 Then + theta = pi / 2 + Scenery(Index).rotation + Else + theta = 3 * pi / 2 + Scenery(Index).rotation + End If + ElseIf xDiff > 0 Then + theta = Atn(yDiff / xDiff) + Scenery(Index).rotation + ElseIf xDiff < 0 Then + theta = pi + Atn(yDiff / xDiff) + Scenery(Index).rotation + End If + + X = R * Cos(theta) + Y = R * Sin(theta) + + If isBetween(0, X, SceneryTextures(Scenery(Index).Style).Width * Scenery(Index).Scaling.X * zoomFactor) Then + If isBetween(0, Y, SceneryTextures(Scenery(Index).Style).Height * Scenery(Index).Scaling.Y * zoomFactor) Then + PointInProp = True + End If + End If + + Exit Function + +ErrorHandler: + + MsgBox "Error selecting scenery" & vbNewLine & Error$ + +End Function + +Private Sub ColorFill(X As Single, Y As Single) + + Dim i As Integer, j As Integer + Dim PolyNum As Integer + Dim destClr As TColor + Dim polyColored As Boolean + + If numSelectedPolys > 0 Or numSelectedScenery > 0 Then + + If showPolys Or showWireframe Or showPoints Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + destClr = getRGB(Polys(PolyNum).vertex(j).Color) + destClr = applyBlend(destClr) + Polys(PolyNum).vertex(j).Color = ARGB(getAlpha(Polys(PolyNum).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) + vertexList(PolyNum).color(j).red = destClr.red + vertexList(PolyNum).color(j).green = destClr.green + vertexList(PolyNum).color(j).blue = destClr.blue + applyLightsToVert PolyNum, j + polyColored = True + End If + Next + Next + End If + + If showScenery Then + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + destClr = getRGB(Scenery(i).Color) + destClr = applyBlend(destClr) + Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) + polyColored = True + End If + Next + End If + + If polyColored Then + SaveUndo + End If + + Else + + If showPolys Or showWireframe Or showPoints Then + For i = 1 To polyCount + If (pointInPoly(X, Y, i)) Then + For j = 1 To 3 + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + destClr = getRGB(Polys(i).vertex(j).Color) 'get clr of poly + destClr = applyBlend(destClr) + Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) + vertexList(i).color(j).red = destClr.red + vertexList(i).color(j).green = destClr.green + vertexList(i).color(j).blue = destClr.blue + applyLightsToVert i, j + polyColored = True + Next + End If + Next + End If + + If Not polyColored And showScenery Then + For i = 1 To sceneryCount + If PointInProp(X, Y, i) Then + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + destClr = getRGB(Scenery(i).Color) + destClr = applyBlend(destClr) + Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) + polyColored = True + End If + Next + End If + + If polyColored Then + SaveUndo + End If + + End If + + prompt = True + + Render + +End Sub + +Private Function applyBlend(dClr As TColor) As TColor + + If blendMode = 0 Then 'normal + applyBlend.red = polyClr.red * opacity + dClr.red * (1 - opacity) + applyBlend.green = polyClr.green * opacity + dClr.green * (1 - opacity) + applyBlend.blue = polyClr.blue * opacity + dClr.blue * (1 - opacity) + ElseIf blendMode = 1 Then 'multiply + applyBlend.red = (dClr.red / 255 * polyClr.red) * opacity + dClr.red * (1 - opacity) + applyBlend.green = (dClr.green / 255 * polyClr.green) * opacity + dClr.green * (1 - opacity) + applyBlend.blue = (dClr.blue / 255 * polyClr.blue) * opacity + dClr.blue * (1 - opacity) + ElseIf blendMode = 2 Then 'screen + applyBlend.red = (dClr.red - dClr.red / 255 * polyClr.red + polyClr.red) * opacity + dClr.red * (1 - opacity) + applyBlend.green = (dClr.green - dClr.green / 255 * polyClr.green + polyClr.green) * opacity + dClr.green * (1 - opacity) + applyBlend.blue = (dClr.blue - dClr.blue / 255 * polyClr.blue + polyClr.blue) * opacity + dClr.blue * (1 - opacity) + ElseIf blendMode = 3 Then 'AND 'darken + applyBlend.red = lowerVal(dClr.red, polyClr.red) * opacity + dClr.red * (1 - opacity) + applyBlend.green = lowerVal(dClr.green, polyClr.green) * opacity + dClr.green * (1 - opacity) + applyBlend.blue = lowerVal(dClr.blue, polyClr.blue) * opacity + dClr.blue * (1 - opacity) + ElseIf blendMode = 4 Then 'OR 'lighten + applyBlend.red = higherVal(dClr.red, polyClr.red) * opacity + dClr.red * (1 - opacity) + applyBlend.green = higherVal(dClr.green, polyClr.green) * opacity + dClr.green * (1 - opacity) + applyBlend.blue = higherVal(dClr.blue, polyClr.blue) * opacity + dClr.blue * (1 - opacity) + ElseIf blendMode = 5 Then 'XOR 'difference + applyBlend.red = diffVal(dClr.red, polyClr.red) * opacity + dClr.red * (1 - opacity) + applyBlend.green = diffVal(dClr.green, polyClr.green) * opacity + dClr.green * (1 - opacity) + applyBlend.blue = diffVal(dClr.blue, polyClr.blue) * opacity + dClr.blue * (1 - opacity) + Else + applyBlend.red = 0 + applyBlend.green = 0 + applyBlend.blue = 0 + End If + +End Function + +Private Function diffVal(val1 As Byte, val2 As Byte) As Byte + + If val1 > val2 Then + diffVal = val1 - val2 + Else + diffVal = val2 - val1 + End If + +End Function + +Private Function lowerVal(val1 As Byte, val2 As Byte) As Byte + + If val1 < val2 Then + lowerVal = val1 + Else + lowerVal = val2 + End If + +End Function + +Private Function higherVal(val1 As Byte, val2 As Byte) As Byte + + If val1 > val2 Then + higherVal = val1 + Else + higherVal = val2 + End If + +End Function + +Private Function snapVertexToGrid(ByVal coord As Single, offset As Single) As Single + + Dim target As Single + + offset = (inc * zoomFactor) - offset + + target = (Int(coord / (inc * zoomFactor)) * (inc * zoomFactor) + offset) + If target > coord Then target = target - inc * zoomFactor + + If (coord - target) < ((inc * zoomFactor) / 2) Then + snapVertexToGrid = target + Else + snapVertexToGrid = target + inc * zoomFactor + End If + +End Function + +Private Sub deletePolys() + + Dim i As Integer, j As Integer + Dim offset As Integer + + On Error GoTo ErrorHandler + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + prompt = True + + If numSelectedScenery > 0 Then + offset = 1 + For i = 1 To sceneryCount + Scenery(offset) = Scenery(i) + If Scenery(i).selected = 1 Then 'scenery selected + sceneryCount = sceneryCount - 1 + Else 'not selected + offset = offset + 1 + End If + Next + ReDim Preserve Scenery(sceneryCount) + End If + + If numSelSpawns > 0 Then + offset = 1 + For i = 1 To spawnPoints + Spawns(offset) = Spawns(i) + If Spawns(i).active = 1 Then + spawnPoints = spawnPoints - 1 + Else 'not selected + offset = offset + 1 + End If + Next + ReDim Preserve Spawns(spawnPoints) + End If + + If numSelColliders > 0 Then + offset = 1 + For i = 1 To colliderCount + Colliders(offset) = Colliders(i) + If Colliders(i).active = 1 Then 'scenery selected + colliderCount = colliderCount - 1 + Else 'not selected + offset = offset + 1 + End If + Next + ReDim Preserve Colliders(colliderCount) + End If + + If numSelWaypoints > 0 Then + + currentWaypoint = 0 + offset = 1 + For i = 1 To waypointCount + Waypoints(i).tempIndex = Waypoints(offset).tempIndex + Waypoints(offset) = Waypoints(i) + If Waypoints(i).selected Then + waypointCount = waypointCount - 1 + Waypoints(i).tempIndex = -1 + Else 'not selected + Waypoints(i).tempIndex = offset + offset = offset + 1 + End If + Next + + offset = 1 + For i = 1 To conCount + Connections(offset) = Connections(i) + If Waypoints(Connections(i).point1).tempIndex < 0 Or Waypoints(Connections(i).point2).tempIndex < 0 Then + conCount = conCount - 1 + Else 'not selected + Connections(offset).point1 = Waypoints(Connections(offset).point1).tempIndex + Connections(offset).point2 = Waypoints(Connections(offset).point2).tempIndex + offset = offset + 1 + End If + Next + For i = 1 To waypointCount + Waypoints(i).tempIndex = i + Waypoints(i).numConnections = 0 + Next + ReDim Preserve Waypoints(waypointCount) + ReDim Preserve Connections(conCount) + For i = 1 To conCount + Waypoints(Connections(i).point1).numConnections = Waypoints(Connections(i).point1).numConnections + 1 + Next + + End If + + If numSelLights > 0 Then + offset = 1 + For i = 1 To lightCount + Lights(offset) = Lights(i) + If Lights(i).selected = 1 Then + lightCount = lightCount - 1 + Else 'not selected + offset = offset + 1 + End If + Next + ReDim Preserve Lights(lightCount) + If lightCount > 0 Then + applyLights + ElseIf lightCount = 0 Then + For i = 1 To polyCount + For j = 1 To 3 + Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) + Next + Next + End If + End If + + numSelectedScenery = 0 + numSelSpawns = 0 + numSelColliders = 0 + numSelWaypoints = 0 + numSelLights = 0 + + If numSelectedPolys > 0 Then 'delete polys + + numSelectedPolys = 0 + ReDim selectedPolys(0) + + offset = 1 + + For i = 1 To polyCount + + Polys(offset) = Polys(i) + PolyCoords(offset) = PolyCoords(i) + vertexList(offset) = vertexList(i) + + If (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) = 3 Then 'poly selected + vertexList(offset).vertex(1) = 0 + vertexList(offset).vertex(2) = 0 + vertexList(offset).vertex(3) = 0 + polyCount = polyCount - 1 + ElseIf (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) > 0 Then 'vertices selected + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = offset + offset = offset + 1 + Else 'not selected + offset = offset + 1 + End If + + Next + + ReDim Preserve Polys(polyCount) + ReDim Preserve PolyCoords(polyCount) + ReDim Preserve vertexList(polyCount) + + End If + + setMapData + + SaveUndo + Render + getInfo + + Exit Sub + +ErrorHandler: + + MsgBox "Error deleting" & vbNewLine & Error$ + +End Sub + +Private Function nearCoord(ByVal mouseCoord As Single, ByVal polyCoord As Single, ByVal range As Single) As Boolean + + If mouseCoord <= (polyCoord + range) And mouseCoord >= (polyCoord - range) Then + nearCoord = True + End If + +End Function + +Private Function inSelRect(ByVal X As Single, ByVal Y As Single) As Boolean + + If (X > selectedCoords(1).X And X < selectedCoords(2).X) Or (X > selectedCoords(2).X And X < selectedCoords(1).X) Then + If (Y > selectedCoords(1).Y And Y < selectedCoords(2).Y) Or (Y > selectedCoords(2).Y And Y < selectedCoords(1).Y) Then + inSelRect = True + End If + End If + +End Function + +Private Sub mnuClrSketch_Click() + + sketchLines = 0 + ReDim Preserve sketch(0) + +End Sub + +Private Sub mnuCopy_Click() + + savePrefab appPath & "\Temp\copy.PFB" + +End Sub + +Private Sub mnuVSelBringForward_Click() + + mnuBringForward_Click + +End Sub + +Private Sub mnuVSelBringToFront_Click() + + mnuBringToFront_Click + +End Sub + +Private Sub mnuVSelClear_Click() + + mnuClear_Click + +End Sub + +Private Sub mnuVSelCopy_Click() + + mnuCopy_Click + +End Sub + +Private Sub mnuFlip_Click(Index As Integer) + + Dim i As Integer, j As Integer + Dim PolyNum As Integer + Dim vertSel As Byte + Dim temp As D3DVECTOR2 + Dim tempVertex As TCustomVertex + Dim tempClr As TColor + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If Index = 0 Then + scaleDiff.X = -1 + ElseIf Index = 1 Then + scaleDiff.Y = -1 + End If + + rCenter.X = selRect(0).X + (selRect(2).X - selRect(0).X) / 2 + rCenter.Y = selRect(0).Y + (selRect(2).Y - selRect(0).Y) / 2 + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + PolyCoords(PolyNum).vertex(j).X = (rCenter.X + (PolyCoords(PolyNum).vertex(j).X - rCenter.X) * scaleDiff.X) + PolyCoords(PolyNum).vertex(j).Y = (rCenter.Y + (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) * scaleDiff.Y) + Polys(PolyNum).vertex(j).X = (PolyCoords(PolyNum).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(PolyNum).vertex(j).Y = (PolyCoords(PolyNum).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + End If + Next + + 'make sure polys are cw + If Not isCW(PolyNum) Then 'switch to make cw + temp = PolyCoords(PolyNum).vertex(3) + PolyCoords(PolyNum).vertex(3) = PolyCoords(PolyNum).vertex(2) + PolyCoords(PolyNum).vertex(2) = temp + + tempVertex = Polys(PolyNum).vertex(3) + Polys(PolyNum).vertex(3) = Polys(PolyNum).vertex(2) + Polys(PolyNum).vertex(2) = tempVertex + + vertSel = vertexList(PolyNum).vertex(3) + vertexList(PolyNum).vertex(3) = vertexList(PolyNum).vertex(2) + vertexList(PolyNum).vertex(2) = vertSel + + tempClr = vertexList(PolyNum).color(3) + vertexList(PolyNum).color(3) = vertexList(PolyNum).color(2) + vertexList(PolyNum).color(2) = tempClr + End If + Next + End If + + If numSelectedScenery > 0 Then + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + + If scaleDiff.X * scaleDiff.Y < 0 Then + Scenery(i).rotation = -Scenery(i).rotation + Else + Scenery(i).rotation = Scenery(i).rotation + End If + + Scenery(i).Translation.X = rCenter.X + (Scenery(i).Translation.X - rCenter.X) * scaleDiff.X + Scenery(i).Translation.Y = rCenter.Y + (Scenery(i).Translation.Y - rCenter.Y) * scaleDiff.Y + + Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor + Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor + + Scenery(i).Scaling.X = Scenery(i).Scaling.X * scaleDiff.X + Scenery(i).Scaling.Y = Scenery(i).Scaling.Y * scaleDiff.Y + End If + Next + End If + + If numSelWaypoints > 0 Then + For i = 1 To waypointCount + If Waypoints(i).selected Then + Waypoints(i).X = (rCenter.X + (Waypoints(i).X - rCenter.X) * scaleDiff.X) + Waypoints(i).Y = (rCenter.Y + (Waypoints(i).Y - rCenter.Y) * scaleDiff.Y) + If Waypoints(i).wayType(0) Then + Waypoints(i).wayType(0) = False + Waypoints(i).wayType(1) = True + ElseIf Waypoints(i).wayType(1) Then + Waypoints(i).wayType(0) = True + Waypoints(i).wayType(1) = False + End If + End If + Next + End If + + scaleDiff.X = 1 + scaleDiff.Y = 1 + + SaveUndo + Render + getInfo + +End Sub + +Private Sub mnuFlipTexture_Click(Index As Integer) + + Dim i As Integer, j As Integer + Dim PolyNum As Integer + Dim avgMul As Single + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If Index = 0 Then + scaleDiff.X = -1 + ElseIf Index = 1 Then + scaleDiff.Y = -1 + End If + + rCenter.X = 0 + rCenter.Y = 0 + + avgMul = 1 + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + rCenter.X = rCenter.X * (1 - 1 / avgMul) + Polys(PolyNum).vertex(j).tu / avgMul + rCenter.Y = rCenter.Y * (1 - 1 / avgMul) + Polys(PolyNum).vertex(j).tv / avgMul + avgMul = avgMul + 1 + End If + Next + Next + End If + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + Polys(PolyNum).vertex(j).tu = (rCenter.X + (Polys(PolyNum).vertex(j).tu - rCenter.X) * scaleDiff.X) + Polys(PolyNum).vertex(j).tv = (rCenter.Y + (Polys(PolyNum).vertex(j).tv - rCenter.Y) * scaleDiff.Y) + End If + Next + Next + End If + + scaleDiff.X = 1 + scaleDiff.Y = 1 + + SaveUndo + Render + getInfo + +End Sub + +Private Sub mnuInvertSel_Click() + + Dim i As Integer, j As Integer + Dim addPoly As Boolean + + If showPolys Or showWireframe Or showPoints Then + numSelectedPolys = 0 + ReDim selectedPolys(polyCount) + For i = 1 To polyCount + addPoly = False + For j = 1 To 3 + If vertexList(i).vertex(j) = 0 Then + vertexList(i).vertex(j) = 1 + Else + vertexList(i).vertex(j) = 0 + End If + If vertexList(i).vertex(j) = 1 Then + addPoly = True + End If + Next + If addPoly Then + numSelectedPolys = numSelectedPolys + 1 + selectedPolys(numSelectedPolys) = i + End If + Next + ReDim Preserve selectedPolys(numSelectedPolys) + End If + + If showScenery Or showWireframe Or showPoints Then + numSelectedScenery = 0 + For i = 1 To sceneryCount + If (Scenery(i).level = 0 And sslBack) Or (Scenery(i).level = 1 And sslMid) Or (Scenery(i).level = 2 And sslFront) Then + If Scenery(i).selected = 0 Then + Scenery(i).selected = 1 + Else + Scenery(i).selected = 0 + End If + If Scenery(i).selected = 1 Then + numSelectedScenery = numSelectedScenery + 1 + End If + End If + Next + End If + + If showObjects Then + numSelSpawns = 0 + For i = 1 To spawnPoints + If Spawns(i).active = 0 Then + Spawns(i).active = 1 + Else + Spawns(i).active = 0 + End If + If Spawns(i).active = 1 Then + numSelSpawns = numSelSpawns + 1 + End If + Next + numSelColliders = 0 + For i = 1 To colliderCount + If Colliders(i).active = 0 Then + Colliders(i).active = 1 + Else + Colliders(i).active = 0 + End If + If Colliders(i).active Then + numSelColliders = numSelColliders + 1 + End If + Next + End If + + If showLights Then + numSelLights = 0 + For i = 1 To lightCount + If Lights(i).selected = 0 Then + Lights(i).selected = 1 + Else + Lights(i).selected = 0 + End If + If Lights(i).selected Then + numSelLights = numSelLights + 1 + End If + Next + End If + + If showWaypoints Then + numSelWaypoints = 0 + For i = 1 To waypointCount + Waypoints(i).selected = Not Waypoints(i).selected + If Waypoints(i).selected Then + numSelWaypoints = numSelWaypoints + 1 + End If + Next + End If + + getRCenter + getInfo + + Render + +End Sub + +Private Sub mnuPaste_Click() + + On Error GoTo ErrorHandler + + If (GetAttr(appPath & "\Temp\copy.PFB") And vbDirectory) = 0 Then + loadPrefab appPath & "\Temp\copy.PFB" + End If + +ErrorHandler: + +End Sub + +Private Sub mnuRecent_Click(Index As Integer) + + Dim i As Integer + Dim Result As VbMsgBoxResult + Dim FileName As String + + FileName = mnuRecent(Index).Caption + + If Len(Dir$(FileName)) <> 0 And FileName <> "" Then + + If prompt Then + Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) + DoEvents + If Result = vbCancel Then + Exit Sub + ElseIf Result = vbYes Then + mnuSave_Click + If prompt Then Exit Sub + End If + End If + DoEvents + + LoadFile FileName + For i = Index To 1 Step -1 + mnuRecent(i).Caption = mnuRecent(i - 1).Caption + Next + mnuRecent(0).Caption = FileName + ElseIf Len(Dir$(FileName)) = 0 Then + MsgBox "File not found: " & FileName + End If + +End Sub + +'put in recent files if it isn't already +Private Sub updateRecent(FileName As String) + + Dim i As Integer + + mnuRecentFiles.Enabled = True + + For i = 9 To 1 Step -1 + mnuRecent(i).Caption = mnuRecent(i - 1).Caption + If mnuRecent(i).Caption = "" Then + mnuRecent(i).Visible = False + Else + mnuRecent(i).Visible = True + End If + Next + mnuRecent(0).Caption = FileName + +End Sub + +Private Sub mnuResetView_Click() + + zoomFactor = 1 + scrollCoords(2).X = -ScaleWidth / 2 + scrollCoords(2).Y = -ScaleHeight / 2 + Zoom 1 + + Render + +End Sub + +Private Sub mnuRotate_Click(Index As Integer) + + Dim R As Single, theta As Single + Dim xDiff As Single, yDiff As Single + Dim i As Integer, j As Integer + Dim PolyNum As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If Index = 0 Then + rDiff = pi + ElseIf Index = 1 Then + rDiff = pi / 2 + ElseIf Index = 2 Then + rDiff = 3 * pi / 2 + End If + + rCenter.X = selRect(0).X + (selRect(2).X - selRect(0).X) / 2 + rCenter.Y = selRect(0).Y + (selRect(2).Y - selRect(0).Y) / 2 + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + xDiff = (PolyCoords(PolyNum).vertex(j).X - rCenter.X) + yDiff = (PolyCoords(PolyNum).vertex(j).Y - rCenter.Y) + + R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center + If xDiff = 0 Then + If yDiff > 0 Then + theta = pi / 2 + Else + theta = 3 * pi / 2 + End If + ElseIf xDiff > 0 Then + theta = Atn(yDiff / xDiff) + ElseIf xDiff < 0 Then + theta = pi + Atn(yDiff / xDiff) + End If + theta = theta + rDiff + + PolyCoords(PolyNum).vertex(j).X = rCenter.X + R * Cos(theta) + PolyCoords(PolyNum).vertex(j).Y = rCenter.Y + R * Sin(theta) + + Polys(PolyNum).vertex(j).X = (PolyCoords(PolyNum).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(PolyNum).vertex(j).Y = (PolyCoords(PolyNum).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + End If + Next + Next + End If + + If numSelectedScenery > 0 Then + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + xDiff = (Scenery(i).Translation.X - rCenter.X) + yDiff = (Scenery(i).Translation.Y - rCenter.Y) + + R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center + If xDiff = 0 Then + If yDiff > 0 Then + theta = pi / 2 + Else + theta = 3 * pi / 2 + End If + ElseIf xDiff > 0 Then + theta = Atn(yDiff / xDiff) + ElseIf xDiff < 0 Then + theta = pi + Atn(yDiff / xDiff) + End If + theta = theta + rDiff + + Scenery(i).Translation.X = rCenter.X + R * Cos(theta) + Scenery(i).Translation.Y = rCenter.Y + R * Sin(theta) + + Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor + Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor + + If scaleDiff.X * scaleDiff.Y < 0 Then + Scenery(i).rotation = -(Scenery(i).rotation - rDiff) + Else + Scenery(i).rotation = (Scenery(i).rotation - rDiff) + End If + End If + Next + End If + + rCenter.X = selRect(0).X + rCenter.Y = selRect(0).Y + rDiff = 0 + + getRCenter + getInfo + + SaveUndo + Render + +End Sub + +Private Sub mnuRotateTexture_Click(Index As Integer) + + Dim R As Single, theta As Single + Dim xDiff As Single, yDiff As Single + Dim i As Integer, j As Integer + Dim PolyNum As Integer + Dim avgMul As Single + Dim texRate As Single + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If Index = 0 Then + rDiff = pi + ElseIf Index = 2 Then + rDiff = pi / 2 + ElseIf Index = 1 Then + rDiff = 3 * pi / 2 + End If + + texRate = CSng(xTexture) / CSng(yTexture) + + rCenter.X = 0 + rCenter.Y = 0 + + avgMul = 1 + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + rCenter.X = rCenter.X * (1 - 1 / avgMul) + Polys(PolyNum).vertex(j).tu * texRate / avgMul + rCenter.Y = rCenter.Y * (1 - 1 / avgMul) + Polys(PolyNum).vertex(j).tv / avgMul + avgMul = avgMul + 1 + End If + Next + Next + End If + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + xDiff = (Polys(PolyNum).vertex(j).tu * texRate - rCenter.X) + yDiff = (Polys(PolyNum).vertex(j).tv - rCenter.Y) + + R = Sqr((xDiff) ^ 2 + (yDiff) ^ 2) 'distance of point from rotation center + If xDiff = 0 Then + If yDiff > 0 Then + theta = pi / 2 + Else + theta = 3 * pi / 2 + End If + ElseIf xDiff > 0 Then + theta = Atn(yDiff / xDiff) + ElseIf xDiff < 0 Then + theta = pi + Atn(yDiff / xDiff) + End If + theta = theta + rDiff + + Polys(PolyNum).vertex(j).tu = (rCenter.X + R * Cos(theta)) / texRate + Polys(PolyNum).vertex(j).tv = rCenter.Y + R * Sin(theta) + End If + Next + Next + End If + + rCenter.X = selRect(0).X + rCenter.Y = selRect(0).Y + rDiff = 0 + + getRCenter + getInfo + + SaveUndo + Render + +End Sub + +Private Sub mnuSetRCenter_Click() + + mnuFixedRCenter.Checked = False + mnuSetRCenter.Checked = True + mnuCenterRCenter.Checked = False + rCenter.X = mouseCoords.X / zoomFactor + scrollCoords(2).X + rCenter.Y = mouseCoords.Y / zoomFactor + scrollCoords(2).Y + +End Sub + +Private Sub mnuFixedRCenter_Click() + + mnuFixedRCenter.Checked = True + mnuSetRCenter.Checked = False + mnuCenterRCenter.Checked = False + rCenter.X = Midpoint(selRect(0).X, selRect(2).X) + rCenter.Y = Midpoint(selRect(0).Y, selRect(2).Y) + +End Sub + +Private Sub mnuCenterRCenter_Click() + + mnuFixedRCenter.Checked = False + mnuSetRCenter.Checked = False + mnuCenterRCenter.Checked = True + rCenter.X = Midpoint(selRect(0).X, selRect(2).X) + rCenter.Y = Midpoint(selRect(0).Y, selRect(2).Y) + +End Sub + +Private Sub mnuShowSceneryLayer_Click(Index As Integer) + + mnuShowSceneryLayer(Index).Checked = Not mnuShowSceneryLayer(Index).Checked + + If Index = 0 Then + sslBack = mnuShowSceneryLayer(0).Checked + ElseIf Index = 1 Then + sslMid = mnuShowSceneryLayer(1).Checked + ElseIf Index = 2 Then + sslFront = mnuShowSceneryLayer(2).Checked + End If + +End Sub + +Private Sub mnuSnapSelected_Click() + + SnapSelection + +End Sub + +Private Sub mnuVSelDuplicate_Click() + + mnuDuplicate_Click + +End Sub + +Private Sub mnuVSelFlip_Click(Index As Integer) + + mnuFlip_Click Index + +End Sub + +Private Sub mnuVSelPaste_Click() + + mnuPaste_Click + +End Sub + +Private Sub mnuVSelRotate_Click(Index As Integer) + + mnuRotate_Click Index + +End Sub + +Private Sub mnuVSelSendBackward_Click() + + mnuSendBackward_Click + +End Sub + +Private Sub mnuVSelSendToBack_Click() + + mnuSendToBack_Click + +End Sub + +Private Sub mnuWayType_Click(Index As Integer) + + Dim i As Integer + + mnuWayType(Index).Checked = Not mnuWayType(Index).Checked + If Index = 0 Then + mnuWayType(1).Checked = False + ElseIf Index = 1 Then + mnuWayType(0).Checked = False + ElseIf Index = 2 Then + mnuWayType(3).Checked = False + ElseIf Index = 3 Then + mnuWayType(2).Checked = False + End If + + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + + For i = 0 To 4 + If mnuWayType(i).Checked Then + lblCurrentTool.Caption = lblCurrentTool.Caption & " (" & mnuWayType(i).Caption & ")" + End If + Next + +End Sub + +Private Sub tvwScenery_Expand(ByVal Node As MSComctlLib.Node) + + If Node.Key <> "Master List" And Node.Key <> "In Use" And Node.Key <> "" Then + mnuScenList.Tag = Node.Key + mnuScenList.Caption = "Add to " & Node.Key & " list" + End If + +End Sub + +Private Sub tvwScenery_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + If Button = 2 Then + If tvwScenery.SelectedItem.FirstSibling <> "In Use" Then + If tvwScenery.SelectedItem.Parent.Key = "Master List" Then + If mnuScenList.Tag <> "" Then + mnuScenList.Caption = "Add " & tvwScenery.SelectedItem.Text & " to " & mnuScenList.Tag & " List" + mnuScenList.Enabled = True + mnuScenRemove.Enabled = False + PopupMenu mnuScenTree + End If + ElseIf tvwScenery.SelectedItem.Parent.Key <> "In Use" Then + mnuScenRemove.Caption = "Remove " & tvwScenery.SelectedItem.Text & " from List" + mnuScenList.Enabled = False + mnuScenRemove.Enabled = True + PopupMenu mnuScenTree + End If + End If + End If + +End Sub + +Private Sub mnuScenList_Click() + + Dim i As Integer + Dim tempNode As Node + + tvwScenery.Nodes.Add mnuScenList.Tag, tvwChild, , tvwScenery.SelectedItem.Text + + Open appPath & "\lists\" & mnuScenList.Tag & ".txt" For Output As #1 + + Set tempNode = tvwScenery.Nodes.Item(mnuScenList.Tag).Child + For i = 1 To tvwScenery.Nodes(mnuScenList.Tag).Children + Print #1, tempNode.Text + Set tempNode = tempNode.Next + Next + + Close #1 + +End Sub + +Private Sub mnuScenRemove_Click() + + Dim i As Integer + Dim tempNode As Node + + tvwScenery.Nodes.Remove (tvwScenery.SelectedItem.Index) + + Open appPath & "\lists\" & mnuScenList.Tag & ".txt" For Output As #1 + + Set tempNode = tvwScenery.Nodes.Item(mnuScenList.Tag).Child + For i = 1 To tvwScenery.Nodes(mnuScenList.Tag).Children + Print #1, tempNode.Text + Set tempNode = tempNode.Next + Next + + Close #1 + +End Sub + +Public Sub tvwScenery_NodeClick(ByVal Node As MSComctlLib.Node) + + Dim i As Integer + Dim isInList As Boolean + Dim token As Long + Dim tempNode As Node + + On Error GoTo ErrorHandler + + 'if there is no parent + If tvwScenery.SelectedItem.FirstSibling = "In Use" Then Exit Sub + + If Len(Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & tvwScenery.SelectedItem.Text)) = 0 Then + frmScenery.picScenery.Picture = LoadPicture(appPath & "\" & gfxDir & "\notfound.bmp") + Exit Sub + End If + + If tvwScenery.SelectedItem.Parent.Key = "In Use" Then + + currentScenery = tvwScenery.SelectedItem.Text + + token = InitGDIPlus + frmScenery.picScenery.Picture = LoadPictureGDIPlus(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & currentScenery, , , RGB(0, 255, 0)) + FreeGDIPlus token + + Set tempNode = tvwScenery.Nodes.Item("In Use").Child + + For i = 1 To (tvwScenery.Nodes.Item("In Use").Children) + If currentScenery = tempNode.Text Then + frmSoldatMapEditor.setCurrentScenery i + frmScenery.lstScenery.ListIndex = i - 1 + End If + Set tempNode = tempNode.Next + Next + + Else + + If Len(Dir$(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & tvwScenery.SelectedItem.Text)) <> 0 Then + + currentScenery = tvwScenery.SelectedItem.Text + + token = InitGDIPlus + frmScenery.picScenery.Picture = LoadPictureGDIPlus(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" & currentScenery, , , RGB(0, 255, 0)) + FreeGDIPlus token + + 'check if already in list + Set tempNode = tvwScenery.Nodes.Item("In Use").Child + + For i = 1 To (tvwScenery.Nodes.Item("In Use").Children) + If currentScenery = tempNode.Text Then + isInList = True + frmSoldatMapEditor.setCurrentScenery i + End If + Set tempNode = tempNode.Next + Next + + If Not isInList Then + frmSoldatMapEditor.setCurrentTexture currentScenery + End If + + End If + + frmScenery.lstScenery.ListIndex = -1 + + End If + + Exit Sub + +ErrorHandler: + + MsgBox "Error clicking scenery tree" & vbNewLine & Error$ + +End Sub + +Private Function confirmExists(FileName As String) As Boolean + + Dim tempNode As Node + Dim i As Integer + + Set tempNode = tvwScenery.Nodes.Item("Master List").Child + + For i = 1 To (tvwScenery.Nodes.Item("Master List").Children) + If LCase$(FileName) = LCase$(tempNode.Text) Then + confirmExists = True + End If + Set tempNode = tempNode.Next + Next + +End Function + +Private Sub txtZoom_KeyPress(KeyAscii As Integer) + + If KeyAscii = 13 Then + KeyAscii = 0 + picTitle.SetFocus + End If + +End Sub + +Private Sub txtZoom_LostFocus() + + Dim zoomInput As Single + + 'check if valid value was input + If txtZoom.Text = "" Then + txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" + ElseIf IsNumeric(txtZoom.Text) Then + zoomInput = txtZoom.Text + ElseIf IsNumeric(mid$(txtZoom.Text, 1, Len(txtZoom.Text) - 1)) And right$(txtZoom.Text, 1) = "%" Then + zoomInput = mid$(txtZoom.Text, 1, Len(txtZoom.Text) - 1) + Else + txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" + End If + + If (zoomInput / 100) >= MIN_ZOOM Or (zoomInput / 100) <= MAX_ZOOM Then + Zoom ((zoomInput / 100) / zoomFactor) + txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" + Else + txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" + End If + +End Sub + +Private Function getZoomDir(zoomDir As Single) As Single + + Dim zoomVal As Single + Dim i As Integer + + getZoomDir = zoomDir + + zoomVal = MIN_ZOOM + For i = 1 To 8 + If zoomDir > 1 Then 'zooming in + If (zoomFactor) > zoomVal And (zoomFactor) < (zoomVal * 2) Then + getZoomDir = (zoomVal * 2) / zoomFactor + Exit For + End If + ElseIf zoomDir < 1 Then 'zooming out + If (zoomFactor) < zoomVal And (zoomFactor) > (zoomVal * 0.5) Then + getZoomDir = (zoomVal * 0.5) / zoomFactor + Exit For + End If + End If + zoomVal = zoomVal * 2 + Next + +End Function + +Public Sub Zoom(zoomDir As Single) + + Dim i As Integer, j As Integer + Dim zoomVal As Single + + If zoomFactor * zoomDir < MIN_ZOOM Or zoomFactor * zoomDir > MAX_ZOOM Then Exit Sub + + Scenery(0).screenTr.X = Scenery(0).screenTr.X / zoomFactor + scrollCoords(2).X + Scenery(0).screenTr.Y = Scenery(0).screenTr.Y / zoomFactor + scrollCoords(2).Y + + zoomFactor = zoomFactor * zoomDir + + If zoomDir > 1 Then + 'zoom to middle + scrollCoords(2).X = scrollCoords(2).X + Me.ScaleWidth / zoomFactor / (2 / (zoomDir - 1)) + scrollCoords(2).Y = scrollCoords(2).Y + Me.ScaleHeight / zoomFactor / (2 / (zoomDir - 1)) + ElseIf zoomDir < 1 Then + scrollCoords(2).X = scrollCoords(2).X - Me.ScaleWidth / zoomFactor / (2 / (1 - zoomDir)) + scrollCoords(2).Y = scrollCoords(2).Y - Me.ScaleHeight / zoomFactor / (2 / (1 - zoomDir)) + End If + + For i = 1 To polyCount + For j = 1 To 3 + Polys(i).vertex(j).X = (PolyCoords(i).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(i).vertex(j).Y = (PolyCoords(i).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + Next + Next + + For i = 1 To sceneryCount + Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor + Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor + Next + + If numVerts > 0 Then + For j = 1 To 3 + Polys(polyCount + 1).vertex(j).X = (PolyCoords(polyCount + 1).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(polyCount + 1).vertex(j).Y = (PolyCoords(polyCount + 1).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + Next + End If + + For i = 1 To 4 + bgPolys(i).X = (bgPolyCoords(i).X - scrollCoords(2).X) * zoomFactor + bgPolys(i).Y = (bgPolyCoords(i).Y - scrollCoords(2).Y) * zoomFactor + Next + + Scenery(0).screenTr.X = (Scenery(0).screenTr.X - scrollCoords(2).X) * zoomFactor + Scenery(0).screenTr.Y = (Scenery(0).screenTr.Y - scrollCoords(2).Y) * zoomFactor + + selectedCoords(1).X = 0 + selectedCoords(1).Y = 0 + selectedCoords(2).X = 0 + selectedCoords(2).Y = 0 + + txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" + + Render + + If circleOn Then + Render + End If + +End Sub + +Public Sub zoomScroll(zoomDir As Single, ByVal X As Integer, ByVal Y As Integer) + + Dim i As Integer, j As Integer + + If (zoomFactor * zoomDir < MIN_ZOOM) And zoomFactor > MIN_ZOOM Then + zoomDir = MIN_ZOOM / zoomFactor + ElseIf zoomFactor * zoomDir > MAX_ZOOM And zoomFactor < MAX_ZOOM Then + zoomDir = MAX_ZOOM / zoomFactor + End If + + If zoomFactor * zoomDir < MIN_ZOOM Or zoomFactor * zoomDir > MAX_ZOOM Then Exit Sub + + Scenery(0).screenTr.X = Scenery(0).screenTr.X / zoomFactor + scrollCoords(2).X + Scenery(0).screenTr.Y = Scenery(0).screenTr.Y / zoomFactor + scrollCoords(2).Y + + selectedCoords(1).X = selectedCoords(1).X / zoomFactor + scrollCoords(2).X + selectedCoords(1).Y = selectedCoords(1).Y / zoomFactor + scrollCoords(2).Y + + zoomFactor = (zoomFactor * zoomDir) + + If zoomDir > 1 Then + scrollCoords(2).X = scrollCoords(2).X + X / zoomFactor / ((2 / (zoomDir - 1)) / 2) + scrollCoords(2).Y = scrollCoords(2).Y + Y / zoomFactor / ((2 / (zoomDir - 1)) / 2) + ElseIf zoomDir < 1 Then + scrollCoords(2).X = scrollCoords(2).X - Me.ScaleWidth / zoomFactor / (2 / (1 - zoomDir)) + scrollCoords(2).Y = scrollCoords(2).Y - Me.ScaleHeight / zoomFactor / (2 / (1 - zoomDir)) + End If + + For i = 1 To polyCount + For j = 1 To 3 + Polys(i).vertex(j).X = (PolyCoords(i).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(i).vertex(j).Y = (PolyCoords(i).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + Next + Next + + For i = 1 To sceneryCount + Scenery(i).screenTr.X = (Scenery(i).Translation.X - scrollCoords(2).X) * zoomFactor + Scenery(i).screenTr.Y = (Scenery(i).Translation.Y - scrollCoords(2).Y) * zoomFactor + Next + + If numVerts > 0 Then + For j = 1 To 3 + Polys(polyCount + 1).vertex(j).X = (PolyCoords(polyCount + 1).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(polyCount + 1).vertex(j).Y = (PolyCoords(polyCount + 1).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + Next + End If + + For i = 1 To 4 + bgPolys(i).X = (bgPolyCoords(i).X - scrollCoords(2).X) * zoomFactor + bgPolys(i).Y = (bgPolyCoords(i).Y - scrollCoords(2).Y) * zoomFactor + Next + + Scenery(0).screenTr.X = (Scenery(0).screenTr.X - scrollCoords(2).X) * zoomFactor + Scenery(0).screenTr.Y = (Scenery(0).screenTr.Y - scrollCoords(2).Y) * zoomFactor + + selectedCoords(1).X = (selectedCoords(1).X - scrollCoords(2).X) * zoomFactor + selectedCoords(1).Y = (selectedCoords(1).Y - scrollCoords(2).Y) * zoomFactor + + txtZoom.Text = Int(zoomFactor * 1000 + 0.5) / 10 & "%" + + Render + +End Sub + +Private Function pointInPoly(ByVal X As Single, ByVal Y As Single, ByVal i As Integer) As Boolean + + Dim xDist As Single, yDist As Single + Dim xDiff As Single, yDiff As Single + Dim length As Single + Dim D As Single + + pointInPoly = True + + xDist = X - Polys(i).vertex(1).X + yDist = Y - Polys(i).vertex(1).Y + xDiff = Polys(i).vertex(2).X - Polys(i).vertex(1).X + yDiff = Polys(i).vertex(1).Y - Polys(i).vertex(2).Y + If xDiff = 0 And yDiff = 0 Then + length = 1 + Else + length = Sqr(xDiff ^ 2 + yDiff ^ 2) + End If + D = (yDiff / length) * xDist + (xDiff / length) * yDist + If D < 0 Then pointInPoly = False + + xDist = X - Polys(i).vertex(2).X + yDist = Y - Polys(i).vertex(2).Y + xDiff = Polys(i).vertex(3).X - Polys(i).vertex(2).X + yDiff = Polys(i).vertex(2).Y - Polys(i).vertex(3).Y + If xDiff = 0 And yDiff = 0 Then + length = 1 + Else + length = Sqr(xDiff ^ 2 + yDiff ^ 2) + End If + D = (yDiff / length) * xDist + (xDiff / length) * yDist + If D < 0 Then pointInPoly = False + + xDist = X - Polys(i).vertex(3).X + yDist = Y - Polys(i).vertex(3).Y + xDiff = Polys(i).vertex(1).X - Polys(i).vertex(3).X + yDiff = Polys(i).vertex(3).Y - Polys(i).vertex(1).Y + If xDiff = 0 And yDiff = 0 Then + length = 1 + Else + length = Sqr(xDiff ^ 2 + yDiff ^ 2) + End If + D = (yDiff / length) * xDist + (xDiff / length) * yDist + If D < 0 Then pointInPoly = False + +End Function + +Private Function isCW(ByVal i As Integer) As Boolean + + Dim xVal As Single, yVal As Single + + xVal = Midpoint(Polys(i).vertex(1).X, Midpoint(Polys(i).vertex(2).X, Polys(i).vertex(3).X)) + yVal = Midpoint(Polys(i).vertex(1).Y, Midpoint(Polys(i).vertex(2).Y, Polys(i).vertex(3).Y)) + + isCW = pointInPoly(xVal, yVal, i) + +End Function + +Private Function Midpoint(ByVal p1 As Single, ByVal p2 As Single) As Single + + If p1 < p2 Then + Midpoint = p1 + (p2 - p1) / 2 + Else + Midpoint = p2 + (p1 - p2) / 2 + End If + +End Function + +Public Sub setDispOptions(layerNum As Integer, value As Boolean) + + If layerNum = 0 Then + showBG = value + ElseIf layerNum = 1 Then + showPolys = value + ElseIf layerNum = 2 Then + showTexture = value + ElseIf layerNum = 3 Then + showWireframe = value + ElseIf layerNum = 4 Then + showPoints = value + ElseIf layerNum = 5 Then + showScenery = value + ElseIf layerNum = 6 Then + showObjects = value + ElseIf layerNum = 7 Then + showWaypoints = value + ElseIf layerNum = 8 Then + showGrid = value + mnuGrid.Checked = value + ElseIf layerNum = 9 Then + showLights = value + setLightsMode showLights + ElseIf layerNum = 10 Then + showSketch = value + End If + + Render + +End Sub + +Private Sub setLightsMode(lightsOn As Boolean) + + Dim i As Integer, j As Integer + + If Not lightsOn Then + For i = 1 To polyCount + For j = 1 To 3 + Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) + Next + Next + Else + applyLights + End If + +End Sub + +Public Sub setColorMode(ByVal clrVal As Byte) + + colorMode = clrVal + +End Sub + +Public Sub setCurrentTool(ByVal Index As Integer) + + Dim i As Integer + + currentTool = Index + currentFunction = Index + If currentTool = TOOL_CREATE And mnuQuad.Checked Then + currentFunction = TOOL_QUAD + ElseIf currentTool <> TOOL_SCENERY Then + frmSoldatMapEditor.tvwScenery.Visible = False + End If + + circleOn = False + + If numVerts > 0 And currentTool <> TOOL_CREATE Then 'abort poly creation + numVerts = 0 + ElseIf numCorners > 0 And currentTool <> TOOL_SCENERY Then + numCorners = 0 + ElseIf currentWaypoint > 0 And currentTool <> TOOL_WAYPOINT Then + currentWaypoint = 0 + End If + toolAction = False + + If currentTool = TOOL_PSELECT And numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + vertexList(selectedPolys(i)).vertex(1) = 1 + vertexList(selectedPolys(i)).vertex(2) = 1 + vertexList(selectedPolys(i)).vertex(3) = 1 + Next + getRCenter + ElseIf currentTool = TOOL_MOVE Then + If numSelectedPolys = 0 And numSelectedScenery = 1 Then + frmInfo.mnuProp_Click 1 + Else + frmInfo.mnuProp_Click 2 + End If + ElseIf currentTool = TOOL_TEXTURE Then + frmInfo.mnuProp_Click 3 + ElseIf currentTool = TOOL_VCOLOR Then + circleOn = True + ElseIf currentTool = TOOL_DEPTHMAP Then + circleOn = True + End If + + SetCursor currentFunction + 1 + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + + If currentTool = TOOL_CREATE Then + lblCurrentTool.Caption = lblCurrentTool.Caption & " (" & mnuPolyType(polyType).Caption & ")" + ElseIf currentTool = TOOL_WAYPOINT Then + For i = 0 To 4 + If mnuWayType(i).Checked Then + lblCurrentTool.Caption = lblCurrentTool.Caption & " (" & mnuWayType(i).Caption & ")" + End If + Next + End If + + Render + +End Sub + +Public Function setTempTool(toolNum As Byte) As Byte + + setTempTool = currentTool + currentTool = toolNum + +End Function + +Public Sub setMapTexture(texturePath As String) + + On Error GoTo ErrorHandler + + Set mapTexture = D3DX.CreateTextureFromFileEx(D3DDevice, frmSoldatMapEditor.soldatDir & "textures\" & texturePath, D3DX_DEFAULT, D3DX_DEFAULT, _ + D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_TRIANGLE, _ + D3DX_FILTER_TRIANGLE, ColorKey, imageInfo, ByVal 0) + + textureFile = texturePath + + xTexture = imageInfo.Width + yTexture = imageInfo.Height + + frmInfo.lblDimensions.Caption = "Dimensions: " & xTexture & " x " & yTexture + frmInfo.txtQuadX(0).Text = 0 + frmInfo.txtQuadY(0).Text = 0 + frmInfo.txtQuadX(1).Text = xTexture + frmInfo.txtQuadY(1).Text = yTexture + + Render + +ErrorHandler: + +End Sub + +'set polyclr when rgb modified +Public Sub setPolyColor(Index As Integer, value As Byte) + + If Index = 0 Then + polyClr.red = value + ElseIf Index = 1 Then + polyClr.green = value + ElseIf Index = 2 Then + polyClr.blue = value + ElseIf Index = 3 Then + opacity = value / 100 + End If + If numVerts > 0 And (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) Then + Polys(polyCount + 1).vertex(numVerts + 1).Color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) + End If + Scenery(0).alpha = opacity * 255 + Scenery(0).Color = ARGB(opacity * 255, RGB(polyClr.blue, polyClr.green, polyClr.red)) + +End Sub + +'set polyclr when palette clicked +Public Sub setPaletteColor(red As Byte, green As Byte, blue As Byte) + + polyClr.red = red + polyClr.green = green + polyClr.blue = blue + If numVerts > 0 And (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) Then + Polys(polyCount + 1).vertex(numVerts + 1).Color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) + End If + Scenery(0).alpha = opacity * 255 + Scenery(0).Color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) + +End Sub + +Public Sub setBlendMode(Index As Integer) + + blendMode = Index + +End Sub + +Public Function getColor() As Long + + getColor = RGB(polyClr.red, polyClr.green, polyClr.blue) + +End Function + +Public Sub getOptions() + + Dim i As Integer + + frmMap.txtDesc = mapTitle + frmMap.txtJet = Options.StartJet + frmMap.cboGrenades.ListIndex = Options.GrenadePacks + frmMap.cboMedikits.ListIndex = Options.Medikits + frmMap.cboSteps.ListIndex = Options.Steps + frmMap.cboWeather.ListIndex = Options.Weather + frmMap.picBackClr(0).BackColor = RGB(bgColors(1).red, bgColors(1).green, bgColors(1).blue) + frmMap.picBackClr(1).BackColor = RGB(bgColors(2).red, bgColors(2).green, bgColors(2).blue) + + For i = 0 To frmMap.cboTexture.ListCount - 1 + If frmMap.cboTexture.List(i) = textureFile Then + frmMap.cboTexture.ListIndex = i + End If + Next + +End Sub + +Public Sub setOptions() + + Options.GrenadePacks = frmMap.cboGrenades.ListIndex + Options.Medikits = frmMap.cboMedikits.ListIndex + Options.StartJet = frmMap.txtJet.Text + Options.Steps = frmMap.cboSteps.ListIndex + Options.Weather = frmMap.cboWeather.ListIndex + Options.BackgroundColor = ARGB(255, RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red)) + Options.BackgroundColor = ARGB(255, RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red)) + + mapTitle = frmMap.txtDesc.Text + +End Sub + +Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) + + Dim Result As VbMsgBoxResult + Dim temp As String + + temp = Data.Files.Item(1) + If right(temp, 1) = """" Then + temp = left(temp, Len(temp) - 1) + temp = right(temp, Len(temp) - 1) + End If + + If LCase$(right(temp, 4)) = ".pms" Then + + If prompt Then + Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) + DoEvents + If Result = vbCancel Then + Exit Sub + ElseIf Result = vbYes Then + mnuSave_Click + If prompt Then Exit Sub + End If + End If + DoEvents + + recentFiles Data.Files.Item(1) + + LoadFile Data.Files.Item(1) + + End If + +End Sub + +Public Sub Form_Paint() + + Render + +End Sub + +Public Sub Terminate() 'You are on the way to destruction. + + Dim Result As VbMsgBoxResult + + On Error GoTo ErrorHandler + + If prompt Then + Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) + DoEvents + If Result = vbCancel Then + Exit Sub + ElseIf Result = vbYes Then + mnuSave_Click + If prompt Then Exit Sub + End If + End If + DoEvents + + saveSettings + + Set mapTexture = Nothing + Set particleTexture = Nothing + Set patternTexture = Nothing + Set sketchTexture = Nothing + Set objectsTexture = Nothing + Set lineTexture = Nothing + Set pathTexture = Nothing + Set rCenterTexture = Nothing + + ReDim SceneryTextures(0) + Set SceneryTextures(0).Texture = Nothing + + DIDevice.Unacquire + + If hEvent <> 0 Then DX.DestroyEvent hEvent + + Set D3DDevice = Nothing + Set DIDevice = Nothing + Set DI = Nothing + Set D3D = Nothing + Set DX = Nothing + + Unload Me + End + + Exit Sub + +ErrorHandler: + + MsgBox "Error terminating" & vbNewLine & Error$ + +End Sub + +Private Sub Form_Resize() + + picHelp.left = frmSoldatMapEditor.ScaleWidth - 80 + picMinimize.left = frmSoldatMapEditor.ScaleWidth - 48 + picMaximize.left = frmSoldatMapEditor.ScaleWidth - 32 + picExit.left = frmSoldatMapEditor.ScaleWidth - 16 + + picProgress.left = frmSoldatMapEditor.ScaleWidth - 136 + +End Sub + +Private Sub MouseHelper_MouseWheel(ctrl As Variant, Direction As MBMouseHelper.mbDirectionConstants, Button As Long, Shift As Long, Cancel As Boolean) + + Dim zoomVal As Single + + If Direction = mbBackward Then + zoomScroll 0.8, mouseCoords.X, mouseCoords.Y + ElseIf Direction = mbForward Then + zoomScroll 1.25, mouseCoords.X, mouseCoords.Y + End If + +End Sub + +Public Sub setPreferences() + + inc = (gridSpacing / gridDivisions) + tvwScenery.Height = formHeight - 41 - 20 + resetDevice + Render + +End Sub + +Public Function setBGColor(Index As Integer) As Long + + frmColor.InitClr bgColors(Index).red, bgColors(Index).green, bgColors(Index).blue + frmColor.Show 1 + bgColors(Index).red = frmColor.red + bgColors(Index).green = frmColor.green + bgColors(Index).blue = frmColor.blue + + bgPolys(1).Color = RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red) + bgPolys(2).Color = RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red) + bgPolys(3).Color = RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red) + bgPolys(4).Color = RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red) + + setBGColor = RGB(bgColors(Index).red, bgColors(Index).green, bgColors(Index).blue) + + Render + +End Function + +Public Sub setLightColor() + + Dim i As Integer + Dim Index As Integer + + For i = 1 To lightCount + If Lights(i).selected = 1 Then + Index = i + Exit For + End If + Next + + frmColor.InitClr Lights(Index).color.red, Lights(Index).color.green, Lights(Index).color.blue + frmColor.Show 1 + + For i = 1 To lightCount + If Lights(i).selected = 1 Then + Lights(i).color.red = frmColor.red + Lights(i).color.green = frmColor.green + Lights(i).color.blue = frmColor.blue + End If + Next + + frmInfo.picLight.BackColor = RGB(frmColor.red, frmColor.green, frmColor.blue) + + applyLights + +End Sub + +Public Sub setRadius(R As Integer) + + Dim i As Integer + + clrRadius = R + Colliders(0).radius = R + + If numSelColliders > 0 Then + For i = 1 To colliderCount + If Colliders(i).active Then + Colliders(i).radius = R + End If + Next + Render + End If + +End Sub + +Public Function setWayType(Index As Integer, tehValue As Boolean) As Boolean + + If numSelWaypoints = 0 Then + setWayType = False + Exit Function + End If + + Dim i As Integer + + For i = 1 To waypointCount + If Waypoints(i).selected Then + Waypoints(i).wayType(Index) = tehValue + If Index = 0 Then + Waypoints(i).wayType(1) = False + ElseIf Index = 1 Then + Waypoints(i).wayType(0) = False + ElseIf Index = 2 Then + Waypoints(i).wayType(3) = False + ElseIf Index = 3 Then + Waypoints(i).wayType(2) = False + End If + End If + Next + + setWayType = True + + Render + +End Function + +Public Sub setPathNum(tehValue As Byte) + + Dim i As Integer + + For i = 1 To waypointCount + If Waypoints(i).selected Then + Waypoints(i).pathNum = tehValue + End If + Next + + Render + +End Sub + +Public Function setSpecial(tehValue As Byte) As Boolean + + Dim i As Integer + + If numSelWaypoints = 0 Then + setSpecial = False + Exit Function + End If + + For i = 1 To waypointCount + If Waypoints(i).selected Then + Waypoints(i).special = tehValue + End If + Next + + setSpecial = True + +End Function + +Public Sub setShowPaths() + + Render + +End Sub + +Public Sub ClearUnused() + + Dim i As Integer, j As Integer + Dim doesExist As Boolean + Dim offset As Integer + Dim numDeleted As Integer + + On Error GoTo ErrorHandler + + offset = 1 + For i = 1 To sceneryElements + For j = 1 To sceneryCount 'check if exists + If Scenery(j).Style = i Then + doesExist = True + Exit For + End If + Next + 'check if duplicate + For j = 0 To offset - 2 + If frmScenery.lstScenery.List(j) = frmScenery.lstScenery.List(offset - 1) Then + doesExist = False + Exit For + End If + Next + SceneryTextures(offset) = SceneryTextures(i) + If doesExist Then 'if does not exist, will get overwritten next time + offset = offset + 1 + Else + numDeleted = numDeleted + 1 + frmScenery.lstScenery.RemoveItem offset - 1 + End If + For j = 1 To sceneryCount + If Scenery(j).Style = i Then + Scenery(j).Style = Scenery(j).Style - numDeleted + End If + Next + doesExist = False + Next + + If numDeleted > 0 Then + + Scenery(0).Style = 0 + + sceneryElements = sceneryElements - numDeleted + ReDim Preserve SceneryTextures(sceneryElements) + + tvwScenery.Nodes.Remove "In Use" + tvwScenery.Nodes.Add "Master List", tvwFirst, "In Use", "In Use" + For i = 0 To frmScenery.lstScenery.ListCount - 1 + tvwScenery.Nodes.Add "In Use", tvwChild, frmScenery.lstScenery.List(i), frmScenery.lstScenery.List(i) + Next + + End If + + numUndo = 0 + + Exit Sub + +ErrorHandler: + + MsgBox "Error clearing unused scenery" & vbNewLine & Error$ + +End Sub + +Private Sub saveSettings() + + Dim X As Integer, Y As Integer + Dim i As Integer, KeyCode As Byte + + Dim iniString As String + Dim currentColor As Long + Dim sNull As String + sNull = Chr$(0) + + 'preferences + iniString = "Dir=" & soldatDir & sNull & "Uncompiled=" & uncompDir & sNull & "Prefabs=" & prefabDir & sNull _ + & "GridSpacing=" & gridSpacing & sNull & "GridDiv=" & gridDivisions & sNull _ + & "GridClr1=" & RGBtoHex(gridClr) & sNull & "GridClr2=" & RGBtoHex(gridClr2) & sNull _ + & "GridAlpha1=" & gridOp1 & sNull & "GridAlpha2=" & gridOp2 & sNull _ + & "PolySrc=" & polyBlendSrc & sNull & "PolyDest=" & polyBlendDest & sNull _ + & "WireSrc=" & wireBlendSrc & sNull & "WireDest=" & wireBlendDest & sNull _ + & "PointClr=" & RGBtoHex(pointClr) & sNull & "SelectionClr=" & RGBtoHex(selectionClr) & sNull _ + & "BackClr=" & RGBtoHex(backClr) & sNull & "MaxUndo=" & max_undo & sNull _ + & "SceneryVerts=" & sceneryVerts & sNull & "Topmost=" & topmost & sNull & sNull + saveSection "Preferences", iniString + + 'display + iniString = "Background=" & showBG & sNull & "Polys=" & showPolys & sNull _ + & "Texture=" & showTexture & sNull & "Wireframe=" & showWireframe & sNull _ + & "Points=" & showPoints & sNull & "Scenery=" & showScenery & sNull _ + & "Objects=" & showObjects & sNull & "Waypoints=" & showWaypoints & sNull _ + & "Grid=" & showGrid & sNull & "Lights=" & showLights & sNull _ + & "Sketch=" & showSketch & sNull & sNull + saveSection "Display", iniString + + 'tool settings + currentColor = RGB(polyClr.blue, polyClr.green, polyClr.red) + iniString = "CurrentTool=" & currentTool & sNull & "SnapVertices=" & ohSnap & sNull _ + & "SnapToGrid=" & snapToGrid & sNull & "FixedTexture=" & fixedTexture & sNull _ + & "Opacity=" & (opacity * 100) & sNull & "ColorRadius=" & clrRadius & sNull _ + & "CurrentColor=" & RGBtoHex(currentColor) & sNull & "ColorMode=" & colorMode & sNull _ + & "BlendMode=" & blendMode & sNull & "SnapRadius=" & snapRadius & sNull _ + & "RotateScenery=" & frmScenery.rotateScenery & sNull & "ScaleScenery=" & frmScenery.scaleScenery & sNull _ + & "TextureWidth=" & xTexture & sNull & "TextureHeight=" & yTexture & sNull _ + & "Texture=" & textureFile & sNull _ + & "CustomX=" & mnuCustomX.Checked & sNull _ + & "CustomY=" & mnuCustomY.Checked & sNull & sNull + saveSection "ToolSettings", iniString + + 'hotkeys + iniString = "Move=" & frmTools.getHotKey(0) & sNull & "Create=" & frmTools.getHotKey(1) & sNull _ + & "VertexSelection=" & frmTools.getHotKey(2) & sNull & "PolySelection=" & frmTools.getHotKey(3) & sNull _ + & "VertexColor=" & frmTools.getHotKey(4) & sNull & "PolyColor=" & frmTools.getHotKey(5) & sNull _ + & "Texture=" & frmTools.getHotKey(6) & sNull & "Scenery=" & frmTools.getHotKey(7) & sNull _ + & "Waypoints=" & frmTools.getHotKey(8) & sNull & "Objects=" & frmTools.getHotKey(9) & sNull _ + & "ColorPicker=" & frmTools.getHotKey(10) & sNull & "Sketch=" & frmTools.getHotKey(11) & sNull _ + & "Lights=" & frmTools.getHotKey(12) & sNull & "Depthmap=" & frmTools.getHotKey(13) & sNull & sNull + saveSection "HotKeys", iniString + + 'waypoint keys + iniString = "Left=" & frmWaypoints.getWayptKey(0) & sNull & "Right=" & frmWaypoints.getWayptKey(1) & sNull _ + & "Up=" & frmWaypoints.getWayptKey(2) & sNull & "Down=" & frmWaypoints.getWayptKey(3) & sNull _ + & "Fly=" & frmWaypoints.getWayptKey(4) & sNull & sNull + saveSection "WaypointKeys", iniString + + 'layer keys + iniString = "Background=" & frmDisplay.getLayerKey(0) & sNull & "Polys=" & frmDisplay.getLayerKey(1) & sNull _ + & "Texture=" & frmDisplay.getLayerKey(2) & sNull & "Wireframe=" & frmDisplay.getLayerKey(3) & sNull _ + & "Points=" & frmDisplay.getLayerKey(4) & sNull & "Scenery=" & frmDisplay.getLayerKey(5) & sNull _ + & "Objects=" & frmDisplay.getLayerKey(6) & sNull & "Waypoints=" & frmDisplay.getLayerKey(7) & sNull & sNull + saveSection "LayerKeys", iniString + + 'palette + frmPalette.savePalette appPath & "\palettes\current.txt" + + 'workspace + iniString = "WindowState=" & Me.WindowState & sNull _ + & "Width=" & formWidth & sNull & "Height=" & formHeight & sNull _ + & "Left=" & formLeft & sNull & "Top=" & formTop & sNull & sNull + saveSection "Main", iniString, appPath & "\workspace\current.ini" + + saveWindow "Tools", frmTools, False + saveWindow "Display", frmDisplay, frmDisplay.collapsed + saveWindow "Properties", frmInfo, frmInfo.collapsed + saveWindow "Palette", frmPalette, frmPalette.collapsed + saveWindow "Scenery", frmScenery, frmScenery.collapsed + saveWindow "Waypoints", frmWaypoints, frmWaypoints.collapsed + saveWindow "Texture", frmTexture, frmTexture.collapsed + + 'recent files + iniString = "01=" & mnuRecent(0).Caption & sNull & "02=" & mnuRecent(1).Caption & sNull _ + & "03=" & mnuRecent(2).Caption & sNull & "04=" & mnuRecent(3).Caption & sNull _ + & "05=" & mnuRecent(4).Caption & sNull & "06=" & mnuRecent(5).Caption & sNull _ + & "07=" & mnuRecent(6).Caption & sNull & "08=" & mnuRecent(7).Caption & sNull _ + & "09=" & mnuRecent(8).Caption & sNull & "10=" & mnuRecent(9).Caption & sNull & sNull + saveSection "RecentFiles", iniString + + 'gfx dir + iniString = "Dir=" & gfxDir & sNull & sNull + saveSection "gfx", iniString + +End Sub + +Private Sub saveWindow(sectionName As String, window As Form, collapsed As Boolean, Optional FileName As String = "current.ini") + + Dim leftVal As Integer, topVal As Integer + Dim iniString As String + Dim sNull As String + sNull = Chr$(0) + + leftVal = window.left / Screen.TwipsPerPixelX + topVal = window.Top / Screen.TwipsPerPixelY + + iniString = "Visible=" & window.Visible & sNull & "Left=" & leftVal & sNull & "Top=" & topVal & sNull _ + & "Collapsed=" & collapsed & sNull & sNull + + saveSection sectionName, iniString, appPath & "\workspace\" & FileName + +End Sub + +Private Function SetIdePath() As Boolean + + appPath = appPath & "\pwinstall" + SetIdePath = True + +End Function + +Private Sub loadINI() + + On Error GoTo ErrorHandler + + appPath = App.path + + Debug.Assert SetIdePath 'workaround for debugging with ide + + Dim i As Integer + Dim numRecent As Integer + Dim errVal As String + + errVal = "1" + + soldatDir = loadString("Preferences", "Dir", , 1024) + uncompDir = loadString("Preferences", "Uncompiled", , 1024) + prefabDir = loadString("Preferences", "Prefabs", , 1024) + + gridSpacing = loadInt("Preferences", "GridSpacing") + gridDivisions = loadInt("Preferences", "GridDiv") + gridClr = HexToLong(loadString("Preferences", "GridClr1")) + gridClr2 = HexToLong(loadString("Preferences", "GridClr2")) + gridOp1 = loadInt("Preferences", "GridAlpha1") + gridOp2 = loadInt("Preferences", "GridAlpha2") + polyBlendSrc = loadInt("Preferences", "PolySrc") + polyBlendDest = loadInt("Preferences", "PolyDest") + wireBlendSrc = loadInt("Preferences", "WireSrc") + wireBlendDest = loadInt("Preferences", "WireDest") + pointClr = HexToLong(loadString("Preferences", "PointClr")) + selectionClr = HexToLong(loadString("Preferences", "SelectionClr")) + backClr = HexToLong(loadString("Preferences", "BackClr")) + max_undo = loadInt("Preferences", "MaxUndo") + sceneryVerts = loadString("Preferences", "SceneryVerts") + topmost = loadString("Preferences", "Topmost") + + errVal = "2" + + showBG = loadString("Display", "Background") + showPolys = loadString("Display", "Polys") + showTexture = loadString("Display", "Texture") + showWireframe = loadString("Display", "Wireframe") + showPoints = loadString("Display", "Points") + showScenery = loadString("Display", "Scenery") + showObjects = loadString("Display", "Objects") + showWaypoints = loadString("Display", "Waypoints") + showGrid = loadString("Display", "Grid") + showLights = loadString("Display", "Lights") + showSketch = loadString("Display", "Sketch") + + errVal = "3" + + currentTool = loadInt("ToolSettings", "CurrentTool") + ohSnap = loadString("ToolSettings", "SnapVertices") + snapToGrid = loadString("ToolSettings", "SnapToGrid") + fixedTexture = loadString("ToolSettings", "FixedTexture") + opacity = loadInt("ToolSettings", "Opacity") / 100 + clrRadius = loadInt("ToolSettings", "ColorRadius") + polyClr = getRGB(HexToLong(loadString("ToolSettings", "CurrentColor"))) + colorMode = loadInt("ToolSettings", "ColorMode") + blendMode = loadInt("ToolSettings", "BlendMode") + snapRadius = loadInt("ToolSettings", "SnapRadius") + frmScenery.rotateScenery = loadString("ToolSettings", "RotateScenery") + frmScenery.scaleScenery = loadString("ToolSettings", "ScaleScenery") + xTexture = loadInt("ToolSettings", "TextureWidth") + yTexture = loadInt("ToolSettings", "TextureHeight") + textureFile = loadString("ToolSettings", "Texture", , 1024) + mnuCustomX.Checked = loadString("ToolSettings", "CustomX") + mnuCustomY.Checked = loadString("ToolSettings", "CustomY") + + errVal = "4" + + frmTools.setHotKey 0, loadInt("HotKeys", "Move") + frmTools.setHotKey 1, loadInt("HotKeys", "Create") + frmTools.setHotKey 2, loadInt("HotKeys", "VertexSelection") + frmTools.setHotKey 3, loadInt("HotKeys", "PolySelection") + frmTools.setHotKey 4, loadInt("HotKeys", "VertexColor") + frmTools.setHotKey 5, loadInt("HotKeys", "PolyColor") + frmTools.setHotKey 6, loadInt("HotKeys", "Texture") + frmTools.setHotKey 7, loadInt("HotKeys", "Scenery") + frmTools.setHotKey 8, loadInt("HotKeys", "Waypoints") + frmTools.setHotKey 9, loadInt("HotKeys", "Objects") + frmTools.setHotKey 10, loadInt("HotKeys", "ColorPicker") + frmTools.setHotKey 11, loadInt("HotKeys", "Sketch") + frmTools.setHotKey 12, loadInt("HotKeys", "Lights") + frmTools.setHotKey 13, loadInt("HotKeys", "DepthMap") + + errVal = "5" + + frmWaypoints.setWayptKey 0, loadInt("WaypointKeys", "Left") + frmWaypoints.setWayptKey 1, loadInt("WaypointKeys", "Right") + frmWaypoints.setWayptKey 2, loadInt("WaypointKeys", "Up") + frmWaypoints.setWayptKey 3, loadInt("WaypointKeys", "Down") + frmWaypoints.setWayptKey 4, loadInt("WaypointKeys", "Fly") + + errVal = "6" + + frmDisplay.setLayerKey 0, loadInt("LayerKeys", "Background") + frmDisplay.setLayerKey 1, loadInt("LayerKeys", "Polys") + frmDisplay.setLayerKey 2, loadInt("LayerKeys", "Texture") + frmDisplay.setLayerKey 3, loadInt("LayerKeys", "Wireframe") + frmDisplay.setLayerKey 4, loadInt("LayerKeys", "Points") + frmDisplay.setLayerKey 5, loadInt("LayerKeys", "Scenery") + frmDisplay.setLayerKey 6, loadInt("LayerKeys", "Objects") + frmDisplay.setLayerKey 7, loadInt("LayerKeys", "Waypoints") + + errVal = "7" + + mnuRecent(0).Caption = loadString("RecentFiles", "01", , 1024) + mnuRecent(1).Caption = loadString("RecentFiles", "02", , 1024) + mnuRecent(2).Caption = loadString("RecentFiles", "03", , 1024) + mnuRecent(3).Caption = loadString("RecentFiles", "04", , 1024) + mnuRecent(4).Caption = loadString("RecentFiles", "05", , 1024) + mnuRecent(5).Caption = loadString("RecentFiles", "06", , 1024) + mnuRecent(6).Caption = loadString("RecentFiles", "07", , 1024) + mnuRecent(7).Caption = loadString("RecentFiles", "08", , 1024) + mnuRecent(8).Caption = loadString("RecentFiles", "09", , 1024) + mnuRecent(9).Caption = loadString("RecentFiles", "10", , 1024) + + errVal = "8" + + PolyTypeClrs(1) = CLng("&H" + (loadString("PolyTypeColors", "OnlyBullets"))) + PolyTypeClrs(2) = CLng("&H" + (loadString("PolyTypeColors", "OnlyPlayer"))) + PolyTypeClrs(3) = CLng("&H" + (loadString("PolyTypeColors", "DoesntCollide"))) + PolyTypeClrs(4) = CLng("&H" + (loadString("PolyTypeColors", "Ice"))) + PolyTypeClrs(5) = CLng("&H" + (loadString("PolyTypeColors", "Deadly"))) + PolyTypeClrs(6) = CLng("&H" + (loadString("PolyTypeColors", "BloodyDeadly"))) + PolyTypeClrs(7) = CLng("&H" + (loadString("PolyTypeColors", "Hurts"))) + PolyTypeClrs(8) = CLng("&H" + (loadString("PolyTypeColors", "Regenerates"))) + PolyTypeClrs(9) = CLng("&H" + (loadString("PolyTypeColors", "Lava"))) + PolyTypeClrs(10) = CLng("&H" + (loadString("PolyTypeColors", "TeamBullets"))) + PolyTypeClrs(11) = CLng("&H" + (loadString("PolyTypeColors", "TeamPlayers"))) + PolyTypeClrs(12) = PolyTypeClrs(10) + PolyTypeClrs(13) = PolyTypeClrs(11) + PolyTypeClrs(14) = PolyTypeClrs(10) + PolyTypeClrs(15) = PolyTypeClrs(11) + PolyTypeClrs(16) = PolyTypeClrs(10) + PolyTypeClrs(17) = PolyTypeClrs(11) + PolyTypeClrs(18) = CLng("&H" + (loadString("PolyTypeColors", "Bouncy"))) + PolyTypeClrs(19) = CLng("&H" + (loadString("PolyTypeColors", "Explosive"))) + PolyTypeClrs(20) = CLng("&H" + (loadString("PolyTypeColors", "HurtFlaggers"))) + PolyTypeClrs(21) = CLng("&H" + (loadString("PolyTypeColors", "OnlyFlagger"))) + PolyTypeClrs(22) = CLng("&H" + (loadString("PolyTypeColors", "NonFlagger"))) + PolyTypeClrs(23) = CLng("&H" + (loadString("PolyTypeColors", "FlagCollides"))) + PolyTypeClrs(24) = CLng("&H" + (loadString("PolyTypeColors", "Back"))) + PolyTypeClrs(25) = CLng("&H" + (loadString("PolyTypeColors", "BackTransition"))) + + errVal = "9" + + gfxDir = loadString("gfx", "Dir", , 1024) + + If gfxDir = "" Then gfxDir = "gfx" + + errVal = "10" + + For i = 1 To 9 + If mnuRecent(i).Caption = "" Then + numRecent = numRecent + 1 + mnuRecent(i).Visible = False + Else + mnuRecent(i).Visible = True + End If + Next + If numRecent = 9 And mnuRecent(0).Caption = "" Then + mnuRecentFiles.Enabled = False + End If + + Exit Sub + +ErrorHandler: + + MsgBox "Error loading ini file" & vbNewLine & Error$ & vbNewLine & errVal + +End Sub + +Private Function getNextValue(sectionString As String, ByRef eIndex As Integer) As String + + Dim nIndex As Integer + + eIndex = InStr(eIndex, sectionString, "=") + 1 + nIndex = InStr(eIndex, sectionString, vbNullChar) + getNextValue = mid$(sectionString, eIndex, nIndex) + +End Function + +Private Sub loadWorkspace(Optional FileName As String = "current.ini") + + On Error GoTo ErrorHandler + + Me.WindowState = loadInt("Main", "WindowState", appPath & "\workspace\" & FileName) + Me.formWidth = loadInt("Main", "Width", appPath & "\workspace\" & FileName) + Me.formHeight = loadInt("Main", "Height", appPath & "\workspace\" & FileName) + Me.formLeft = loadInt("Main", "Left", appPath & "\workspace\" & FileName) + Me.formTop = loadInt("Main", "Top", appPath & "\workspace\" & FileName) + + If Me.WindowState = vbNormal Then + Me.Width = formWidth * Screen.TwipsPerPixelX + Me.Height = formHeight * Screen.TwipsPerPixelY + Me.left = formLeft * Screen.TwipsPerPixelX + Me.Top = formTop * Screen.TwipsPerPixelY + End If + + tvwScenery.Height = formHeight - 41 - 20 + + mnuTools.Checked = loadString("Tools", "Visible", appPath & "\workspace\" & FileName) + frmTools.xPos = loadInt("Tools", "Left", appPath & "\workspace\" & FileName) + frmTools.yPos = loadInt("Tools", "Top", appPath & "\workspace\" & FileName) + frmTools.collapsed = loadString("Tools", "Collapsed", appPath & "\workspace\" & FileName) + + mnuDisplay.Checked = loadString("Display", "Visible", appPath & "\workspace\" & FileName) + frmDisplay.xPos = loadInt("Display", "Left", appPath & "\workspace\" & FileName) + frmDisplay.yPos = loadInt("Display", "Top", appPath & "\workspace\" & FileName) + frmDisplay.collapsed = loadString("Display", "Collapsed", appPath & "\workspace\" & FileName) + + mnuInfo.Checked = loadString("Properties", "Visible", appPath & "\workspace\" & FileName) + frmInfo.xPos = loadInt("Properties", "Left", appPath & "\workspace\" & FileName) + frmInfo.yPos = loadInt("Properties", "Top", appPath & "\workspace\" & FileName) + frmInfo.collapsed = loadString("Properties", "Collapsed", appPath & "\workspace\" & FileName) + + mnuPalette.Checked = loadString("Palette", "Visible", appPath & "\workspace\" & FileName) + frmPalette.xPos = loadInt("Palette", "Left", appPath & "\workspace\" & FileName) + frmPalette.yPos = loadInt("Palette", "Top", appPath & "\workspace\" & FileName) + frmPalette.collapsed = loadString("Palette", "Collapsed", appPath & "\workspace\" & FileName) + + mnuScenery.Checked = loadString("Scenery", "Visible", appPath & "\workspace\" & FileName) + frmScenery.xPos = loadInt("Scenery", "Left", appPath & "\workspace\" & FileName) + frmScenery.yPos = loadInt("Scenery", "Top", appPath & "\workspace\" & FileName) + frmScenery.collapsed = loadString("Scenery", "Collapsed", appPath & "\workspace\" & FileName) + + mnuWaypoints.Checked = loadString("Waypoints", "Visible", appPath & "\workspace\" & FileName) + frmWaypoints.xPos = loadInt("Waypoints", "Left", appPath & "\workspace\" & FileName) + frmWaypoints.yPos = loadInt("Waypoints", "Top", appPath & "\workspace\" & FileName) + frmWaypoints.collapsed = loadString("Waypoints", "Collapsed", appPath & "\workspace\" & FileName) + + mnuTexture.Checked = loadString("Texture", "Visible", appPath & "\workspace\" & FileName) + frmTexture.xPos = loadInt("Texture", "Left", appPath & "\workspace\" & FileName) + frmTexture.yPos = loadInt("Texture", "Top", appPath & "\workspace\" & FileName) + frmTexture.collapsed = loadString("Texture", "Collapsed", appPath & "\workspace\" & FileName) + + Exit Sub + +ErrorHandler: + + MsgBox "Error loading workspace" & vbNewLine & Error$ + +End Sub + +Public Sub loadColors() + + On Error GoTo ErrorHandler + + bgClr = CLng("&H" + loadString("GUIColors", "Background", appPath & "\" & gfxDir & "\colors.ini")) + lblBackClr = CLng("&H" + loadString("GUIColors", "LabelBack", appPath & "\" & gfxDir & "\colors.ini")) + lblTextClr = CLng("&H" + loadString("GUIColors", "LabelText", appPath & "\" & gfxDir & "\colors.ini")) + txtBackClr = CLng("&H" + loadString("GUIColors", "TextBoxBack", appPath & "\" & gfxDir & "\colors.ini")) + txtTextClr = CLng("&H" + loadString("GUIColors", "TextBoxText", appPath & "\" & gfxDir & "\colors.ini")) + frameClr = CLng("&H" + loadString("GUIColors", "Frame", appPath & "\" & gfxDir & "\colors.ini")) + font1 = loadString("GUIColors", "font1", appPath & "\" & gfxDir & "\colors.ini", 40) + font2 = loadString("GUIColors", "font2", appPath & "\" & gfxDir & "\colors.ini", 40) + + If font1 = "" Then font1 = "Arial" + If font2 = "" Then font2 = "Arial" + + Exit Sub + +ErrorHandler: + + MsgBox "Error loading colors" & vbNewLine & Error$ + +End Sub + +Private Sub mnuExit_Click() + + Terminate + +End Sub + +Private Sub mnuNew_Click() + + Dim Result As VbMsgBoxResult + + If prompt Then + Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) + DoEvents + If Result = vbCancel Then + Exit Sub + ElseIf Result = vbYes Then + mnuSave_Click + If prompt Then Exit Sub + End If + End If + newMap + +End Sub + +Private Sub mnuOpen_Click() + + On Error GoTo ErrorHandler + + Dim Result As VbMsgBoxResult + + If prompt Then + Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) + DoEvents + If Result = vbCancel Then + Exit Sub + ElseIf Result = vbYes Then + mnuSave_Click + If prompt Then Exit Sub + End If + End If + DoEvents + + frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" + commonDialog.InitDir = uncompDir + commonDialog.FileName = uncompDir & currentFileName + frmSoldatMapEditor.commonDialog.DialogTitle = "Load Map" + commonDialog.ShowOpen + + If commonDialog.FileName <> "" Then + prompt = False + recentFiles commonDialog.FileName + polyCount = 0 + numSelectedPolys = 0 + ReDim selectedPolys(0) + ReDim vertexList(0) + ReDim Polys(0) + selectedCoords(1).X = 0 + selectedCoords(1).Y = 0 + selectedCoords(2).X = 0 + selectedCoords(2).Y = 0 + LoadFile commonDialog.FileName + End If + + RegainFocus + + Exit Sub + +ErrorHandler: + + If Error$ <> "Cancel was selected." Then + MsgBox "Error opening file" & vbNewLine & Error$ + End If + RegainFocus + +End Sub + +Private Sub mnuOpenCompiled_Click() + + On Error GoTo ErrorHandler + + Dim Result As VbMsgBoxResult + + If prompt Then + Result = MsgBox("Save changes to " & currentFileName & "?", vbYesNoCancel) + DoEvents + If Result = vbCancel Then + Exit Sub + ElseIf Result = vbYes Then + mnuSave_Click + If prompt Then Exit Sub + End If + End If + DoEvents + + frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" + commonDialog.InitDir = soldatDir & "Maps\" + commonDialog.FileName = soldatDir & "Maps\" & currentFileName + frmSoldatMapEditor.commonDialog.DialogTitle = "Load Map" + commonDialog.ShowOpen + + If commonDialog.FileName <> "" Then + prompt = False + recentFiles commonDialog.FileName + polyCount = 0 + numSelectedPolys = 0 + ReDim selectedPolys(0) + ReDim vertexList(0) + ReDim Polys(0) + selectedCoords(1).X = 0 + selectedCoords(1).Y = 0 + selectedCoords(2).X = 0 + selectedCoords(2).Y = 0 + LoadFile commonDialog.FileName + End If + + RegainFocus + + Exit Sub + +ErrorHandler: + + If Error$ <> "Cancel was selected." Then + MsgBox "Error opening compiled map" & vbNewLine & Error$ + End If + RegainFocus + +End Sub + +Private Sub mnuSave_Click() + + Dim i As Integer + + On Error GoTo ErrorHandler + + frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" + frmSoldatMapEditor.commonDialog.DialogTitle = "Save Map" + commonDialog.FileName = uncompDir & currentFileName + commonDialog.InitDir = uncompDir + + If lblFileName.Caption = "Untitled.pms" Then + + commonDialog.ShowSave + + If commonDialog.FileName <> "" Then + + recentFiles commonDialog.FileName + + DoEvents + SaveFile commonDialog.FileName + prompt = False + End If + + Else + SaveFile commonDialog.FileName + prompt = False + End If + + RegainFocus + + Exit Sub + +ErrorHandler: + + If Error$ <> "Cancel was selected." Then + MsgBox "Error saving file" & vbNewLine & Error$ + End If + RegainFocus + +End Sub + +Private Sub mnuSaveAs_Click() + + Dim i As Integer + + On Error GoTo ErrorHandler + + frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" + commonDialog.InitDir = appPath & "\Maps\" + commonDialog.FileName = appPath & "\Maps\" & currentFileName + frmSoldatMapEditor.commonDialog.DialogTitle = "Save Map" + commonDialog.ShowSave + + If commonDialog.FileName <> "" Then + + recentFiles commonDialog.FileName + + DoEvents + SaveFile commonDialog.FileName + prompt = False + End If + + RegainFocus + + Exit Sub + +ErrorHandler: + + If Error$ <> "Cancel was selected." Then + MsgBox "Error saving as" & vbNewLine & Error$ + End If + RegainFocus + +End Sub + +Private Sub mnuCompile_Click() + + Dim i As Integer + Dim length As Integer + + On Error GoTo ErrorHandler + + frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" + commonDialog.InitDir = frmSoldatMapEditor.soldatDir & "Maps\" + commonDialog.FileName = frmSoldatMapEditor.soldatDir & "Maps\" & currentFileName + frmSoldatMapEditor.commonDialog.DialogTitle = "Compile to pms" + + If lblFileName.Caption = "Untitled.pms" Then + + commonDialog.ShowSave + DoEvents + + If commonDialog.FileName <> "" Then + + SaveAndCompile commonDialog.FileName + prompt = False + + For i = 1 To Len(commonDialog.FileName) + If mid(commonDialog.FileName, i, 1) = "\" Then + length = i + 1 + End If + Next + lastCompiled = mid(commonDialog.FileName, length, Len(commonDialog.FileName) - length - 3) + End If + Else + SaveAndCompile commonDialog.FileName + prompt = False + + For i = 1 To Len(commonDialog.FileName) + If mid(commonDialog.FileName, i, 1) = "\" Then + length = i + 1 + End If + Next + lastCompiled = mid(commonDialog.FileName, length, Len(commonDialog.FileName) - length - 3) + + End If + + RegainFocus + + Exit Sub + +ErrorHandler: + + If Error$ <> "Cancel was selected." Then + MsgBox "Error compiling map" & vbNewLine & Error$ + End If + RegainFocus + +End Sub + +Private Sub mnuCompileAs_Click() + + Dim i As Integer + Dim length As Integer + + On Error GoTo ErrorHandler + + frmSoldatMapEditor.commonDialog.Filter = "Map File (*.pms)|*.pms" + commonDialog.InitDir = frmSoldatMapEditor.soldatDir & "Maps\" + commonDialog.FileName = frmSoldatMapEditor.soldatDir & "Maps\" & currentFileName + frmSoldatMapEditor.commonDialog.DialogTitle = "Compile to pms" + commonDialog.ShowSave + + If commonDialog.FileName <> "" Then + DoEvents + SaveAndCompile commonDialog.FileName + prompt = False + + For i = 1 To Len(commonDialog.FileName) + If mid(commonDialog.FileName, i, 1) = "\" Then + length = i + 1 + End If + Next + lastCompiled = mid(commonDialog.FileName, length, Len(commonDialog.FileName) - length - 3) + End If + + RegainFocus + + Exit Sub + +ErrorHandler: + + If Error$ <> "Cancel was selected." Then + MsgBox "Error compiling map" & vbNewLine & Error$ + End If + RegainFocus + +End Sub + +Private Function recentFiles(FileName As String) As Boolean + + Dim i As Integer + Dim inRecent As Boolean + Dim Index As Integer + + For i = 0 To 9 + If mnuRecent(i).Caption = FileName Then + inRecent = True + Index = i + End If + Next + If Not inRecent Then + updateRecent FileName + Else + For i = Index To 1 Step -1 + mnuRecent(i).Caption = mnuRecent(i - 1).Caption + Next + mnuRecent(0).Caption = FileName + End If + +End Function + +Private Sub mnuExport_Click() + + On Error GoTo ErrorHandler + + frmSoldatMapEditor.commonDialog.Filter = "Prefab (*.pfb)|*.pfb" + commonDialog.InitDir = prefabDir + commonDialog.FileName = "Untitled.pfb" + frmSoldatMapEditor.commonDialog.DialogTitle = "Save Prefab" + commonDialog.ShowSave + + If commonDialog.FileName <> "" Then + + savePrefab commonDialog.FileName + + End If + + RegainFocus + + Exit Sub + +ErrorHandler: + + If Error$ <> "Cancel was selected." Then + MsgBox "Error exporting" & vbNewLine & Error$ + End If + RegainFocus + +End Sub + +Private Sub mnuImport_Click() + + On Error GoTo ErrorHandler + + commonDialog.Filter = "Prefab (*.pfb)|*.pfb" + commonDialog.InitDir = prefabDir + commonDialog.FileName = "" + commonDialog.DialogTitle = "Import" + commonDialog.ShowOpen + + If commonDialog.FileName <> "" Then + + loadPrefab commonDialog.FileName + + End If + + RegainFocus + + Exit Sub + +ErrorHandler: + + If Error$ <> "Cancel was selected." Then + MsgBox "Error importing" & vbNewLine & Error$ + End If + RegainFocus + +End Sub + +Private Sub savePrefab(FileName As String) + + On Error GoTo ErrorHandler + + Dim i As Integer, j As Integer + Dim Polygon As TPolygon + Dim elementName(50) As Byte + Dim elementString As String + Dim numSelCon As Integer + Dim offset As Integer + Dim tempConnection As TConnection + Dim alpha As Byte + + Open FileName For Binary Access Write Lock Write As #1 + + Put #1, , numSelectedPolys + For i = 1 To numSelectedPolys + Polygon = Polys(selectedPolys(i)) + For j = 1 To 3 + Polygon.vertex(j).X = PolyCoords(selectedPolys(i)).vertex(j).X + Polygon.vertex(j).Y = PolyCoords(selectedPolys(i)).vertex(j).Y + vertexList(selectedPolys(i)).vertex(j) = 1 + alpha = getAlpha(Polys(selectedPolys(i)).vertex(j).Color) + Polygon.vertex(j).Color = ARGB(alpha, RGB(vertexList(selectedPolys(i)).color(j).blue, vertexList(selectedPolys(i)).color(j).green, vertexList(selectedPolys(i)).color(j).red)) + Next + Put #1, , Polygon + Put #1, , vertexList(selectedPolys(i)).vertex(1) + Put #1, , vertexList(selectedPolys(i)).vertex(2) + Put #1, , vertexList(selectedPolys(i)).vertex(3) + Put #1, , vertexList(selectedPolys(i)).polyType + Next + + Put #1, , numSelectedScenery + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + Put #1, , Scenery(i) + elementString = frmScenery.lstScenery.List(Scenery(i).Style - 1) + elementName(0) = Len(elementString) + For j = 1 To elementName(0) + elementName(j) = Asc(mid(elementString, j, 1)) + Next + Put #1, , elementName + End If + Next + + Put #1, , numSelColliders + For i = 1 To colliderCount + If Colliders(i).active = 1 Then + Put #1, , Colliders(i) + End If + Next + + Put #1, , numSelSpawns + For i = 1 To spawnPoints + If Spawns(i).active = 1 Then + Put #1, , Spawns(i) + End If + Next + + offset = 0 + Put #1, , numSelWaypoints + For i = 1 To waypointCount + If Waypoints(i).selected Then + offset = offset + 1 + Waypoints(i).tempIndex = offset + Put #1, , Waypoints(i) + End If + Next + + numSelCon = 0 + For i = 1 To conCount + If Waypoints(Connections(i).point1).selected And Waypoints(Connections(i).point2).selected Then + numSelCon = numSelCon + 1 + End If + Next + + Put #1, , numSelCon + For i = 1 To conCount + If Waypoints(Connections(i).point1).selected And Waypoints(Connections(i).point2).selected Then + tempConnection.point1 = Waypoints(Connections(i).point1).tempIndex + tempConnection.point2 = Waypoints(Connections(i).point2).tempIndex + Put #1, , tempConnection + End If + Next + + For i = 1 To waypointCount + Waypoints(i).tempIndex = i + Next + + Close #1 + + Exit Sub + +ErrorHandler: + + MsgBox Error$ + +End Sub + +Private Sub loadPrefab(FileName As String) + + On Error GoTo ErrorHandler + + Dim newPolys As Integer, newScenery As Integer + Dim newElements As Integer + Dim elementName(50) As Byte + Dim elementString As String + Dim newColliders As Integer, newSpawnPoints As Integer, newWaypoints As Integer, newConnections As Integer + Dim i As Integer, j As Integer + Dim tehValue As Integer + Dim tempClr As TColor + + mnuDeselect_Click + + Open FileName For Binary Access Read Lock Read As #1 + + Get #1, , newPolys + If newPolys > 0 Then + ReDim Preserve Polys(polyCount + newPolys) + ReDim Preserve PolyCoords(polyCount + newPolys) + ReDim Preserve vertexList(polyCount + newPolys) + numSelectedPolys = newPolys + ReDim selectedPolys(newPolys) + + For i = 1 To newPolys + tehValue = polyCount + i + Get #1, , Polys(tehValue) + Get #1, , vertexList(tehValue).vertex(1) + Get #1, , vertexList(tehValue).vertex(2) + Get #1, , vertexList(tehValue).vertex(3) + Get #1, , vertexList(tehValue).polyType + For j = 1 To 3 + PolyCoords(tehValue).vertex(j).X = Polys(tehValue).vertex(j).X + PolyCoords(tehValue).vertex(j).Y = Polys(tehValue).vertex(j).Y + Polys(tehValue).vertex(j).X = (PolyCoords(tehValue).vertex(j).X - scrollCoords(2).X) * zoomFactor + Polys(tehValue).vertex(j).Y = (PolyCoords(tehValue).vertex(j).Y - scrollCoords(2).Y) * zoomFactor + tempClr = getRGB(Polys(tehValue).vertex(j).Color) + vertexList(tehValue).color(j).red = tempClr.red + vertexList(tehValue).color(j).green = tempClr.green + vertexList(tehValue).color(j).blue = tempClr.blue + Next + selectedPolys(i) = tehValue + Next + polyCount = polyCount + newPolys + End If + + Get #1, , newScenery + If newScenery > 0 Then + If Not showScenery Then + showScenery = True + frmDisplay.setLayer 5, showScenery + End If + numSelectedScenery = newScenery + ReDim Preserve Scenery(sceneryCount + newScenery) + If newScenery > 0 Then + For i = 1 To newScenery + tehValue = sceneryCount + i + Get #1, , Scenery(tehValue) + Scenery(tehValue).screenTr.X = (Scenery(tehValue).Translation.X - scrollCoords(2).X) * zoomFactor + Scenery(tehValue).screenTr.Y = (Scenery(tehValue).Translation.Y - scrollCoords(2).Y) * zoomFactor + Scenery(tehValue).Style = 0 + + Get #1, , elementName + 'get scenery name + elementString = "" + For j = 1 To elementName(0) + elementString = elementString + Chr$(elementName(j)) + Next + 'find scenery in list + For j = 1 To sceneryElements + If frmScenery.lstScenery.List(j - 1) = elementString Then + Scenery(tehValue).Style = j + End If + Next + 'scenery not in list, so load it + If Scenery(tehValue).Style = 0 Then + CreateSceneryTexture elementString + Scenery(tehValue).Style = sceneryElements + End If + Next + End If + End If + sceneryCount = sceneryCount + newScenery + + Get #1, , newColliders + If newColliders > 0 Then + showObjects = True + numSelColliders = newColliders + ReDim Preserve Colliders(colliderCount + newColliders) + For i = 1 To newColliders + Get #1, , Colliders(colliderCount + i) + Next + colliderCount = colliderCount + newColliders + End If + + Get #1, , newSpawnPoints + If newSpawnPoints > 0 Then + showObjects = True + numSelSpawns = newSpawnPoints + ReDim Preserve Spawns(spawnPoints + newSpawnPoints) + For i = 1 To newSpawnPoints + Get #1, , Spawns(spawnPoints + i) + Next + spawnPoints = spawnPoints + newSpawnPoints + End If + + Get #1, , newWaypoints + If newWaypoints > 0 Then + showWaypoints = True + numSelWaypoints = newWaypoints + ReDim Preserve Waypoints(waypointCount + newWaypoints) + For i = 1 To newWaypoints + Get #1, , Waypoints(waypointCount + i) + Next + Get #1, , newConnections + If newConnections > 0 Then + ReDim Preserve Connections(conCount + newConnections) + For i = 1 To newConnections + Get #1, , Connections(conCount + i) + Connections(conCount + i).point1 = Connections(conCount + i).point1 + waypointCount + Connections(conCount + i).point2 = Connections(conCount + i).point2 + waypointCount + Next + conCount = conCount + newConnections + End If + waypointCount = waypointCount + newWaypoints + For i = 1 To waypointCount + Waypoints(i).tempIndex = i + Next + End If + + frmDisplay.setLayer 6, showObjects + + Close #1 + + setMapData + + getInfo + getRCenter + + Exit Sub + +ErrorHandler: + + MsgBox Error$ + +End Sub + +Private Sub mnuRunSoldat_Click() + + SetGameMode lastCompiled + SetMapList lastCompiled + RunSoldat + +End Sub + +Private Sub SetMapList(FileName As String) + + Open soldatDir & "mapslist.txt" For Output As #1 + Print #1, FileName + Close #1 + +End Sub + +Private Sub mnuUndo_Click() + + loadUndo False + +End Sub + +Private Sub mnuRedo_Click() + + loadUndo True + +End Sub + +Private Sub mnuDuplicate_Click() + + Dim i As Integer, j As Integer + Dim offset As Integer + + On Error GoTo ErrorHandler + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + polyCount = polyCount + numSelectedPolys + ReDim Preserve Polys(polyCount) + ReDim Preserve PolyCoords(polyCount) + ReDim Preserve vertexList(polyCount) + For i = 1 To numSelectedPolys + PolyCoords(polyCount - numSelectedPolys + i) = PolyCoords(selectedPolys(i)) + PolyCoords(polyCount - numSelectedPolys + i).vertex(1).X = PolyCoords(selectedPolys(i)).vertex(1).X + 32 + PolyCoords(polyCount - numSelectedPolys + i).vertex(2).X = PolyCoords(selectedPolys(i)).vertex(2).X + 32 + PolyCoords(polyCount - numSelectedPolys + i).vertex(3).X = PolyCoords(selectedPolys(i)).vertex(3).X + 32 + Polys(polyCount - numSelectedPolys + i) = Polys(selectedPolys(i)) + Polys(polyCount - numSelectedPolys + i).vertex(1).X = (PolyCoords(polyCount - numSelectedPolys + i).vertex(1).X - scrollCoords(2).X) * zoomFactor + Polys(polyCount - numSelectedPolys + i).vertex(2).X = (PolyCoords(polyCount - numSelectedPolys + i).vertex(2).X - scrollCoords(2).X) * zoomFactor + Polys(polyCount - numSelectedPolys + i).vertex(3).X = (PolyCoords(polyCount - numSelectedPolys + i).vertex(3).X - scrollCoords(2).X) * zoomFactor + vertexList(polyCount - numSelectedPolys + i).polyType = vertexList(selectedPolys(i)).polyType + vertexList(polyCount - numSelectedPolys + i).color(1) = vertexList(selectedPolys(i)).color(1) + vertexList(polyCount - numSelectedPolys + i).color(2) = vertexList(selectedPolys(i)).color(2) + vertexList(polyCount - numSelectedPolys + i).color(3) = vertexList(selectedPolys(i)).color(3) + For j = 1 To 3 + vertexList(selectedPolys(i)).vertex(j) = 0 + vertexList(polyCount - numSelectedPolys + i).vertex(j) = 1 + Next + selectedPolys(i) = polyCount - numSelectedPolys + i + Next + + End If + offset = 0 + If numSelectedScenery > 0 Then + ReDim Preserve Scenery(sceneryCount + numSelectedScenery) + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + offset = offset + 1 + Scenery(sceneryCount + offset) = Scenery(i) + Scenery(sceneryCount + offset).Translation.X = Scenery(sceneryCount + offset).Translation.X + 32 + Scenery(sceneryCount + offset).screenTr.X = Scenery(sceneryCount + offset).screenTr.X + 32 * zoomFactor + Scenery(i).selected = 0 + End If + Next + sceneryCount = sceneryCount + numSelectedScenery + End If + + If numSelectedScenery > 0 Or numSelectedPolys > 0 Then + rCenter.X = rCenter.X + 32 + selRect(0).X = selRect(0).X + 32 + selRect(1).X = selRect(1).X + 32 + selRect(2).X = selRect(2).X + 32 + selRect(3).X = selRect(3).X + 32 + End If + + offset = 0 + For i = 1 To spawnPoints + If Spawns(i).active = 1 Then + offset = offset + 1 + ReDim Preserve Spawns(spawnPoints + offset) + Spawns(spawnPoints + offset) = Spawns(i) + Spawns(spawnPoints + offset).X = Spawns(spawnPoints + offset).X + 32 + Spawns(i).active = 0 + End If + Next + spawnPoints = spawnPoints + offset + + offset = 0 + For i = 1 To colliderCount + If Colliders(i).active = 1 Then + offset = offset + 1 + ReDim Preserve Colliders(colliderCount + offset) + Colliders(colliderCount + offset) = Colliders(i) + Colliders(colliderCount + offset).X = Colliders(colliderCount + offset).X + 32 + Colliders(i).active = 0 + End If + Next + colliderCount = colliderCount + offset + + If numSelWaypoints > 0 Then + + offset = 0 + For i = 1 To waypointCount + If Waypoints(i).selected Then + offset = offset + 1 + ReDim Preserve Waypoints(waypointCount + offset) + Waypoints(waypointCount + offset) = Waypoints(i) + Waypoints(waypointCount + offset).X = Waypoints(waypointCount + offset).X + 32 + Waypoints(waypointCount + offset).tempIndex = 0 + Waypoints(i).tempIndex = waypointCount + offset + End If + Next + + waypointCount = waypointCount + offset + + offset = 0 + For i = 1 To conCount + If Waypoints(Connections(i).point1).selected And Waypoints(Connections(i).point2).selected Then + offset = offset + 1 + ReDim Preserve Connections(conCount + offset) + Connections(conCount + offset).point1 = Waypoints(Connections(i).point1).tempIndex + Connections(conCount + offset).point2 = Waypoints(Connections(i).point2).tempIndex + End If + Next + + conCount = conCount + offset + + For i = 1 To waypointCount + If Waypoints(i).tempIndex > 0 Then + Waypoints(i).selected = False + End If + Waypoints(i).tempIndex = i + Next + + End If + + setMapData + + getRCenter + + SaveUndo + Render + getInfo + + prompt = True + + Exit Sub + +ErrorHandler: + + MsgBox "Duplicate error" & vbNewLine & Error$ + +End Sub + +Private Sub mnuClear_Click() + + deletePolys + +End Sub + +Private Sub mnuSelectAll_Click() + + Dim i As Integer, j As Integer + + If showPolys Or showWireframe Or showPoints Then + ReDim selectedPolys(polyCount) + For i = 1 To polyCount + selectedPolys(i) = i + For j = 1 To 3 + vertexList(i).vertex(j) = 1 + Next + Next + numSelectedPolys = polyCount + End If + + If showScenery Or showWireframe Or showPoints Then + numSelectedScenery = 0 + For i = 1 To sceneryCount + If (Scenery(i).level = 0 And sslBack) Or (Scenery(i).level = 1 And sslMid) Or (Scenery(i).level = 2 And sslFront) Then + Scenery(i).selected = 1 + numSelectedScenery = numSelectedScenery + 1 + End If + Next + End If + + If showObjects Then + For i = 1 To spawnPoints + Spawns(i).active = 1 + Next + numSelSpawns = spawnPoints + For i = 1 To colliderCount + Colliders(i).active = 1 + Next + numSelColliders = colliderCount + End If + + If showLights Then + For i = 1 To lightCount + Lights(i).selected = 1 + Next + numSelLights = lightCount + End If + + If showWaypoints Then + For i = 1 To waypointCount + Waypoints(i).selected = True + Next + numSelWaypoints = waypointCount + End If + + getRCenter + getInfo + + Render + +End Sub + +Private Sub mnuDeselect_Click() + + Dim i As Integer, j As Integer + + numSelectedPolys = 0 + ReDim selectedPolys(0) + numSelectedScenery = 0 + numSelSpawns = 0 + numSelColliders = 0 + numSelWaypoints = 0 + + For i = 1 To polyCount + For j = 1 To 3 + vertexList(i).vertex(j) = 0 + Next + Next + For i = 1 To sceneryCount + Scenery(i).selected = 0 + Next + For i = 1 To colliderCount + Colliders(i).active = 0 + Next + For i = 1 To spawnPoints + Spawns(i).active = 0 + Next + For i = 1 To waypointCount + Waypoints(i).selected = False + Next + + Render + getInfo + +End Sub + +Private Sub mnuSelColor_Click() + + Dim i As Integer, j As Integer + Dim addPoly As Byte + Dim clrVal As TColor + + numSelectedPolys = 0 + ReDim selectedPolys(0) + + For i = 1 To polyCount + For j = 1 To 3 + vertexList(i).vertex(j) = 0 + clrVal = getRGB(Polys(i).vertex(j).Color) + If clrVal.red = polyClr.red And clrVal.green = polyClr.green And clrVal.blue = polyClr.blue Then + addPoly = 1 + vertexList(i).vertex(j) = 1 + End If + Next + If addPoly = 1 Then + numSelectedPolys = numSelectedPolys + 1 + ReDim Preserve selectedPolys(numSelectedPolys) + selectedPolys(numSelectedPolys) = i + End If + addPoly = 0 + Next + + Render + +End Sub + +Private Sub mnuBringToFront_Click() + + Dim i As Integer, j As Integer + Dim tempTri As TTriangle + Dim tempPoly As TPolygon + Dim tempScenery As TScenery + Dim tempVertex As TVertexData + Dim offset As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + offset = polyCount + For i = polyCount To 1 Step -1 + If (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) > 0 Then 'if selected + tempPoly = Polys(i) + tempTri = PolyCoords(i) + tempVertex = vertexList(i) + For j = i To (offset - 1) + Polys(j) = Polys(j + 1) + PolyCoords(j) = PolyCoords(j + 1) + vertexList(j) = vertexList(j + 1) + Next + Polys(offset) = tempPoly + PolyCoords(offset) = tempTri + vertexList(offset) = tempVertex + + selectedPolys(polyCount - offset + 1) = offset + offset = offset - 1 + End If + Next + End If + + If numSelectedScenery > 0 Then + offset = sceneryCount + For i = sceneryCount To 1 Step -1 + If Scenery(i).selected Then 'if selected + tempScenery = Scenery(i) + For j = i To (offset - 1) + Scenery(j) = Scenery(j + 1) + Next + Scenery(offset) = tempScenery + offset = offset - 1 + End If + Next + End If + + prompt = True + SaveUndo + Render + getInfo + +End Sub + +Private Sub mnuSendToBack_Click() + + Dim i As Integer, j As Integer + Dim tempTri As TTriangle + Dim tempPoly As TPolygon + Dim tempScenery As TScenery + Dim tempVertex As TVertexData + Dim offset As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + offset = 1 + For i = 1 To polyCount + If (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) > 0 Then 'if selected + tempPoly = Polys(i) + tempTri = PolyCoords(i) + tempVertex = vertexList(i) + For j = i To offset + 1 Step -1 + Polys(j) = Polys(j - 1) + PolyCoords(j) = PolyCoords(j - 1) + vertexList(j) = vertexList(j - 1) + Next + Polys(offset) = tempPoly + PolyCoords(offset) = tempTri + vertexList(offset) = tempVertex + + selectedPolys(offset) = offset + offset = offset + 1 + End If + Next + End If + + + If numSelectedScenery > 0 Then + offset = 1 + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then 'if selected + tempScenery = Scenery(i) + For j = i To offset + 1 Step -1 + Scenery(j) = Scenery(j - 1) + Next + Scenery(offset) = tempScenery + offset = offset + 1 + End If + Next + End If + + prompt = True + SaveUndo + Render + getInfo + +End Sub + +Private Sub mnuBringForward_Click() + + Dim i As Integer + Dim tempTri As TTriangle + Dim tempPoly As TPolygon + Dim tempScenery As TScenery + Dim tempVertex As TVertexData + Dim offset As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + offset = polyCount + For i = (polyCount - 1) To 1 Step -1 + If (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) > 0 Then 'if selected + If (vertexList(i + 1).vertex(1) + vertexList(i + 1).vertex(2) + vertexList(i + 1).vertex(3)) > 0 Then + selectedPolys(polyCount - offset + 1) = i + 1 + offset = offset - 1 + Else + tempPoly = Polys(i) + tempTri = PolyCoords(i) + tempVertex = vertexList(i) + + Polys(i) = Polys(i + 1) + PolyCoords(i) = PolyCoords(i + 1) + vertexList(i) = vertexList(i + 1) + + Polys(i + 1) = tempPoly + PolyCoords(i + 1) = tempTri + vertexList(i + 1) = tempVertex + + selectedPolys(polyCount - offset + 1) = i + 1 + offset = offset - 1 + End If + End If + Next + End If + + If numSelectedScenery > 0 Then + offset = sceneryCount + For i = (sceneryCount - 1) To 1 Step -1 + If Scenery(i).selected = 1 Then 'if selected + If Scenery(i + 1).selected = 1 Then + offset = offset - 1 + Else + tempScenery = Scenery(i) + Scenery(i) = Scenery(i + 1) + Scenery(i + 1) = tempScenery + offset = offset - 1 + End If + End If + Next + End If + + prompt = True + SaveUndo + Render + getInfo + +End Sub + +Private Sub mnuSendBackward_Click() + + Dim i As Integer + Dim tempTri As TTriangle + Dim tempPoly As TPolygon + Dim tempVertex As TVertexData + Dim offset As Integer + Dim tempScenery As TScenery + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + offset = 1 + For i = 2 To polyCount + If (vertexList(i).vertex(1) + vertexList(i).vertex(2) + vertexList(i).vertex(3)) > 0 Then 'if selected + If (vertexList(i - 1).vertex(1) + vertexList(i - 1).vertex(2) + vertexList(i - 1).vertex(3)) > 0 Then + selectedPolys(offset) = i - 1 + offset = offset + 1 + Else + tempPoly = Polys(i) + tempTri = PolyCoords(i) + tempVertex = vertexList(i) + + Polys(i) = Polys(i - 1) + PolyCoords(i) = PolyCoords(i - 1) + vertexList(i) = vertexList(i - 1) + + Polys(i - 1) = tempPoly + PolyCoords(i - 1) = tempTri + vertexList(i - 1) = tempVertex + + selectedPolys(offset) = i - 1 + offset = offset + 1 + End If + End If + Next + End If + + If numSelectedScenery > 0 Then + offset = 1 + For i = 2 To sceneryCount + If Scenery(i).selected = 1 Then 'if selected + If Scenery(i - 1).selected = 1 Then + offset = offset + 1 + Else + tempScenery = Scenery(i) + Scenery(i) = Scenery(i - 1) + Scenery(i - 1) = tempScenery + offset = offset + 1 + End If + End If + Next + End If + + prompt = True + SaveUndo + Render + getInfo + +End Sub + +Private Sub mnuFixTexture_Click() + + Dim PolyNum As Integer + Dim i As Integer, j As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + PolyNum = selectedPolys(i) + For j = 1 To 3 + If vertexList(PolyNum).vertex(j) = 1 Then + Polys(PolyNum).vertex(j).tu = (PolyCoords(PolyNum).vertex(j).X / xTexture) + Polys(PolyNum).vertex(j).tv = (PolyCoords(PolyNum).vertex(j).Y / yTexture) + End If + Next + Next + prompt = True + End If + + SaveUndo + Render + getInfo + +End Sub + +Private Sub mnuUntexture_Click() + + Dim i As Integer, j As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then + Polys(selectedPolys(i)).vertex(j).tu = 1 + Polys(selectedPolys(i)).vertex(j).tv = 1 + End If + Next + Next + prompt = True + End If + + SaveUndo + Render + getInfo + +End Sub + +Private Sub mnuVisible_Click() + + Dim i As Integer, j As Integer + + On Error GoTo ErrorHandler + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + For i = 1 To numSelectedPolys + For j = 1 To 3 + If Polys(selectedPolys(i)).vertex(j).z < 0 Then + Polys(selectedPolys(i)).vertex(j).rhw = 1 + Polys(selectedPolys(i)).vertex(j).z = 1 + Else + Polys(selectedPolys(i)).vertex(j).rhw = -10 + Polys(selectedPolys(i)).vertex(j).z = -1 + End If + Next + Next + + prompt = True + SaveUndo + Render + + Exit Sub + +ErrorHandler: + + MsgBox Error$ + +End Sub + +Private Sub mnuAverage_Click() + + AverageVertices + +End Sub + +Private Sub mnuApplyLight_Click() + + Dim i As Integer, j As Integer + Dim tehClr As TColor + + If lightCount = 0 Then Exit Sub + + If numSelectedPolys > 0 Then + + For i = 1 To numSelectedPolys + For j = 1 To 3 + 'apply poly color to base color + tehClr = getRGB(Polys(selectedPolys(i)).vertex(j).Color) + vertexList(selectedPolys(i)).color(j).red = tehClr.red + vertexList(selectedPolys(i)).color(j).green = tehClr.green + vertexList(selectedPolys(i)).color(j).blue = tehClr.blue + Next + Next + + Else + + For i = 1 To polyCount + For j = 1 To 3 + 'apply poly color to base color + tehClr = getRGB(Polys(i).vertex(j).Color) + vertexList(i).color(j).red = tehClr.red + vertexList(i).color(j).green = tehClr.green + vertexList(i).color(j).blue = tehClr.blue + Next + Next + + End If + + ReDim Lights(0) + lightCount = 0 + + Render + +End Sub + +Private Sub mnuSplit_Click() + + If numSelectedPolys < 1 Then Exit Sub + + Dim i As Integer, j As Integer + Dim left As Byte, right As Byte + Dim clr1 As TColor + Dim clr2 As TColor + Dim alpha1 As Byte + Dim alpha2 As Byte + Dim newPolys As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + For i = 1 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then + If j = 1 Then + left = 2 + right = 3 + ElseIf j = 2 Then + left = 3 + right = 1 + ElseIf j = 3 Then + left = 1 + right = 2 + End If + polyCount = polyCount + 1 + newPolys = newPolys + 1 + + ReDim Preserve Polys(polyCount) + ReDim Preserve PolyCoords(polyCount) + ReDim Preserve vertexList(polyCount) + + ReDim Preserve selectedPolys(numSelectedPolys + newPolys) + selectedPolys(numSelectedPolys + newPolys) = polyCount + vertexList(polyCount).vertex(j) = 1 + + PolyCoords(polyCount).vertex(j) = PolyCoords(selectedPolys(i)).vertex(j) + PolyCoords(polyCount).vertex(left) = PolyCoords(selectedPolys(i)).vertex(left) + + PolyCoords(polyCount).vertex(right).X = Midpoint(PolyCoords(selectedPolys(i)).vertex(left).X, PolyCoords(selectedPolys(i)).vertex(right).X) + PolyCoords(polyCount).vertex(right).Y = Midpoint(PolyCoords(selectedPolys(i)).vertex(left).Y, PolyCoords(selectedPolys(i)).vertex(right).Y) + + PolyCoords(selectedPolys(i)).vertex(left) = PolyCoords(polyCount).vertex(right) + + Polys(polyCount).vertex(j) = Polys(selectedPolys(i)).vertex(j) + Polys(polyCount).vertex(left) = Polys(selectedPolys(i)).vertex(left) + Polys(polyCount).Perp.vertex(1).z = 2 + Polys(polyCount).Perp.vertex(2).z = 2 + Polys(polyCount).Perp.vertex(3).z = 2 + + 'coords + Polys(polyCount).vertex(right) = Polys(selectedPolys(i)).vertex(right) + Polys(polyCount).vertex(right).X = (PolyCoords(polyCount).vertex(right).X - scrollCoords(2).X) * zoomFactor + Polys(polyCount).vertex(right).Y = (PolyCoords(polyCount).vertex(right).Y - scrollCoords(2).Y) * zoomFactor + + 'texture coords + Polys(polyCount).vertex(right).tu = Midpoint(Polys(selectedPolys(i)).vertex(right).tu, Polys(polyCount).vertex(left).tu) + Polys(polyCount).vertex(right).tv = Midpoint(Polys(selectedPolys(i)).vertex(right).tv, Polys(polyCount).vertex(left).tv) + + vertexList(polyCount).color(j) = vertexList(selectedPolys(i)).color(j) + vertexList(polyCount).color(left) = vertexList(selectedPolys(i)).color(left) + + 'colors + clr1 = vertexList(selectedPolys(i)).color(right) + clr2 = vertexList(polyCount).color(left) + vertexList(polyCount).color(right).red = clr1.red * 0.5 + clr2.red * 0.5 + vertexList(polyCount).color(right).green = clr1.green * 0.5 + clr2.green * 0.5 + vertexList(polyCount).color(right).blue = clr1.blue * 0.5 + clr2.blue * 0.5 + + vertexList(selectedPolys(i)).color(left) = vertexList(polyCount).color(right) + + clr1 = getRGB(Polys(selectedPolys(i)).vertex(right).Color) + clr2 = getRGB(Polys(polyCount).vertex(left).Color) + alpha1 = getAlpha(Polys(selectedPolys(i)).vertex(right).Color) + alpha2 = getAlpha(Polys(polyCount).vertex(left).Color) + Polys(polyCount).vertex(right).Color = ARGB((alpha1 * 0.5 + alpha2 * 0.5), RGB((clr1.blue * 0.5 + clr2.blue * 0.5), (clr1.green * 0.5 + clr2.green * 0.5), (clr1.red * 0.5 + clr2.red * 0.5))) + + Polys(selectedPolys(i)).vertex(left) = Polys(polyCount).vertex(right) + + vertexList(polyCount).polyType = vertexList(selectedPolys(i)).polyType + End If + Next + Next + + numSelectedPolys = numSelectedPolys + newPolys + SaveUndo + Render + getInfo + + frmInfo.lblCount(0).Caption = polyCount + frmInfo.lblCount(6).Caption = getMapDimensions + +End Sub + +Private Sub mnuJoinVertices_Click() + + Dim firstVertex As Integer + Dim i As Integer, j As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + For j = 1 To 3 + If vertexList(selectedPolys(1)).vertex(4 - j) = 1 Then + firstVertex = 4 - j + End If + Next + + For i = 2 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then + PolyCoords(selectedPolys(i)).vertex(j).X = PolyCoords(selectedPolys(1)).vertex(firstVertex).X + PolyCoords(selectedPolys(i)).vertex(j).Y = PolyCoords(selectedPolys(1)).vertex(firstVertex).Y + Polys(selectedPolys(i)).vertex(j).X = Polys(selectedPolys(1)).vertex(firstVertex).X + Polys(selectedPolys(i)).vertex(j).Y = Polys(selectedPolys(1)).vertex(firstVertex).Y + End If + Next + Next + + prompt = True + End If + + SaveUndo + Render + getInfo + +End Sub + +Private Sub mnuCreate_Click() + + If numSelectedPolys < 1 Or numSelectedPolys > 3 Then Exit Sub + + Dim i As Integer, j As Integer + Dim numSelVerts As Integer + Dim temp As D3DVECTOR2 + Dim tempVertex As TCustomVertex + Dim tempClr As TColor + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + ReDim Preserve Polys(polyCount + 1) + ReDim Preserve PolyCoords(polyCount + 1) + ReDim Preserve vertexList(polyCount + 1) + + For i = 1 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then + numSelVerts = numSelVerts + 1 + Polys(polyCount + 1).vertex(numSelVerts) = Polys(selectedPolys(i)).vertex(j) + PolyCoords(polyCount + 1).vertex(numSelVerts) = PolyCoords(selectedPolys(i)).vertex(j) + vertexList(polyCount + 1).color(numSelVerts) = vertexList(selectedPolys(i)).color(j) + vertexList(polyCount + 1).polyType = vertexList(selectedPolys(i)).polyType + End If + If numSelVerts = 3 Then Exit For + Next + If numSelVerts = 3 Then Exit For + Next + + If numSelVerts > 2 Then + polyCount = polyCount + 1 + End If + + If Not isCW(polyCount) Then 'switch to make cw + temp = PolyCoords(polyCount).vertex(3) + PolyCoords(polyCount).vertex(3) = PolyCoords(polyCount).vertex(2) + PolyCoords(polyCount).vertex(2) = temp + + tempVertex = Polys(polyCount).vertex(3) + Polys(polyCount).vertex(3) = Polys(polyCount).vertex(2) + Polys(polyCount).vertex(2) = tempVertex + + tempClr = vertexList(polyCount).color(3) + vertexList(polyCount).color(3) = vertexList(polyCount).color(2) + vertexList(polyCount).color(2) = tempClr + End If + + Polys(polyCount).Perp.vertex(1).z = 2 + Polys(polyCount).Perp.vertex(2).z = 2 + Polys(polyCount).Perp.vertex(3).z = 2 + + frmInfo.lblCount(0).Caption = polyCount + frmInfo.lblCount(6).Caption = getMapDimensions + + SaveUndo + Render + +End Sub + +Private Sub mnuSever_Click() + + Dim i As Integer + Dim offset As Integer + Dim numConnections As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + numConnections = conCount + + If numSelWaypoints > 1 Then + offset = 1 + For i = 1 To conCount + Connections(offset) = Connections(i) + If Waypoints(Connections(i).point1).selected And Waypoints(Connections(i).point2).selected Then + numConnections = numConnections - 1 + Waypoints(Connections(i).point1).numConnections = Waypoints(Connections(i).point1).numConnections - 1 + Else 'not selected + offset = offset + 1 + End If + Next + ElseIf numSelWaypoints = 1 Then + offset = 1 + For i = 1 To conCount + Connections(offset) = Connections(i) + If Waypoints(Connections(i).point1).selected Or Waypoints(Connections(i).point2).selected Then + numConnections = numConnections - 1 + Waypoints(Connections(i).point1).numConnections = Waypoints(Connections(i).point1).numConnections - 1 + Else 'not selected + offset = offset + 1 + End If + Next + End If + + conCount = numConnections + ReDim Preserve Connections(conCount) + + SaveUndo + Render + +End Sub + +Private Sub mnuRefreshBG_Click() + + Dim i As Integer, j As Integer + Dim bgSize As Integer + Dim xOffset As Integer, yOffset As Integer + + maxX = 0 + maxY = 0 + minX = 0 + minY = 0 + + If polyCount > 0 Then + For i = 1 To polyCount + For j = 1 To 3 + If PolyCoords(i).vertex(j).X > maxX Then maxX = PolyCoords(i).vertex(j).X + If PolyCoords(i).vertex(j).X < minX Then minX = PolyCoords(i).vertex(j).X + If PolyCoords(i).vertex(j).Y > maxY Then maxY = PolyCoords(i).vertex(j).Y + If PolyCoords(i).vertex(j).Y < minY Then minY = PolyCoords(i).vertex(j).Y + Next + Next + End If + + xOffset = Int(Midpoint(maxX, minX)) + yOffset = Int(Midpoint(maxY, minY)) + + If (maxX - minX) > (maxY - minY) Then + bgSize = maxX - xOffset + Else + bgSize = maxY - xOffset + End If + + bgPolyCoords(1).X = xOffset - (bgSize + 640) + bgPolyCoords(1).Y = yOffset - (bgSize + 640) + + bgPolyCoords(2).X = xOffset - (bgSize + 640) + bgPolyCoords(2).Y = yOffset + (bgSize + 640) + + bgPolyCoords(3).X = xOffset + (bgSize + 640) + bgPolyCoords(3).Y = yOffset - (bgSize + 640) + + bgPolyCoords(4).X = xOffset + (bgSize + 640) + bgPolyCoords(4).Y = yOffset + (bgSize + 640) + + For i = 1 To 4 + bgPolys(i).X = (bgPolyCoords(i).X - scrollCoords(2).X) * zoomFactor + bgPolys(i).Y = (bgPolyCoords(i).Y - scrollCoords(2).Y) * zoomFactor + Next + + frmInfo.lblCount(6).Caption = getMapDimensions + + Render + +End Sub + +Private Sub mnuPreferences_Click() + + frmPreferences.Show 1 + PolyTypeClrs(0) = frmSoldatMapEditor.selectionClr + +End Sub + +Private Sub mnuMap_Click() + + frmMap.Show 1 + ctrlDown = False + setCurrentTool currentTool + +End Sub + +Private Sub mnuZoomIn_Click() + + Zoom 2 + +End Sub + +Private Sub mnuZoomOut_Click() + + Zoom 0.5 + +End Sub + +Private Sub mnuGrid_Click() + + mnuGrid.Checked = Not mnuGrid.Checked + showGrid = mnuGrid.Checked + frmDisplay.setLayer 8, mnuGrid.Checked + Render + +End Sub + +Private Sub mnuSnapToGrid_Click() + + mnuSnapToGrid.Checked = Not mnuSnapToGrid.Checked + snapToGrid = mnuSnapToGrid.Checked + +End Sub + +Private Sub mnuRefresh_Click() + + resetDevice + +End Sub + +Private Sub mnuTools_Click() + + mnuTools.Checked = Not mnuTools.Checked + frmTools.Visible = mnuTools.Checked + +End Sub + +Private Sub mnuDisplay_Click() + + mnuDisplay.Checked = Not mnuDisplay.Checked + frmDisplay.Visible = mnuDisplay.Checked + +End Sub + +Private Sub mnuPalette_Click() + + mnuPalette.Checked = Not mnuPalette.Checked + frmPalette.Visible = mnuPalette.Checked + +End Sub + +Private Sub mnuWaypoints_Click() + + mnuWaypoints.Checked = Not mnuWaypoints.Checked + frmWaypoints.Visible = mnuWaypoints.Checked + +End Sub + +Private Sub mnuScenery_Click() + + mnuScenery.Checked = Not mnuScenery.Checked + frmScenery.Visible = mnuScenery.Checked + +End Sub + +Private Sub mnuinfo_Click() + + mnuInfo.Checked = Not mnuInfo.Checked + frmInfo.Visible = mnuInfo.Checked + +End Sub + +Private Sub mnuTexture_Click() + + mnuTexture.Checked = Not mnuTexture.Checked + frmTexture.Visible = mnuTexture.Checked + +End Sub + +Private Sub mnuBlendWireframe_Click() + + mnuBlendWireframe.Checked = Not mnuBlendWireframe.Checked + clrWireframe = mnuBlendWireframe.Checked + +End Sub + +Private Sub mnuBlendPolys_Click() + + mnuBlendPolys.Checked = Not mnuBlendPolys.Checked + clrPolys = mnuBlendPolys.Checked + +End Sub + +Private Sub mnuFixedTexture_Click() + + mnuFixedTexture.Checked = Not mnuFixedTexture.Checked + fixedTexture = mnuFixedTexture.Checked + +End Sub + +Private Sub mnuSnapToVerts_Click() + + mnuSnapToVerts.Checked = Not mnuSnapToVerts.Checked + ohSnap = mnuSnapToVerts.Checked + +End Sub + +Private Sub mnuLoadSpace_Click() + + On Error GoTo ErrorHandler + + frmSoldatMapEditor.commonDialog.Filter = "Ini File (*.ini)|*.ini" + commonDialog.InitDir = appPath & "\Workspace\" + commonDialog.FileName = "" + frmSoldatMapEditor.commonDialog.DialogTitle = "Load Workspace" + commonDialog.ShowOpen + + If commonDialog.FileName <> "" Then + If Len(Dir$(appPath & "\Workspace\" & commonDialog.FileTitle)) <> 0 Then + loadWorkspace commonDialog.FileTitle + frmTools.setForm + frmDisplay.setForm + frmInfo.setForm + frmPalette.setForm + frmScenery.setForm + frmTexture.setForm + frmWaypoints.setForm + End If + End If + + RegainFocus + + Exit Sub + +ErrorHandler: + + RegainFocus + +End Sub + +Private Sub mnuSaveSpace_Click() + + On Error GoTo ErrorHandler + + Dim iniString As String + Dim sNull As String + sNull = Chr$(0) + + frmSoldatMapEditor.commonDialog.Filter = "Ini File (*.ini)|*.ini" + commonDialog.InitDir = appPath & "\Workspace\" + commonDialog.FileName = "" + frmSoldatMapEditor.commonDialog.DialogTitle = "Save Workspace" + commonDialog.ShowSave + + If commonDialog.FileName <> "" Then + + iniString = "WindowState=" & Me.WindowState & sNull _ + & "Width=" & formWidth & sNull & "Height=" & formHeight & sNull _ + & "Left=" & formLeft & sNull & "Top=" & formTop & sNull & sNull + saveSection "Main", iniString, appPath & "\workspace\" & commonDialog.FileTitle + + saveWindow "Tools", frmTools, False, commonDialog.FileTitle + saveWindow "Display", frmDisplay, frmDisplay.collapsed, commonDialog.FileTitle + saveWindow "Properties", frmInfo, frmInfo.collapsed, commonDialog.FileTitle + saveWindow "Palette", frmPalette, frmPalette.collapsed, commonDialog.FileTitle + saveWindow "Scenery", frmScenery, frmScenery.collapsed, commonDialog.FileTitle + saveWindow "Waypoints", frmWaypoints, frmWaypoints.collapsed, commonDialog.FileTitle + saveWindow "Texture", frmTexture, frmTexture.collapsed, commonDialog.FileTitle + + End If + + RegainFocus + + Exit Sub + +ErrorHandler: + + RegainFocus + +End Sub + +Private Sub mnuResetWindows_Click() + + If Me.WindowState = vbNormal Then + + formWidth = Screen.Width / Screen.TwipsPerPixelX - (64 + 208 + 208) + formHeight = formWidth * 3 / 4 + formLeft = Screen.Width / Screen.TwipsPerPixelX / 2 - formWidth / 2 - 1 + formTop = Screen.Height / Screen.TwipsPerPixelY / 2 - formHeight / 2 - 1 + + tvwScenery.Height = formHeight - 41 - 20 + + Me.Width = formWidth * Screen.TwipsPerPixelX + Me.Height = formHeight * Screen.TwipsPerPixelY + Me.left = Screen.Width / 2 - Me.Width / 2 - Screen.TwipsPerPixelX + Me.Top = Screen.Height / 2 - Me.Height / 2 - Screen.TwipsPerPixelY + + frmTools.left = Me.left - frmTools.Width + Screen.TwipsPerPixelX + frmTools.Top = Me.Top + 41 * Screen.TwipsPerPixelY + frmPalette.left = Me.left + Me.Width - Screen.TwipsPerPixelX + frmPalette.Top = Me.Top + 41 * Screen.TwipsPerPixelY + frmDisplay.left = frmPalette.left + frmDisplay.Top = frmPalette.Top + frmPalette.Height - Screen.TwipsPerPixelY + frmScenery.left = Me.left + Me.Width - Screen.TwipsPerPixelX + frmScenery.Top = frmDisplay.Top + frmDisplay.Height - Screen.TwipsPerPixelY + frmInfo.left = Me.left - frmInfo.Width + Screen.TwipsPerPixelX + frmInfo.Top = frmTools.Top + frmTools.Height - Screen.TwipsPerPixelY + frmWaypoints.left = Me.left - frmWaypoints.Width + Screen.TwipsPerPixelX + frmWaypoints.Top = frmInfo.Top + frmInfo.Height - Screen.TwipsPerPixelY + frmTexture.Top = frmPalette.Top + frmTexture.left = frmPalette.left - frmTexture.Width + Screen.TwipsPerPixelX + + resetDevice + + Else + + frmTools.left = Me.left + frmTools.Top = Me.Top + 41 * Screen.TwipsPerPixelY + frmPalette.left = Me.left + Me.Width - frmPalette.Width + frmPalette.Top = Me.Top + 41 * Screen.TwipsPerPixelY + frmDisplay.left = frmPalette.left + frmDisplay.Top = frmPalette.Top + frmPalette.Height - Screen.TwipsPerPixelY + frmWaypoints.left = Me.left + frmWaypoints.Top = Me.Top + Me.Height - frmWaypoints.Height - 19 * Screen.TwipsPerPixelY + frmScenery.left = Me.left + Me.Width - frmScenery.Width + frmScenery.Top = frmDisplay.Top + frmDisplay.Height - Screen.TwipsPerPixelY + frmInfo.left = Me.left + frmInfo.Top = frmWaypoints.Top - frmInfo.Height + Screen.TwipsPerPixelY + frmTexture.Top = frmPalette.Top + frmTexture.left = frmPalette.left - frmTexture.Width + Screen.TwipsPerPixelX + + End If + +End Sub + +Private Sub mnuShowAll_Click() + + mnuTools.Checked = True + frmTools.Visible = True + + mnuPalette.Checked = True + frmPalette.Visible = True + + mnuDisplay.Checked = True + frmDisplay.Visible = True + + mnuScenery.Checked = True + frmScenery.Visible = True + + mnuInfo.Checked = True + frmInfo.Visible = True + + mnuTexture.Checked = True + frmTexture.Visible = True + + mnuWaypoints.Checked = True + frmWaypoints.Visible = True + +End Sub + +Private Sub mnuHideAll_Click() + + mnuTools.Checked = False + frmTools.Visible = False + + mnuPalette.Checked = False + frmPalette.Visible = False + + mnuDisplay.Checked = False + frmDisplay.Visible = False + + mnuScenery.Checked = False + frmScenery.Visible = False + + mnuInfo.Checked = False + frmInfo.Visible = False + + mnuTexture.Checked = False + frmTexture.Visible = False + + mnuWaypoints.Checked = False + frmWaypoints.Visible = False + +End Sub + +Private Sub mnuGostek_Click() + + If mnuGostek.Checked Then + gostek.X = 0 + gostek.Y = 0 + Else + mnuGostek.Checked = True + mnuSpawn(Spawns(0).Team).Checked = False + mnuCollider.Checked = False + End If + +End Sub + +Private Sub mnuCollider_Click() + + mnuCollider.Checked = True + mnuSpawn(Spawns(0).Team).Checked = False + mnuGostek.Checked = False + Colliders(0).radius = clrRadius +End Sub + +Private Sub mnuSpawn_Click(Index As Integer) + + mnuCollider.Checked = False + mnuSpawn(Spawns(0).Team).Checked = False + mnuSpawn(Index).Checked = True + mnuGostek.Checked = False + Spawns(0).Team = Index + +End Sub + +Private Sub mnuPolyType_Click(Index As Integer) + + mnuPolyType(polyType).Checked = False + mnuPolyType(Index).Checked = True + polyType = Index + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag & " (" & mnuPolyType(polyType).Caption & ")" + +End Sub + +Private Sub mnuQuad_Click() + + mnuQuad.Checked = Not mnuQuad.Checked + + If mnuQuad.Checked Then + currentFunction = TOOL_QUAD + SetCursor currentFunction + 1 + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + Else + currentFunction = TOOL_CREATE + SetCursor currentFunction + 1 + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag + End If + + lblCurrentTool.Caption = frmSoldatMapEditor.ImageList.ListImages(currentFunction + 1).Tag & " (" & mnuPolyType(polyType).Caption & ")" + +End Sub + +Private Sub mnuCustomX_Click() + + mnuCustomX.Checked = Not mnuCustomX.Checked + +End Sub + +Private Sub mnuCustomY_Click() + + mnuCustomY.Checked = Not mnuCustomY.Checked + +End Sub + +Private Sub mnuFitOnScreen_Click() + + If polyCount < 1 Then Exit Sub + + Dim Width As Integer, Height As Integer + + mnuRefreshBG_Click + + scrollCoords(2).X = -Me.ScaleWidth / 2 - 1 + Midpoint(minX, maxX) + scrollCoords(2).Y = -Me.ScaleHeight / 2 - 25 + Midpoint(minY, maxY) + zoomFactor = 1 + + Width = maxX - minX + Height = maxY - minY + + If Height / Width < (Me.ScaleHeight - 88) / (Me.ScaleWidth - 32) Then + Zoom ((Me.ScaleWidth - 32) / Width) + Else + Zoom ((Me.ScaleHeight - 88) / Height) + End If + +End Sub + +Private Sub mnuActualPixels_Click() + + zoomFactor = (Me.ScaleWidth + 2) / 640 + Zoom 1 + +End Sub + +Private Sub mnuScenTrans_Click(Index As Integer) + + mnuScenTrans(Index).Checked = Not mnuScenTrans(Index).Checked + + If Index = 0 Then 'rotate + frmScenery.rotateScenery = mnuScenTrans(Index).Checked + mouseEvent2 frmScenery.picRotate, 0, 0, BUTTON_SMALL, frmScenery.rotateScenery, BUTTON_UP + ElseIf Index = 1 Then + frmScenery.scaleScenery = mnuScenTrans(Index).Checked + mouseEvent2 frmScenery.picScale, 0, 0, BUTTON_SMALL, frmScenery.scaleScenery, BUTTON_UP + End If + +End Sub + +Public Sub getInfo() + + Dim i As Integer, j As Integer + Dim scenNum As Integer + + On Error GoTo ErrorHandler + + frmInfo.noChange = True + frmWaypoints.noChange = True + + For i = 1 To waypointCount + If Waypoints(i).selected Then + frmWaypoints.getPathNum Waypoints(i).pathNum + For j = 0 To 4 + frmWaypoints.getWayType j, Waypoints(i).wayType(j) + Next + frmWaypoints.cboSpecial.ListIndex = Waypoints(i).special + frmWaypoints.lblNumCon = Waypoints(i).numConnections + Exit For + End If + Next + + If numSelectedPolys = 0 And numSelectedScenery = 0 Then + If numSelLights > 0 Then + For i = 1 To lightCount + If Lights(i).selected = 1 Then + frmInfo.txtLightProp(0).Text = Lights(i).z + frmInfo.txtLightProp(1).Text = Lights(i).range + frmInfo.picLight.BackColor = RGB(Lights(i).color.red, Lights(i).color.green, Lights(i).color.blue) + Exit For + End If + Next + frmInfo.mnuProp_Click 4 + Else + frmInfo.mnuProp_Click 5 + End If + frmInfo.lblCoords = "" + frmInfo.lblIndex = "" + frmInfo.lblSelPolys = "" + frmInfo.lblSelScenery = "" + frmInfo.noChange = False + frmWaypoints.noChange = False + Exit Sub + End If + + If numSelectedPolys > 0 Then + + frmInfo.cboPolyType.ListIndex = vertexList(selectedPolys(1)).polyType + frmInfo.txtBounciness.Enabled = False + For j = 1 To 3 + If vertexList(selectedPolys(1)).vertex(j) = 1 Then + frmInfo.txtBounciness.Text = Int((Polys(selectedPolys(1)).Perp.vertex(j).z - 1) * 100) + If frmInfo.txtBounciness.Text < 0 Then + frmInfo.txtBounciness.Text = 0 + End If + If frmInfo.cboPolyType.ListIndex = 18 Then + frmInfo.txtBounciness.Enabled = True + End If + frmInfo.txtTexture(0).Text = Int(Polys(selectedPolys(1)).vertex(j).tu * 10000 + 0.5) / 10000 + frmInfo.txtTexture(1).Text = Int(Polys(selectedPolys(1)).vertex(j).tv * 10000 + 0.5) / 10000 + frmInfo.txtVertexAlpha.Text = Int((getAlpha(Polys(selectedPolys(1)).vertex(j).Color) / 255 * 100) * 100 + 0.5) / 100 + frmInfo.lblCoords.Caption = Int(PolyCoords(selectedPolys(1)).vertex(j).X * 100 + 0.5) / 100 & ", " & Int(PolyCoords(selectedPolys(1)).vertex(j).Y * 100) / 100 + Exit For + End If + Next + + End If + + If numSelectedScenery > 0 Then + + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + scenNum = i + frmInfo.txtScenProp(0).Text = Int(Scenery(i).Scaling.X * 100 * 100 + 0.5) / 100 + frmInfo.txtScenProp(1).Text = Int(Scenery(i).Scaling.Y * 100 * 100 + 0.5) / 100 + frmInfo.txtScenProp(2).Text = Int(Scenery(i).alpha / 255 * 100 * 10 + 0.5) / 10 + frmInfo.txtScenProp(3).Text = Int(Scenery(i).rotation * 180 / pi * 10 + 0.5) / 10 + frmInfo.cboLevel.ListIndex = Scenery(i).level + If numSelectedPolys = 0 Then + frmInfo.lblCoords.Caption = Int(Scenery(i).Translation.X * 100 + 0.5) / 100 & ", " & Int(Scenery(i).Translation.Y * 100) / 100 + End If + Exit For + End If + Next + + End If + + If numSelectedPolys = 1 And numSelectedScenery = 0 Then + frmInfo.lblIndex.Caption = selectedPolys(1) + ElseIf numSelectedPolys = 0 And numSelectedScenery = 1 Then + frmInfo.lblIndex.Caption = scenNum + Else + frmInfo.lblIndex.Caption = "" + End If + + If currentTool = TOOL_MOVE Then + If numSelectedPolys = 0 And numSelectedScenery = 1 Then + frmInfo.mnuProp_Click 1 + Else + frmInfo.mnuProp_Click 2 + End If + ElseIf numSelectedPolys > 0 And numSelectedScenery = 0 Then + frmInfo.mnuProp_Click 0 + ElseIf numSelectedPolys = 0 And numSelectedScenery > 0 Then + frmInfo.mnuProp_Click 1 + End If + + frmInfo.txtScale(0).Text = Int(scaleDiff.X * 1000 + 0.5) / 10 + frmInfo.txtScale(1).Text = Int(scaleDiff.Y * 1000 + 0.5) / 10 + frmInfo.txtRotate.Text = rDiff + + If numSelectedScenery = 1 And numSelectedPolys = 0 Then + frmInfo.lblSelPolys = "" + frmInfo.lblSelScenery = frmScenery.lstScenery.List(Scenery(scenNum).Style - 1) + Else + If numSelectedPolys = 0 Then + frmInfo.lblSelPolys = "" + Else + frmInfo.lblSelPolys = "Polys: " & numSelectedPolys + End If + If numSelectedScenery = 0 Then + frmInfo.lblSelScenery = "" + Else + frmInfo.lblSelScenery = "Scenery: " & numSelectedScenery + End If + End If + + If numSelWaypoints = 0 Then + frmWaypoints.ClearWaypt + End If + + frmInfo.noChange = False + frmWaypoints.noChange = False + + Exit Sub + +ErrorHandler: + + MsgBox "getInfo() error" & vbNewLine & Error$ + +End Sub + +'apply scale/rotate + +Public Sub applyPolyType(ByVal Index As Integer) + + Dim i As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + vertexList(selectedPolys(i)).polyType = Index + Next + End If + SaveUndo + Render + +End Sub + +Public Sub applyTextureCoords(ByVal tehValue As Single, Index As Integer) + + Dim i As Integer, j As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then + If Index = 0 Then + Polys(selectedPolys(i)).vertex(j).tu = tehValue + Else + Polys(selectedPolys(i)).vertex(j).tv = tehValue + End If + End If + Next + Next + End If + SaveUndo + Render + +End Sub + +Public Sub applyVertexAlpha(tehValue As Single) + + Dim i As Integer, j As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + For j = 1 To 3 + If vertexList(selectedPolys(i)).vertex(j) = 1 Then + Polys(selectedPolys(i)).vertex(j).Color = ARGB(tehValue * 255, Polys(selectedPolys(i)).vertex(j).Color) + End If + Next + Next + End If + SaveUndo + Render + +End Sub + +Public Sub applyBounciness(tehValue As Single) + + Dim i As Integer, j As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + If numSelectedPolys > 0 Then + For i = 1 To numSelectedPolys + For j = 1 To 3 + Polys(selectedPolys(i)).Perp.vertex(j).z = tehValue + Next + Next + End If + SaveUndo + +End Sub + +Public Sub applySceneryProp(ByVal tehValue As Single, Index As Integer) + + Dim i As Integer + Dim tempClr As TColor + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + For i = 1 To sceneryCount + If Scenery(i).selected = 1 Then + If Index = 0 Then 'x scale + Scenery(i).Scaling.X = tehValue + ElseIf Index = 1 Then 'y scale + Scenery(i).Scaling.Y = tehValue + ElseIf Index = 2 Then 'alpha + tempClr = getRGB(Scenery(i).Color) + Scenery(i).alpha = tehValue + Scenery(i).Color = ARGB(tehValue, RGB(tempClr.blue, tempClr.green, tempClr.red)) + ElseIf Index = 3 Then 'rotation + Scenery(i).rotation = tehValue + ElseIf Index = 4 Then 'level + Scenery(i).level = tehValue + End If + End If + Next + If Index = 0 Or Index = 1 Or Index = 3 Then + getRCenter + End If + SaveUndo + Render + +End Sub + +Public Sub applyLightProp(ByVal tehValue As Single, Index As Integer) + + Dim i As Integer + + If selectionChanged Then + SaveUndo + selectionChanged = False + End If + + For i = 1 To lightCount + If Lights(i).selected = 1 Then + If Index = 0 Then 'z-coord + Lights(i).z = tehValue + ElseIf Index = 1 Then + Lights(i).range = tehValue + End If + End If + Next + SaveUndo + applyLights + Render + +End Sub + +Private Sub picMenu_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picMenu(Index), X, Y, BUTTON_MENU, 0, BUTTON_DOWN + PopupMenu mnuMenu(Index), , Index * MENU_WIDTH, 41 + mouseEvent2 picMenu(Index), X, Y, BUTTON_MENU, 0, BUTTON_UP + +End Sub + +Private Sub picMenu_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picMenu(Index), X, Y, BUTTON_MENU, 0, BUTTON_MOVE + +End Sub + +Private Sub picHelp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHelp, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHelp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHelp, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHelp_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + RunHelp + + mouseEvent2 picHelp, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + Dim c As Control + + frmSoldatMapEditor.picMenuBar.BackColor = bgClr + frmSoldatMapEditor.picStatus.BackColor = bgClr + txtZoom.BackColor = bgClr + txtZoom.ForeColor = lblTextClr + picProgress.BackColor = bgClr + lblFileName.BackColor = lblBackClr + lblFileName.ForeColor = lblTextClr + lblZoom.BackColor = lblBackClr + lblZoom.ForeColor = lblTextClr + lblCurrentTool.BackColor = lblBackClr + lblCurrentTool.ForeColor = lblTextClr + + For Each c In Me.Controls + If c.Tag = "font1" Then + c.Font.Name = font1 + ElseIf c.Tag = "font2" Then + c.Font.Name = font2 + End If + Next + +End Sub + +Private Sub picMaximize_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picMaximize, X, Y, BUTTON_SMALL, (Me.WindowState = vbNormal), BUTTON_DOWN + +End Sub + +Private Sub picMaximize_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picMaximize, X, Y, BUTTON_SMALL, (Me.WindowState = vbNormal), BUTTON_MOVE + +End Sub + +Private Sub picMaximize_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + If Me.WindowState = 2 Then + Me.WindowState = 0 + Else + Me.WindowState = 2 + End If + + mouseEvent2 picMaximize, X, Y, BUTTON_SMALL, (Me.WindowState = vbNormal), BUTTON_UP + + resetDevice + +End Sub + +Private Sub picMinimize_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picMinimize, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picMinimize_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picMinimize, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Public Sub picMinimize_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picMinimize, X, Y, BUTTON_SMALL, 0, BUTTON_UP + If mnuDisplay.Checked Then frmDisplay.Hide + If mnuWaypoints.Checked Then frmWaypoints.Hide + If mnuTools.Checked Then frmTools.Hide + If mnuPalette.Checked Then frmPalette.Hide + If mnuScenery.Checked Then frmScenery.Hide + If mnuInfo.Checked Then frmInfo.Hide + If mnuTexture.Checked Then frmTexture.Hide + Me.Hide + frmTaskBar.WindowState = vbMinimized + +End Sub + +Private Sub picExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picExit, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picExit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picExit, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picExit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picExit, X, Y, BUTTON_SMALL, 0, BUTTON_UP + Terminate + +End Sub + +Private Sub picStatus_Click() + + If Me.WindowState = vbMaximized Then + Dim hwnd1 As Long + hwnd1 = FindWindow("Shell_traywnd", "") + Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW) + + End If + +End Sub + +Private Sub picTitle_DblClick() + + If Me.WindowState = 2 Then + Me.WindowState = 0 + mouseEvent2 picMaximize, 0, 0, BUTTON_SMALL, (Me.WindowState = vbNormal), BUTTON_UP + Else + Me.WindowState = 2 + mouseEvent2 picMaximize, 0, 0, BUTTON_SMALL, (Me.WindowState = vbNormal), BUTTON_UP + End If + resetDevice + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + If Me.WindowState < 2 Then + If Len(frmDisplay.Tag) <> 0 Then + + frmDisplay.Hide + + End If + If Len(frmInfo.Tag) <> 0 Then + + frmInfo.Hide + + End If + If Len(frmPalette.Tag) <> 0 Then + + frmPalette.Hide + + End If + If Len(frmScenery.Tag) <> 0 Then + + frmScenery.Hide + + End If + If Len(frmTexture.Tag) <> 0 Then + + frmTexture.Hide + + End If + If Len(frmTools.Tag) <> 0 Then + + frmTools.Hide + + End If + If Len(frmWaypoints.Tag) <> 0 Then + + frmWaypoints.Hide + + End If + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + + If Len(frmDisplay.Tag) <> 0 Then + + frmDisplay.Move (frmDisplay.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmDisplay.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmDisplay.Show + + End If + If Len(frmInfo.Tag) <> 0 Then + + frmInfo.Move (frmInfo.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmInfo.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmInfo.Show + + End If + If Len(frmPalette.Tag) <> 0 Then + + frmPalette.Move (frmPalette.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmPalette.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmPalette.Show + + End If + If Len(frmScenery.Tag) <> 0 Then + + frmScenery.Move (frmScenery.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmScenery.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmScenery.Show + + End If + If Len(frmTexture.Tag) <> 0 Then + + frmTexture.Move (frmTexture.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmTexture.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmTexture.Show + + End If + If Len(frmTools.Tag) <> 0 Then + + frmTools.Move (frmTools.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmTools.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmTools.Show + + End If + If Len(frmWaypoints.Tag) <> 0 Then + + frmWaypoints.Move (frmWaypoints.left + (Me.left - (formLeft * Screen.TwipsPerPixelX))), (frmWaypoints.Top + (Me.Top - (formTop * Screen.TwipsPerPixelY))) + frmWaypoints.Show + + End If + + formLeft = Me.left / Screen.TwipsPerPixelX + formTop = Me.Top / Screen.TwipsPerPixelY + + End If + +End Sub + +Private Sub AutoTexture() + + If (numSelectedPolys <= 0) Then + Exit Sub + End If + + Dim X As Single, Y As Single, z As Single + Dim vertIndex As Integer + Dim i As Integer + + For i = 1 To 3 + If vertexList(selectedPolys(1)).vertex(i) > 0 Then + vertIndex = i + End If + Next + + X = PolyCoords(selectedPolys(1)).vertex(vertIndex).X + Y = PolyCoords(selectedPolys(1)).vertex(vertIndex).Y + z = Polys(selectedPolys(1)).vertex(vertIndex).z + + numSelectedPolys = 0 + ReDim selectedPolys(0) + + SetTextureCoords X, Y, z, 0, 0 + + Render + +End Sub + +Private Sub SetTextureCoords(X As Single, Y As Single, z As Single, tu As Single, tv As Single) + + Dim i As Integer + Dim j As Integer + Dim k As Integer + + For i = 0 To polyCount + + For j = 1 To 3 + 'if vertex is at these coords and not marked + If Int(PolyCoords(i).vertex(j).X) = Int(X) _ + And Int(PolyCoords(i).vertex(j).Y) = Int(Y) _ + And Int(Polys(i).vertex(j).z) = Int(z) _ + And vertexList(i).vertex(j) < 10 Then + 'set its tex coords to these tex coords + Polys(i).vertex(j).tu = tu + Polys(i).vertex(j).tv = tv + 'mark in vertex list + vertexList(i).vertex(j) = 10 + 'find next vertex index + k = j + 1 + If k > 3 Then k = 1 + 'check next vertex + If vertexList(i).vertex(k) < 10 Then + 'calculate new tex coords + + 'call this routine again with new coords & tex coords + SetTextureCoords PolyCoords(i).vertex(k).X, PolyCoords(i).vertex(k).Y, Polys(i).vertex(k).z, 0, 0 + End If + End If + Next + Next + + 'loop through all vertices to find vertices at this point, put into array + 'set their coords + 'set vertex list value to mark + + 'for each vertex at this point, find adjacent verts + 'calc new coords, call this and set new coords? + 'send new coords to this routine? + 'call this routine on them + +End Sub diff --git a/frmTaskBar.frm b/frmTaskBar.frm index 4508cca..cb8109e 100644 --- a/frmTaskBar.frm +++ b/frmTaskBar.frm @@ -1,72 +1,72 @@ -VERSION 5.00 -Begin VB.Form frmTaskBar - Caption = "Soldat PolyWorks" - ClientHeight = 1920 - ClientLeft = 60 - ClientTop = 345 - ClientWidth = 1920 - Icon = "frmTaskBar.frx":0000 - LinkTopic = "Form1" - MaxButton = 0 'False - ScaleHeight = 128 - ScaleMode = 3 'Pixel - ScaleWidth = 128 - StartUpPosition = 3 'Windows Default -End -Attribute VB_Name = "frmTaskBar" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Dim minimized As Boolean - -Private Sub Form_GotFocus() - - If frmSoldatMapEditor.Visible Then - frmSoldatMapEditor.RegainFocus - End If - -End Sub - -Private Sub Form_Load() - - Me.left = 2000 * Screen.TwipsPerPixelX - Me.Top = 2000 * Screen.TwipsPerPixelY - -End Sub - -Private Sub Form_Resize() - - If Not frmSoldatMapEditor.Visible And Me.WindowState = vbNormal Then 'show when it gets restored - frmSoldatMapEditor.Show - If frmSoldatMapEditor.mnuDisplay.Checked Then frmDisplay.Show - If frmSoldatMapEditor.mnuWaypoints.Checked Then frmWaypoints.Show - If frmSoldatMapEditor.mnuTools.Checked Then frmTools.Show - If frmSoldatMapEditor.mnuPalette.Checked Then frmPalette.Show - If frmSoldatMapEditor.mnuScenery.Checked Then frmScenery.Show - If frmSoldatMapEditor.mnuInfo.Checked Then frmInfo.Show - If frmSoldatMapEditor.mnuTexture.Checked Then frmTexture.Show - If frmSoldatMapEditor.WindowState = vbNormal Then - frmSoldatMapEditor.left = frmSoldatMapEditor.formLeft * Screen.TwipsPerPixelX - frmSoldatMapEditor.Top = frmSoldatMapEditor.formTop * Screen.TwipsPerPixelY - frmSoldatMapEditor.ScaleWidth = frmSoldatMapEditor.formWidth - frmSoldatMapEditor.ScaleHeight = frmSoldatMapEditor.formHeight - End If - frmSoldatMapEditor.RegainFocus - ElseIf Not frmSoldatMapEditor.Visible And Me.WindowState = vbMinimized Then - - ElseIf frmSoldatMapEditor.Visible And Me.WindowState = vbNormal Then - frmSoldatMapEditor.RegainFocus - ElseIf frmSoldatMapEditor.Visible And Me.WindowState = vbMinimized Then - frmSoldatMapEditor.RegainFocus - End If - -End Sub - -Private Sub Form_Unload(Cancel As Integer) - - frmSoldatMapEditor.Terminate - -End Sub +VERSION 5.00 +Begin VB.Form frmTaskBar + Caption = "Soldat PolyWorks" + ClientHeight = 1920 + ClientLeft = 60 + ClientTop = 345 + ClientWidth = 1920 + Icon = "frmTaskBar.frx":0000 + LinkTopic = "Form1" + MaxButton = 0 'False + ScaleHeight = 128 + ScaleMode = 3 'Pixel + ScaleWidth = 128 + StartUpPosition = 3 'Windows Default +End +Attribute VB_Name = "frmTaskBar" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Dim minimized As Boolean + +Private Sub Form_GotFocus() + + If frmSoldatMapEditor.Visible Then + frmSoldatMapEditor.RegainFocus + End If + +End Sub + +Private Sub Form_Load() + + Me.left = 2000 * Screen.TwipsPerPixelX + Me.Top = 2000 * Screen.TwipsPerPixelY + +End Sub + +Private Sub Form_Resize() + + If Not frmSoldatMapEditor.Visible And Me.WindowState = vbNormal Then 'show when it gets restored + frmSoldatMapEditor.Show + If frmSoldatMapEditor.mnuDisplay.Checked Then frmDisplay.Show + If frmSoldatMapEditor.mnuWaypoints.Checked Then frmWaypoints.Show + If frmSoldatMapEditor.mnuTools.Checked Then frmTools.Show + If frmSoldatMapEditor.mnuPalette.Checked Then frmPalette.Show + If frmSoldatMapEditor.mnuScenery.Checked Then frmScenery.Show + If frmSoldatMapEditor.mnuInfo.Checked Then frmInfo.Show + If frmSoldatMapEditor.mnuTexture.Checked Then frmTexture.Show + If frmSoldatMapEditor.WindowState = vbNormal Then + frmSoldatMapEditor.left = frmSoldatMapEditor.formLeft * Screen.TwipsPerPixelX + frmSoldatMapEditor.Top = frmSoldatMapEditor.formTop * Screen.TwipsPerPixelY + frmSoldatMapEditor.ScaleWidth = frmSoldatMapEditor.formWidth + frmSoldatMapEditor.ScaleHeight = frmSoldatMapEditor.formHeight + End If + frmSoldatMapEditor.RegainFocus + ElseIf Not frmSoldatMapEditor.Visible And Me.WindowState = vbMinimized Then + + ElseIf frmSoldatMapEditor.Visible And Me.WindowState = vbNormal Then + frmSoldatMapEditor.RegainFocus + ElseIf frmSoldatMapEditor.Visible And Me.WindowState = vbMinimized Then + frmSoldatMapEditor.RegainFocus + End If + +End Sub + +Private Sub Form_Unload(Cancel As Integer) + + frmSoldatMapEditor.Terminate + +End Sub diff --git a/frmTexture.frm b/frmTexture.frm index 0ea69c1..d048dd4 100644 --- a/frmTexture.frm +++ b/frmTexture.frm @@ -1,321 +1,321 @@ -VERSION 5.00 -Begin VB.Form frmTexture - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 1 'Fixed Single - ClientHeight = 4320 - ClientLeft = 15 - ClientTop = 15 - ClientWidth = 1200 - ControlBox = 0 'False - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 288 - ScaleMode = 3 'Pixel - ScaleWidth = 80 - ShowInTaskbar = 0 'False - StartUpPosition = 3 'Windows Default - Begin VB.PictureBox picTexture - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H00000000& - BorderStyle = 0 'None - DrawStyle = 2 'Dot - DrawWidth = 2 - ForeColor = &H00FF0000& - Height = 3840 - Left = 120 - ScaleHeight = 256 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 2 - Top = 360 - Width = 960 - End - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 255 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 80 - TabIndex = 0 - TabStop = 0 'False - Top = 0 - Width = 1200 - Begin VB.PictureBox picHide - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 960 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 1 - TabStop = 0 'False - Tag = "3" - Top = 0 - Width = 240 - End - End -End -Attribute VB_Name = "frmTexture" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Public xPos As Integer, yPos As Integer -Dim formHeight As Integer -Public collapsed As Boolean -Public x1tex As Single, x2tex As Single, y1tex As Single, y2tex As Single - -Private Sub Form_Load() - - On Error GoTo ErrorHandler - - Me.SetColors - - formHeight = Me.ScaleHeight - - setForm - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading texture form" - -End Sub - -Public Sub setForm() - - Me.left = xPos * Screen.TwipsPerPixelX - Me.Top = yPos * Screen.TwipsPerPixelY - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Public Sub setTexCoords(tehValue As Single, Index As Integer) - - picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B - If Index = 0 Then - x1tex = tehValue / 2 - ElseIf Index = 1 Then - x2tex = tehValue / 2 - ElseIf Index = 2 Then - y1tex = tehValue / 2 - ElseIf Index = 3 Then - y2tex = tehValue / 2 - End If - picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B - -End Sub - -Private Sub picTexture_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - If Button <> 0 Then - picTexture.DrawMode = 6 - picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B - x1tex = Int((X + 0) / 16) * 16 - y1tex = Int((Y + 0) / 16) * 16 - x2tex = x1tex + 16 - y2tex = y1tex + 16 - picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B - End If - -End Sub - -Private Sub picTexture_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - Dim drawBox As Boolean - - If Button <> 0 Then - If X + 16 > frmSoldatMapEditor.xTexture / 2 Then - X = frmSoldatMapEditor.xTexture / 2 - 16 - ElseIf X + 16 < 0 Then - X = -16 - End If - If Y + 16 > frmSoldatMapEditor.yTexture / 2 Then - Y = frmSoldatMapEditor.yTexture / 2 - 16 - ElseIf Y + 16 < 0 Then - Y = -16 - End If - If Int((X + 16) / 16) * 16 <> x2tex Then - drawBox = True - End If - If Int((Y + 16) / 16) * 16 <> y2tex Then - drawBox = True - End If - If drawBox Then - picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B - x2tex = Int((X + 16) / 16) * 16 - y2tex = Int((Y + 16) / 16) * 16 - picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B - End If - End If - -End Sub - -Private Sub picTexture_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - If Button <> 0 Then - If X + 16 > frmSoldatMapEditor.xTexture / 2 Then - X = frmSoldatMapEditor.xTexture / 2 - 16 - ElseIf X + 16 < 0 Then - X = -16 - End If - If Y + 16 > frmSoldatMapEditor.yTexture / 2 Then - Y = frmSoldatMapEditor.yTexture / 2 - 16 - ElseIf Y + 16 < 0 Then - Y = -16 - End If - - x2tex = Int((X + 16) / 16) * 16 - y2tex = Int((Y + 16) / 16) * 16 - - frmInfo.txtQuadX(0).Text = x1tex * 2 - frmInfo.txtQuadY(0).Text = y1tex * 2 - frmInfo.txtQuadX(1).Text = x2tex * 2 - frmInfo.txtQuadY(1).Text = y2tex * 2 - - End If - -End Sub - -Public Sub setTexture(texturePath As String) - - On Error GoTo ErrorHandler - - Dim texWidth As Integer, texHeight As Integer - Dim X As Integer, Y As Integer - - texWidth = frmSoldatMapEditor.xTexture - texHeight = frmSoldatMapEditor.yTexture - - picTexture.DrawMode = 13 - - picTexture.Width = texWidth / 2 - picTexture.Height = texHeight / 2 - frmTexture.Width = (texWidth / 2 + 2 + 16) * Screen.TwipsPerPixelX - formHeight = texHeight / 2 + 18 + 16 - frmTexture.Height = formHeight * Screen.TwipsPerPixelY - picHide.left = frmTexture.Width / Screen.TwipsPerPixelX - 17 - - Dim Token As Long - Token = InitGDIPlus - picTexture.Picture = LoadPictureGDIPlus(frmSoldatMapEditor.soldatDir & "textures\" & texturePath, texWidth / 2, texHeight / 2) - FreeGDIPlus Token - - For Y = 0 To (texHeight / 32) - If Y Mod 4 = 0 Then - picTexture.DrawWidth = 2 - Else - picTexture.DrawWidth = 1 - End If - picTexture.Line (0, Y * 16)-(texWidth / 2, Y * 16), RGB(0, 0, 0) - Next - - For X = 0 To (texWidth / 32) - If X Mod 4 = 0 Then - picTexture.DrawWidth = 2 - Else - picTexture.DrawWidth = 1 - End If - picTexture.Line (X * 16, 0)-(X * 16, texHeight), RGB(0, 0, 0) - Next - - x1tex = 0 - y1tex = 0 - x2tex = texWidth / 2 - y2tex = texHeight / 2 - picTexture.DrawMode = 6 - picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B - - Exit Sub - -ErrorHandler: - - MsgBox "Error setting texture" & vbNewLine & Error$ - -End Sub - - -Private Sub picTitle_DblClick() - - collapsed = Not collapsed - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - - snapForm Me, frmTools - snapForm Me, frmPalette - snapForm Me, frmWaypoints - snapForm Me, frmDisplay - snapForm Me, frmScenery - snapForm Me, frmInfo - Me.Tag = snapForm(Me, frmSoldatMapEditor) - - xPos = Me.left / Screen.TwipsPerPixelX - yPos = Me.Top / Screen.TwipsPerPixelY - -End Sub - -Private Sub picHide_Click() - - Me.Hide - frmSoldatMapEditor.mnuTexture.Checked = False - -End Sub - -Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Public Sub SetColors() - - On Error Resume Next - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_texture.bmp") - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - - Me.BackColor = bgClr - -End Sub +VERSION 5.00 +Begin VB.Form frmTexture + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 1 'Fixed Single + ClientHeight = 4320 + ClientLeft = 15 + ClientTop = 15 + ClientWidth = 1200 + ControlBox = 0 'False + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 288 + ScaleMode = 3 'Pixel + ScaleWidth = 80 + ShowInTaskbar = 0 'False + StartUpPosition = 3 'Windows Default + Begin VB.PictureBox picTexture + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H00000000& + BorderStyle = 0 'None + DrawStyle = 2 'Dot + DrawWidth = 2 + ForeColor = &H00FF0000& + Height = 3840 + Left = 120 + ScaleHeight = 256 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 2 + Top = 360 + Width = 960 + End + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 255 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 80 + TabIndex = 0 + TabStop = 0 'False + Top = 0 + Width = 1200 + Begin VB.PictureBox picHide + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 960 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 1 + TabStop = 0 'False + Tag = "3" + Top = 0 + Width = 240 + End + End +End +Attribute VB_Name = "frmTexture" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Public xPos As Integer, yPos As Integer +Dim formHeight As Integer +Public collapsed As Boolean +Public x1tex As Single, x2tex As Single, y1tex As Single, y2tex As Single + +Private Sub Form_Load() + + On Error GoTo ErrorHandler + + Me.SetColors + + formHeight = Me.ScaleHeight + + setForm + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading texture form" + +End Sub + +Public Sub setForm() + + Me.left = xPos * Screen.TwipsPerPixelX + Me.Top = yPos * Screen.TwipsPerPixelY + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Public Sub setTexCoords(tehValue As Single, Index As Integer) + + picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B + If Index = 0 Then + x1tex = tehValue / 2 + ElseIf Index = 1 Then + x2tex = tehValue / 2 + ElseIf Index = 2 Then + y1tex = tehValue / 2 + ElseIf Index = 3 Then + y2tex = tehValue / 2 + End If + picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B + +End Sub + +Private Sub picTexture_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + If Button <> 0 Then + picTexture.DrawMode = 6 + picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B + x1tex = Int((X + 0) / 16) * 16 + y1tex = Int((Y + 0) / 16) * 16 + x2tex = x1tex + 16 + y2tex = y1tex + 16 + picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B + End If + +End Sub + +Private Sub picTexture_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + Dim drawBox As Boolean + + If Button <> 0 Then + If X + 16 > frmSoldatMapEditor.xTexture / 2 Then + X = frmSoldatMapEditor.xTexture / 2 - 16 + ElseIf X + 16 < 0 Then + X = -16 + End If + If Y + 16 > frmSoldatMapEditor.yTexture / 2 Then + Y = frmSoldatMapEditor.yTexture / 2 - 16 + ElseIf Y + 16 < 0 Then + Y = -16 + End If + If Int((X + 16) / 16) * 16 <> x2tex Then + drawBox = True + End If + If Int((Y + 16) / 16) * 16 <> y2tex Then + drawBox = True + End If + If drawBox Then + picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B + x2tex = Int((X + 16) / 16) * 16 + y2tex = Int((Y + 16) / 16) * 16 + picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B + End If + End If + +End Sub + +Private Sub picTexture_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + If Button <> 0 Then + If X + 16 > frmSoldatMapEditor.xTexture / 2 Then + X = frmSoldatMapEditor.xTexture / 2 - 16 + ElseIf X + 16 < 0 Then + X = -16 + End If + If Y + 16 > frmSoldatMapEditor.yTexture / 2 Then + Y = frmSoldatMapEditor.yTexture / 2 - 16 + ElseIf Y + 16 < 0 Then + Y = -16 + End If + + x2tex = Int((X + 16) / 16) * 16 + y2tex = Int((Y + 16) / 16) * 16 + + frmInfo.txtQuadX(0).Text = x1tex * 2 + frmInfo.txtQuadY(0).Text = y1tex * 2 + frmInfo.txtQuadX(1).Text = x2tex * 2 + frmInfo.txtQuadY(1).Text = y2tex * 2 + + End If + +End Sub + +Public Sub setTexture(texturePath As String) + + On Error GoTo ErrorHandler + + Dim texWidth As Integer, texHeight As Integer + Dim X As Integer, Y As Integer + + texWidth = frmSoldatMapEditor.xTexture + texHeight = frmSoldatMapEditor.yTexture + + picTexture.DrawMode = 13 + + picTexture.Width = texWidth / 2 + picTexture.Height = texHeight / 2 + frmTexture.Width = (texWidth / 2 + 2 + 16) * Screen.TwipsPerPixelX + formHeight = texHeight / 2 + 18 + 16 + frmTexture.Height = formHeight * Screen.TwipsPerPixelY + picHide.left = frmTexture.Width / Screen.TwipsPerPixelX - 17 + + Dim Token As Long + Token = InitGDIPlus + picTexture.Picture = LoadPictureGDIPlus(frmSoldatMapEditor.soldatDir & "textures\" & texturePath, texWidth / 2, texHeight / 2) + FreeGDIPlus Token + + For Y = 0 To (texHeight / 32) + If Y Mod 4 = 0 Then + picTexture.DrawWidth = 2 + Else + picTexture.DrawWidth = 1 + End If + picTexture.Line (0, Y * 16)-(texWidth / 2, Y * 16), RGB(0, 0, 0) + Next + + For X = 0 To (texWidth / 32) + If X Mod 4 = 0 Then + picTexture.DrawWidth = 2 + Else + picTexture.DrawWidth = 1 + End If + picTexture.Line (X * 16, 0)-(X * 16, texHeight), RGB(0, 0, 0) + Next + + x1tex = 0 + y1tex = 0 + x2tex = texWidth / 2 + y2tex = texHeight / 2 + picTexture.DrawMode = 6 + picTexture.Line (x1tex, y1tex)-(x2tex, y2tex), RGB(255, 255, 255), B + + Exit Sub + +ErrorHandler: + + MsgBox "Error setting texture" & vbNewLine & Error$ + +End Sub + + +Private Sub picTitle_DblClick() + + collapsed = Not collapsed + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + + snapForm Me, frmTools + snapForm Me, frmPalette + snapForm Me, frmWaypoints + snapForm Me, frmDisplay + snapForm Me, frmScenery + snapForm Me, frmInfo + Me.Tag = snapForm(Me, frmSoldatMapEditor) + + xPos = Me.left / Screen.TwipsPerPixelX + yPos = Me.Top / Screen.TwipsPerPixelY + +End Sub + +Private Sub picHide_Click() + + Me.Hide + frmSoldatMapEditor.mnuTexture.Checked = False + +End Sub + +Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_texture.bmp") + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + + Me.BackColor = bgClr + +End Sub diff --git a/frmTools.frm b/frmTools.frm index 057615e..bbede12 100644 --- a/frmTools.frm +++ b/frmTools.frm @@ -1,479 +1,479 @@ -VERSION 5.00 -Begin VB.Form frmTools - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 1 'Fixed Single - ClientHeight = 3600 - ClientLeft = 15 - ClientTop = 15 - ClientWidth = 960 - ControlBox = 0 'False - ForeColor = &H00000000& - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 240 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - ShowInTaskbar = 0 'False - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 13 - Left = 480 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 15 - Tag = "Depth Map" - ToolTipText = "(.)" - Top = 3120 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 12 - Left = 0 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 14 - Tag = "Lights" - ToolTipText = "(.)" - Top = 3120 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 11 - Left = 480 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 13 - Tag = "Sketch" - ToolTipText = "(.)" - Top = 2640 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 10 - Left = 0 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 12 - Tag = "Color Picker" - ToolTipText = "Color Picker (,)" - Top = 2640 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 9 - Left = 480 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 11 - Tag = "Objects" - ToolTipText = "Objects (T)" - Top = 2160 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 8 - Left = 0 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 10 - Tag = "Waypoints" - ToolTipText = "Waypoints (T)" - Top = 2160 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 7 - Left = 480 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 9 - Tag = "Scenery" - ToolTipText = "Scenery (Y)" - Top = 1680 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 0 - Left = 0 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 8 - Tag = "Transform" - ToolTipText = "Transform (M)" - Top = 240 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 1 - Left = 480 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 7 - Tag = "Poly Creation" - ToolTipText = "Poly Creation (C)" - Top = 240 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 2 - Left = 0 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 6 - Tag = "Vertex Selection" - ToolTipText = "Vertex Selection (V)" - Top = 720 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 3 - Left = 480 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 5 - Tag = "Poly Selection" - ToolTipText = "Poly Selection (P)" - Top = 720 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 4 - Left = 0 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 4 - Tag = "Vertex Color" - ToolTipText = "Vertex Color (E)" - Top = 1200 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 5 - Left = 480 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 3 - Tag = "Poly Color" - ToolTipText = "Poly Color (R)" - Top = 1200 - Width = 480 - End - Begin VB.PictureBox picTools - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 480 - Index = 6 - Left = 0 - ScaleHeight = 32 - ScaleMode = 3 'Pixel - ScaleWidth = 32 - TabIndex = 2 - Tag = "Texture" - ToolTipText = "Texture (T)" - Top = 1680 - Width = 480 - End - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 255 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 64 - TabIndex = 0 - TabStop = 0 'False - Top = 0 - Width = 960 - Begin VB.PictureBox picHide - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 720 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 1 - TabStop = 0 'False - Tag = "3" - Top = 0 - Width = 240 - End - End -End -Attribute VB_Name = "frmTools" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Dim curTool As Byte -Dim curButton As Byte -Public xPos As Integer, yPos As Integer -Dim formHeight As Integer -Public collapsed As Boolean -Dim hotKeys(0 To 13) As Byte - -Public Function getHotKey(ByVal Index As Byte) As Byte - - getHotKey = hotKeys(Index) - -End Function - -Public Sub setHotKey(Index As Integer, ByVal value As Byte) - - If value > 0 Then - hotKeys(Index) = value - End If - -End Sub - -Public Sub initTool(value As Byte) - - curTool = value - -End Sub - -Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) - - MsgBox KeyCode - -End Sub - -Private Sub Form_Load() - - On Error GoTo ErrorHandler - - SetColors - - formHeight = Me.ScaleHeight - - setForm - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading Tools form" - -End Sub - -Public Sub setForm() - - Me.left = xPos * Screen.TwipsPerPixelX - Me.Top = yPos * Screen.TwipsPerPixelY - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub picTitle_DblClick() - - collapsed = Not collapsed - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - - snapForm Me, frmPalette - snapForm Me, frmWaypoints - snapForm Me, frmDisplay - snapForm Me, frmScenery - snapForm Me, frmInfo - snapForm Me, frmTexture - Me.Tag = snapForm(Me, frmSoldatMapEditor) - - xPos = Me.left / Screen.TwipsPerPixelX - yPos = Me.Top / Screen.TwipsPerPixelY - -End Sub - -Public Sub picTools_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - Dim i As Integer - - If curTool <> Index Then - For i = 0 To 13 - BitBlt picTools(i).hDC, 0, 0, 32, 32, frmSoldatMapEditor.picGfx.hDC, 0, i * 32, vbSrcCopy - picTools(i).Refresh - Next - BitBlt picTools(Index).hDC, 0, 0, 32, 32, frmSoldatMapEditor.picGfx.hDC, 64, Index * 32, vbSrcCopy - picTools(Index).Refresh - End If - curTool = Index - -End Sub - -Private Sub picTools_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - If curTool <> Index Then - mouseEvent picTools(Index), (picTools(Index).ScaleWidth - X), (picTools(Index).ScaleHeight - Y), 0, Index * 32, 32, 32 - End If - -End Sub - -Private Sub picTools_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - frmSoldatMapEditor.setCurrentTool curTool - frmSoldatMapEditor.MouseIcon = frmSoldatMapEditor.ImageList.ListImages(curTool + 1).Picture - frmSoldatMapEditor.RegainFocus - -End Sub - -Private Sub picHide_Click() - - Me.Hide - frmSoldatMapEditor.mnuTools.Checked = False - -End Sub - -Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Public Sub SetColors() - - On Error Resume Next - - Dim i As Integer - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_tools.bmp") - - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - - For i = 0 To 13 - BitBlt picTools(i).hDC, 0, 0, 32, 32, frmSoldatMapEditor.picGfx.hDC, 0, i * 32, vbSrcCopy - picTools(i).Refresh - frmTools.picTools(i).ToolTipText = frmTools.picTools(i).Tag & " (" & Chr$(MapVirtualKey(hotKeys(i), 1)) & ")" - Next - BitBlt picTools(curTool).hDC, 0, 0, 32, 32, frmSoldatMapEditor.picGfx.hDC, 64, curTool * 32, vbSrcCopy - picTools(curTool).Refresh - -End Sub +VERSION 5.00 +Begin VB.Form frmTools + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 1 'Fixed Single + ClientHeight = 3600 + ClientLeft = 15 + ClientTop = 15 + ClientWidth = 960 + ControlBox = 0 'False + ForeColor = &H00000000& + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 240 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + ShowInTaskbar = 0 'False + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 13 + Left = 480 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 15 + Tag = "Depth Map" + ToolTipText = "(.)" + Top = 3120 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 12 + Left = 0 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 14 + Tag = "Lights" + ToolTipText = "(.)" + Top = 3120 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 11 + Left = 480 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 13 + Tag = "Sketch" + ToolTipText = "(.)" + Top = 2640 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 10 + Left = 0 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 12 + Tag = "Color Picker" + ToolTipText = "Color Picker (,)" + Top = 2640 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 9 + Left = 480 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 11 + Tag = "Objects" + ToolTipText = "Objects (T)" + Top = 2160 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 8 + Left = 0 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 10 + Tag = "Waypoints" + ToolTipText = "Waypoints (T)" + Top = 2160 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 7 + Left = 480 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 9 + Tag = "Scenery" + ToolTipText = "Scenery (Y)" + Top = 1680 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 0 + Left = 0 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 8 + Tag = "Transform" + ToolTipText = "Transform (M)" + Top = 240 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 1 + Left = 480 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 7 + Tag = "Poly Creation" + ToolTipText = "Poly Creation (C)" + Top = 240 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 2 + Left = 0 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 6 + Tag = "Vertex Selection" + ToolTipText = "Vertex Selection (V)" + Top = 720 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 3 + Left = 480 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 5 + Tag = "Poly Selection" + ToolTipText = "Poly Selection (P)" + Top = 720 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 4 + Left = 0 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 4 + Tag = "Vertex Color" + ToolTipText = "Vertex Color (E)" + Top = 1200 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 5 + Left = 480 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 3 + Tag = "Poly Color" + ToolTipText = "Poly Color (R)" + Top = 1200 + Width = 480 + End + Begin VB.PictureBox picTools + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 480 + Index = 6 + Left = 0 + ScaleHeight = 32 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 2 + Tag = "Texture" + ToolTipText = "Texture (T)" + Top = 1680 + Width = 480 + End + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 255 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 64 + TabIndex = 0 + TabStop = 0 'False + Top = 0 + Width = 960 + Begin VB.PictureBox picHide + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 720 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 1 + TabStop = 0 'False + Tag = "3" + Top = 0 + Width = 240 + End + End +End +Attribute VB_Name = "frmTools" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Dim curTool As Byte +Dim curButton As Byte +Public xPos As Integer, yPos As Integer +Dim formHeight As Integer +Public collapsed As Boolean +Dim hotKeys(0 To 13) As Byte + +Public Function getHotKey(ByVal Index As Byte) As Byte + + getHotKey = hotKeys(Index) + +End Function + +Public Sub setHotKey(Index As Integer, ByVal value As Byte) + + If value > 0 Then + hotKeys(Index) = value + End If + +End Sub + +Public Sub initTool(value As Byte) + + curTool = value + +End Sub + +Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) + + MsgBox KeyCode + +End Sub + +Private Sub Form_Load() + + On Error GoTo ErrorHandler + + SetColors + + formHeight = Me.ScaleHeight + + setForm + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading Tools form" + +End Sub + +Public Sub setForm() + + Me.left = xPos * Screen.TwipsPerPixelX + Me.Top = yPos * Screen.TwipsPerPixelY + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub picTitle_DblClick() + + collapsed = Not collapsed + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + + snapForm Me, frmPalette + snapForm Me, frmWaypoints + snapForm Me, frmDisplay + snapForm Me, frmScenery + snapForm Me, frmInfo + snapForm Me, frmTexture + Me.Tag = snapForm(Me, frmSoldatMapEditor) + + xPos = Me.left / Screen.TwipsPerPixelX + yPos = Me.Top / Screen.TwipsPerPixelY + +End Sub + +Public Sub picTools_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + Dim i As Integer + + If curTool <> Index Then + For i = 0 To 13 + BitBlt picTools(i).hDC, 0, 0, 32, 32, frmSoldatMapEditor.picGfx.hDC, 0, i * 32, vbSrcCopy + picTools(i).Refresh + Next + BitBlt picTools(Index).hDC, 0, 0, 32, 32, frmSoldatMapEditor.picGfx.hDC, 64, Index * 32, vbSrcCopy + picTools(Index).Refresh + End If + curTool = Index + +End Sub + +Private Sub picTools_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + If curTool <> Index Then + mouseEvent picTools(Index), (picTools(Index).ScaleWidth - X), (picTools(Index).ScaleHeight - Y), 0, Index * 32, 32, 32 + End If + +End Sub + +Private Sub picTools_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + frmSoldatMapEditor.setCurrentTool curTool + frmSoldatMapEditor.MouseIcon = frmSoldatMapEditor.ImageList.ListImages(curTool + 1).Picture + frmSoldatMapEditor.RegainFocus + +End Sub + +Private Sub picHide_Click() + + Me.Hide + frmSoldatMapEditor.mnuTools.Checked = False + +End Sub + +Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + Dim i As Integer + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_tools.bmp") + + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + + For i = 0 To 13 + BitBlt picTools(i).hDC, 0, 0, 32, 32, frmSoldatMapEditor.picGfx.hDC, 0, i * 32, vbSrcCopy + picTools(i).Refresh + frmTools.picTools(i).ToolTipText = frmTools.picTools(i).Tag & " (" & Chr$(MapVirtualKey(hotKeys(i), 1)) & ")" + Next + BitBlt picTools(curTool).hDC, 0, 0, 32, 32, frmSoldatMapEditor.picGfx.hDC, 64, curTool * 32, vbSrcCopy + picTools(curTool).Refresh + +End Sub diff --git a/frmWaypoints.frm b/frmWaypoints.frm index f5283e5..f9e4e61 100644 --- a/frmWaypoints.frm +++ b/frmWaypoints.frm @@ -1,818 +1,818 @@ -VERSION 5.00 -Begin VB.Form frmWaypoints - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 1 'Fixed Single - ClientHeight = 2400 - ClientLeft = 15 - ClientTop = 15 - ClientWidth = 3120 - ControlBox = 0 'False - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 160 - ScaleMode = 3 'Pixel - ScaleWidth = 208 - ShowInTaskbar = 0 'False - StartUpPosition = 3 'Windows Default - Begin VB.PictureBox picShow - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 2 - Left = 1920 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 21 - Tag = "6" - Top = 1920 - Width = 240 - End - Begin VB.PictureBox picShow - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 1 - Left = 1920 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 19 - Tag = "6" - Top = 1680 - Width = 240 - End - Begin VB.PictureBox picShow - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 0 - Left = 1920 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 17 - Tag = "6" - Top = 1440 - Width = 240 - End - Begin VB.ComboBox cboSpecial - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - Height = 285 - ItemData = "frmWaypoints.frx":0000 - Left = 120 - List = "frmWaypoints.frx":0019 - Style = 2 'Dropdown List - TabIndex = 9 - Tag = "font1" - ToolTipText = "Special" - Top = 1200 - Width = 1455 - End - Begin VB.PictureBox picType - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 4 - Left = 1920 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 8 - Tag = "4" - Top = 840 - Width = 240 - End - Begin VB.PictureBox picType - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 3 - Left = 720 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 7 - Tag = "4" - Top = 840 - Width = 240 - End - Begin VB.PictureBox picType - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 2 - Left = 720 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 6 - Tag = "4" - Top = 360 - Width = 240 - End - Begin VB.PictureBox picType - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 1 - Left = 1320 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 5 - Tag = "4" - Top = 600 - Width = 240 - End - Begin VB.PictureBox picType - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 0 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 4 - Tag = "4" - Top = 600 - Width = 240 - End - Begin VB.PictureBox picPath - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 1 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 3 - Tag = "6" - Top = 1920 - Width = 240 - End - Begin VB.PictureBox picPath - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Index = 0 - Left = 120 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 2 - Tag = "6" - Top = 1680 - Width = 240 - End - Begin VB.PictureBox picTitle - Align = 1 'Align Top - Appearance = 0 'Flat - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 255 - Left = 0 - ScaleHeight = 17 - ScaleMode = 3 'Pixel - ScaleWidth = 208 - TabIndex = 0 - TabStop = 0 'False - Top = 0 - Width = 3120 - Begin VB.PictureBox picHide - Appearance = 0 'Flat - AutoRedraw = -1 'True - BackColor = &H004A3C31& - BorderStyle = 0 'None - ForeColor = &H80000008& - Height = 240 - Left = 2880 - ScaleHeight = 16 - ScaleMode = 3 'Pixel - ScaleWidth = 16 - TabIndex = 1 - TabStop = 0 'False - Tag = "3" - Top = 0 - Width = 240 - End - End - Begin VB.Label lblNumCon - Alignment = 1 'Right Justify - BackStyle = 0 'Transparent - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H007B614A& - Height = 255 - Left = 2520 - TabIndex = 24 - Top = 360 - Width = 375 - End - Begin VB.Label lblWaypoints - BackStyle = 0 'Transparent - Caption = "Show:" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Left = 1920 - TabIndex = 23 - Tag = "font2" - Top = 1200 - Width = 735 - End - Begin VB.Label lblShow - BackStyle = 0 'Transparent - Caption = " Path2" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 2160 - TabIndex = 22 - Tag = "font2" - Top = 1920 - Width = 735 - End - Begin VB.Label lblShow - BackStyle = 0 'Transparent - Caption = " Path1" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 2160 - TabIndex = 20 - Tag = "font2" - Top = 1680 - Width = 735 - End - Begin VB.Label lblShow - BackStyle = 0 'Transparent - Caption = " All" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 2160 - TabIndex = 18 - Tag = "font2" - Top = 1440 - Width = 735 - End - Begin VB.Label lblPath - BackStyle = 0 'Transparent - Caption = " Path 2" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 360 - TabIndex = 16 - Tag = "font2" - Top = 1920 - Width = 855 - End - Begin VB.Label lblPath - BackStyle = 0 'Transparent - Caption = " Path 1" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 360 - TabIndex = 15 - Tag = "font2" - Top = 1680 - Width = 855 - End - Begin VB.Label lblType - BackStyle = 0 'Transparent - Caption = " Fly" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 4 - Left = 2160 - TabIndex = 14 - Tag = "font2" - Top = 840 - Width = 735 - End - Begin VB.Label lblType - BackStyle = 0 'Transparent - Caption = " Left" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 0 - Left = 360 - TabIndex = 13 - Tag = "font2" - Top = 600 - Width = 735 - End - Begin VB.Label lblType - BackStyle = 0 'Transparent - Caption = " Down" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 3 - Left = 960 - TabIndex = 12 - Tag = "font2" - Top = 840 - Width = 735 - End - Begin VB.Label lblType - BackStyle = 0 'Transparent - Caption = " Right" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 1 - Left = 1560 - TabIndex = 11 - Tag = "font2" - Top = 600 - Width = 735 - End - Begin VB.Label lblType - BackStyle = 0 'Transparent - Caption = " Up" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 238 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00FFFFFF& - Height = 255 - Index = 2 - Left = 960 - TabIndex = 10 - Tag = "font2" - Top = 360 - Width = 735 - End -End -Attribute VB_Name = "frmWaypoints" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Option Explicit - -Dim formHeight As Integer -Public collapsed As Boolean - -Public xPos As Integer, yPos As Integer - -Dim wayptType(0 To 4) As Boolean -Public wayptPath As Byte -Public showPaths As Byte - -Dim wayptKeys(0 To 4) As Byte - -Public noChange As Boolean - -Public Function getWayptKey(ByVal Index As Byte) As Byte - - getWayptKey = wayptKeys(Index) - -End Function - -Public Sub setWayptKey(Index As Integer, ByVal value As Byte) - - If value > 0 Then - wayptKeys(Index) = value - End If - -End Sub - -Private Sub Form_Load() - - Dim i As Integer - - On Error GoTo ErrorHandler - - Me.SetColors - - formHeight = Me.ScaleHeight - - setForm - - Exit Sub - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading Waypoints form" - -End Sub - -Public Sub setForm() - - Me.left = xPos * Screen.TwipsPerPixelX - Me.Top = yPos * Screen.TwipsPerPixelY - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub cboSpecial_Click() - - If noChange = False And cboSpecial.ListIndex > -1 Then - If Not frmSoldatMapEditor.setSpecial(cboSpecial.ListIndex) Then - cboSpecial.ListIndex = -1 - End If - End If - -End Sub - -Public Sub getPathNum(tehValue As Byte) - - mouseEvent2 picPath(0), 0, 0, BUTTON_SMALL, tehValue = 1, BUTTON_UP - mouseEvent2 picPath(1), 0, 0, BUTTON_SMALL, tehValue = 2, BUTTON_UP - wayptPath = tehValue - 1 - -End Sub - -Public Sub getWayType(Index As Integer, tehValue As Boolean) - - wayptType(Index) = tehValue - mouseEvent2 picType(Index), 0, 0, BUTTON_SMALL, tehValue, BUTTON_UP - -End Sub - -Private Sub lblPath_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - picPath_MouseMove Index, 1, 0, 0, 0 - -End Sub - -Private Sub lblShow_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - picShow_MouseMove Index, Button, 0, 0, 0 - -End Sub - -Private Sub lblType_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - picType_MouseMove Index, Button, 0, 0, 0 - -End Sub - -Public Sub ClearWaypt() - - Dim i As Integer - - For i = 0 To 4 - mouseEvent2 picType(i), 0, 0, BUTTON_SMALL, 0, BUTTON_UP - wayptType(i) = False - Next - - cboSpecial.ListIndex = -1 - lblNumCon.Caption = "" - -End Sub - - -Private Sub picTitle_DblClick() - - collapsed = Not collapsed - If collapsed Then - Me.Height = 19 * Screen.TwipsPerPixelY - Else - Me.Height = formHeight * Screen.TwipsPerPixelY - End If - -End Sub - -Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - ReleaseCapture - SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& - - snapForm Me, frmPalette - snapForm Me, frmInfo - snapForm Me, frmTools - snapForm Me, frmScenery - snapForm Me, frmDisplay - snapForm Me, frmTexture - Me.Tag = snapForm(Me, frmSoldatMapEditor) - - xPos = Me.left / Screen.TwipsPerPixelX - yPos = Me.Top / Screen.TwipsPerPixelY - -End Sub - -Private Sub picHide_Click() - - Me.Hide - frmSoldatMapEditor.mnuWaypoints.Checked = False - -End Sub - -Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN - -End Sub - -Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE - -End Sub - -Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP - -End Sub - -Private Sub picPath_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picPath(Index), X, Y, BUTTON_SMALL, (Index = wayptPath), BUTTON_DOWN - -End Sub - -Private Sub picPath_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picPath(Index), X, Y, BUTTON_SMALL, (Index = wayptPath), BUTTON_MOVE, lblPath(Index).Width + 16 - -End Sub - -Private Sub picPath_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - Dim i As Integer - - wayptPath = Index - - For i = 0 To 1 - If i <> Index Then - mouseEvent2 picPath(i), X, Y, BUTTON_SMALL, (i = wayptPath), BUTTON_UP - End If - Next - - frmSoldatMapEditor.setPathNum Index + 1 - -End Sub - -Public Sub picType_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picType(Index), X, Y, BUTTON_SMALL, wayptType(Index), BUTTON_DOWN - -End Sub - -Private Sub picType_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picType(Index), X, Y, BUTTON_SMALL, wayptType(Index), BUTTON_MOVE, lblType(Index).Width + 16 - -End Sub - -Public Sub picType_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - If Not frmSoldatMapEditor.setWayType(Index, Not wayptType(Index)) Then Exit Sub - - wayptType(Index) = Not wayptType(Index) - mouseEvent2 picType(Index), 0, 0, BUTTON_SMALL, wayptType(Index), BUTTON_UP - If Index = 0 Then - wayptType(1) = False - mouseEvent2 picType(1), 0, 0, BUTTON_SMALL, 0, BUTTON_UP - ElseIf Index = 1 Then - wayptType(0) = False - mouseEvent2 picType(0), 0, 0, BUTTON_SMALL, 0, BUTTON_UP - ElseIf Index = 2 Then - wayptType(3) = False - mouseEvent2 picType(3), 0, 0, BUTTON_SMALL, 0, BUTTON_UP - ElseIf Index = 3 Then - wayptType(2) = False - mouseEvent2 picType(2), 0, 0, BUTTON_SMALL, 0, BUTTON_UP - End If - -End Sub - -Private Sub picShow_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picShow(Index), X, Y, BUTTON_SMALL, (Index = showPaths), BUTTON_DOWN - -End Sub - -Private Sub picShow_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - mouseEvent2 picShow(Index), X, Y, BUTTON_SMALL, (Index = showPaths), BUTTON_MOVE, lblShow(Index).Width + 16 - -End Sub - -Public Sub picShow_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) - - Dim i As Integer - - showPaths = Index - - For i = 0 To 2 - If i <> Index Then - mouseEvent2 picShow(i), X, Y, BUTTON_SMALL, (i = showPaths), BUTTON_UP - End If - Next - - frmSoldatMapEditor.setShowPaths - -End Sub - -Public Sub SetColors() - - On Error Resume Next - - Dim i As Integer - Dim c As Control - - - picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_waypoints.bmp") - mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP - - mouseEvent2 picPath(0), 0, 0, BUTTON_SMALL, True, BUTTON_UP - mouseEvent2 picPath(1), 0, 0, BUTTON_SMALL, False, BUTTON_UP - - For i = 0 To 4 - mouseEvent2 picType(i), 0, 0, BUTTON_SMALL, 0, BUTTON_UP - Next - - For i = 0 To 2 - mouseEvent2 picShow(i), 0, 0, BUTTON_SMALL, i = showPaths, BUTTON_UP - Next - - - Me.BackColor = bgClr - - For i = 0 To 4 - lblType(i).BackColor = lblBackClr - lblType(i).ForeColor = lblTextClr - Next - - For i = 0 To 1 - lblPath(i).BackColor = lblBackClr - lblPath(i).ForeColor = lblTextClr - Next - - For i = 0 To 2 - lblShow(i).BackColor = lblBackClr - lblShow(i).ForeColor = lblTextClr - Next - - lblWaypoints.BackColor = lblBackClr - lblWaypoints.ForeColor = lblTextClr - - cboSpecial.BackColor = txtBackClr - cboSpecial.ForeColor = txtTextClr - - lblNumCon.BackColor = lblBackClr - lblNumCon.ForeColor = lblTextClr - - For Each c In Me.Controls - If c.Tag = "font1" Then - c.Font.Name = font1 - ElseIf c.Tag = "font2" Then - c.Font.Name = font2 - End If - Next - -End Sub +VERSION 5.00 +Begin VB.Form frmWaypoints + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 1 'Fixed Single + ClientHeight = 2400 + ClientLeft = 15 + ClientTop = 15 + ClientWidth = 3120 + ControlBox = 0 'False + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 160 + ScaleMode = 3 'Pixel + ScaleWidth = 208 + ShowInTaskbar = 0 'False + StartUpPosition = 3 'Windows Default + Begin VB.PictureBox picShow + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 2 + Left = 1920 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 21 + Tag = "6" + Top = 1920 + Width = 240 + End + Begin VB.PictureBox picShow + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 1 + Left = 1920 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 19 + Tag = "6" + Top = 1680 + Width = 240 + End + Begin VB.PictureBox picShow + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 0 + Left = 1920 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 17 + Tag = "6" + Top = 1440 + Width = 240 + End + Begin VB.ComboBox cboSpecial + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + ItemData = "frmWaypoints.frx":0000 + Left = 120 + List = "frmWaypoints.frx":0019 + Style = 2 'Dropdown List + TabIndex = 9 + Tag = "font1" + ToolTipText = "Special" + Top = 1200 + Width = 1455 + End + Begin VB.PictureBox picType + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 4 + Left = 1920 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 8 + Tag = "4" + Top = 840 + Width = 240 + End + Begin VB.PictureBox picType + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 3 + Left = 720 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 7 + Tag = "4" + Top = 840 + Width = 240 + End + Begin VB.PictureBox picType + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 2 + Left = 720 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 6 + Tag = "4" + Top = 360 + Width = 240 + End + Begin VB.PictureBox picType + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 1 + Left = 1320 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 5 + Tag = "4" + Top = 600 + Width = 240 + End + Begin VB.PictureBox picType + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 0 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 4 + Tag = "4" + Top = 600 + Width = 240 + End + Begin VB.PictureBox picPath + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 1 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 3 + Tag = "6" + Top = 1920 + Width = 240 + End + Begin VB.PictureBox picPath + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Index = 0 + Left = 120 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 2 + Tag = "6" + Top = 1680 + Width = 240 + End + Begin VB.PictureBox picTitle + Align = 1 'Align Top + Appearance = 0 'Flat + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 255 + Left = 0 + ScaleHeight = 17 + ScaleMode = 3 'Pixel + ScaleWidth = 208 + TabIndex = 0 + TabStop = 0 'False + Top = 0 + Width = 3120 + Begin VB.PictureBox picHide + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H004A3C31& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 240 + Left = 2880 + ScaleHeight = 16 + ScaleMode = 3 'Pixel + ScaleWidth = 16 + TabIndex = 1 + TabStop = 0 'False + Tag = "3" + Top = 0 + Width = 240 + End + End + Begin VB.Label lblNumCon + Alignment = 1 'Right Justify + BackStyle = 0 'Transparent + BeginProperty Font + Name = "Arial" + Size = 8.25 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H007B614A& + Height = 255 + Left = 2520 + TabIndex = 24 + Top = 360 + Width = 375 + End + Begin VB.Label lblWaypoints + BackStyle = 0 'Transparent + Caption = "Show:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Left = 1920 + TabIndex = 23 + Tag = "font2" + Top = 1200 + Width = 735 + End + Begin VB.Label lblShow + BackStyle = 0 'Transparent + Caption = " Path2" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 2160 + TabIndex = 22 + Tag = "font2" + Top = 1920 + Width = 735 + End + Begin VB.Label lblShow + BackStyle = 0 'Transparent + Caption = " Path1" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 2160 + TabIndex = 20 + Tag = "font2" + Top = 1680 + Width = 735 + End + Begin VB.Label lblShow + BackStyle = 0 'Transparent + Caption = " All" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 2160 + TabIndex = 18 + Tag = "font2" + Top = 1440 + Width = 735 + End + Begin VB.Label lblPath + BackStyle = 0 'Transparent + Caption = " Path 2" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 360 + TabIndex = 16 + Tag = "font2" + Top = 1920 + Width = 855 + End + Begin VB.Label lblPath + BackStyle = 0 'Transparent + Caption = " Path 1" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 360 + TabIndex = 15 + Tag = "font2" + Top = 1680 + Width = 855 + End + Begin VB.Label lblType + BackStyle = 0 'Transparent + Caption = " Fly" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 4 + Left = 2160 + TabIndex = 14 + Tag = "font2" + Top = 840 + Width = 735 + End + Begin VB.Label lblType + BackStyle = 0 'Transparent + Caption = " Left" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 0 + Left = 360 + TabIndex = 13 + Tag = "font2" + Top = 600 + Width = 735 + End + Begin VB.Label lblType + BackStyle = 0 'Transparent + Caption = " Down" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 3 + Left = 960 + TabIndex = 12 + Tag = "font2" + Top = 840 + Width = 735 + End + Begin VB.Label lblType + BackStyle = 0 'Transparent + Caption = " Right" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 1 + Left = 1560 + TabIndex = 11 + Tag = "font2" + Top = 600 + Width = 735 + End + Begin VB.Label lblType + BackStyle = 0 'Transparent + Caption = " Up" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 238 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 255 + Index = 2 + Left = 960 + TabIndex = 10 + Tag = "font2" + Top = 360 + Width = 735 + End +End +Attribute VB_Name = "frmWaypoints" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Dim formHeight As Integer +Public collapsed As Boolean + +Public xPos As Integer, yPos As Integer + +Dim wayptType(0 To 4) As Boolean +Public wayptPath As Byte +Public showPaths As Byte + +Dim wayptKeys(0 To 4) As Byte + +Public noChange As Boolean + +Public Function getWayptKey(ByVal Index As Byte) As Byte + + getWayptKey = wayptKeys(Index) + +End Function + +Public Sub setWayptKey(Index As Integer, ByVal value As Byte) + + If value > 0 Then + wayptKeys(Index) = value + End If + +End Sub + +Private Sub Form_Load() + + Dim i As Integer + + On Error GoTo ErrorHandler + + Me.SetColors + + formHeight = Me.ScaleHeight + + setForm + + Exit Sub + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading Waypoints form" + +End Sub + +Public Sub setForm() + + Me.left = xPos * Screen.TwipsPerPixelX + Me.Top = yPos * Screen.TwipsPerPixelY + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub cboSpecial_Click() + + If noChange = False And cboSpecial.ListIndex > -1 Then + If Not frmSoldatMapEditor.setSpecial(cboSpecial.ListIndex) Then + cboSpecial.ListIndex = -1 + End If + End If + +End Sub + +Public Sub getPathNum(tehValue As Byte) + + mouseEvent2 picPath(0), 0, 0, BUTTON_SMALL, tehValue = 1, BUTTON_UP + mouseEvent2 picPath(1), 0, 0, BUTTON_SMALL, tehValue = 2, BUTTON_UP + wayptPath = tehValue - 1 + +End Sub + +Public Sub getWayType(Index As Integer, tehValue As Boolean) + + wayptType(Index) = tehValue + mouseEvent2 picType(Index), 0, 0, BUTTON_SMALL, tehValue, BUTTON_UP + +End Sub + +Private Sub lblPath_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + picPath_MouseMove Index, 1, 0, 0, 0 + +End Sub + +Private Sub lblShow_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + picShow_MouseMove Index, Button, 0, 0, 0 + +End Sub + +Private Sub lblType_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + picType_MouseMove Index, Button, 0, 0, 0 + +End Sub + +Public Sub ClearWaypt() + + Dim i As Integer + + For i = 0 To 4 + mouseEvent2 picType(i), 0, 0, BUTTON_SMALL, 0, BUTTON_UP + wayptType(i) = False + Next + + cboSpecial.ListIndex = -1 + lblNumCon.Caption = "" + +End Sub + + +Private Sub picTitle_DblClick() + + collapsed = Not collapsed + If collapsed Then + Me.Height = 19 * Screen.TwipsPerPixelY + Else + Me.Height = formHeight * Screen.TwipsPerPixelY + End If + +End Sub + +Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + ReleaseCapture + SendMessage Me.hWnd, WM_NCLBUTTONDOWN, 2, 0& + + snapForm Me, frmPalette + snapForm Me, frmInfo + snapForm Me, frmTools + snapForm Me, frmScenery + snapForm Me, frmDisplay + snapForm Me, frmTexture + Me.Tag = snapForm(Me, frmSoldatMapEditor) + + xPos = Me.left / Screen.TwipsPerPixelX + yPos = Me.Top / Screen.TwipsPerPixelY + +End Sub + +Private Sub picHide_Click() + + Me.Hide + frmSoldatMapEditor.mnuWaypoints.Checked = False + +End Sub + +Private Sub picHide_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_DOWN + +End Sub + +Private Sub picHide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_MOVE + +End Sub + +Private Sub picHide_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picHide, X, Y, BUTTON_SMALL, 0, BUTTON_UP + +End Sub + +Private Sub picPath_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picPath(Index), X, Y, BUTTON_SMALL, (Index = wayptPath), BUTTON_DOWN + +End Sub + +Private Sub picPath_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picPath(Index), X, Y, BUTTON_SMALL, (Index = wayptPath), BUTTON_MOVE, lblPath(Index).Width + 16 + +End Sub + +Private Sub picPath_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + Dim i As Integer + + wayptPath = Index + + For i = 0 To 1 + If i <> Index Then + mouseEvent2 picPath(i), X, Y, BUTTON_SMALL, (i = wayptPath), BUTTON_UP + End If + Next + + frmSoldatMapEditor.setPathNum Index + 1 + +End Sub + +Public Sub picType_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picType(Index), X, Y, BUTTON_SMALL, wayptType(Index), BUTTON_DOWN + +End Sub + +Private Sub picType_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picType(Index), X, Y, BUTTON_SMALL, wayptType(Index), BUTTON_MOVE, lblType(Index).Width + 16 + +End Sub + +Public Sub picType_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + If Not frmSoldatMapEditor.setWayType(Index, Not wayptType(Index)) Then Exit Sub + + wayptType(Index) = Not wayptType(Index) + mouseEvent2 picType(Index), 0, 0, BUTTON_SMALL, wayptType(Index), BUTTON_UP + If Index = 0 Then + wayptType(1) = False + mouseEvent2 picType(1), 0, 0, BUTTON_SMALL, 0, BUTTON_UP + ElseIf Index = 1 Then + wayptType(0) = False + mouseEvent2 picType(0), 0, 0, BUTTON_SMALL, 0, BUTTON_UP + ElseIf Index = 2 Then + wayptType(3) = False + mouseEvent2 picType(3), 0, 0, BUTTON_SMALL, 0, BUTTON_UP + ElseIf Index = 3 Then + wayptType(2) = False + mouseEvent2 picType(2), 0, 0, BUTTON_SMALL, 0, BUTTON_UP + End If + +End Sub + +Private Sub picShow_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picShow(Index), X, Y, BUTTON_SMALL, (Index = showPaths), BUTTON_DOWN + +End Sub + +Private Sub picShow_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + mouseEvent2 picShow(Index), X, Y, BUTTON_SMALL, (Index = showPaths), BUTTON_MOVE, lblShow(Index).Width + 16 + +End Sub + +Public Sub picShow_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) + + Dim i As Integer + + showPaths = Index + + For i = 0 To 2 + If i <> Index Then + mouseEvent2 picShow(i), X, Y, BUTTON_SMALL, (i = showPaths), BUTTON_UP + End If + Next + + frmSoldatMapEditor.setShowPaths + +End Sub + +Public Sub SetColors() + + On Error Resume Next + + Dim i As Integer + Dim c As Control + + + picTitle.Picture = LoadPicture(appPath & "\" & gfxDir & "\titlebar_waypoints.bmp") + mouseEvent2 picHide, 0, 0, BUTTON_SMALL, 0, BUTTON_UP + + mouseEvent2 picPath(0), 0, 0, BUTTON_SMALL, True, BUTTON_UP + mouseEvent2 picPath(1), 0, 0, BUTTON_SMALL, False, BUTTON_UP + + For i = 0 To 4 + mouseEvent2 picType(i), 0, 0, BUTTON_SMALL, 0, BUTTON_UP + Next + + For i = 0 To 2 + mouseEvent2 picShow(i), 0, 0, BUTTON_SMALL, i = showPaths, BUTTON_UP + Next + + + Me.BackColor = bgClr + + For i = 0 To 4 + lblType(i).BackColor = lblBackClr + lblType(i).ForeColor = lblTextClr + Next + + For i = 0 To 1 + lblPath(i).BackColor = lblBackClr + lblPath(i).ForeColor = lblTextClr + Next + + For i = 0 To 2 + lblShow(i).BackColor = lblBackClr + lblShow(i).ForeColor = lblTextClr + Next + + lblWaypoints.BackColor = lblBackClr + lblWaypoints.ForeColor = lblTextClr + + cboSpecial.BackColor = txtBackClr + cboSpecial.ForeColor = txtTextClr + + lblNumCon.BackColor = lblBackClr + lblNumCon.ForeColor = lblTextClr + + For Each c In Me.Controls + If c.Tag = "font1" Then + c.Font.Name = font1 + ElseIf c.Tag = "font2" Then + c.Font.Name = font2 + End If + Next + +End Sub diff --git a/modSME.bas b/modSME.bas index b47eb4c..142b896 100644 --- a/modSME.bas +++ b/modSME.bas @@ -1,876 +1,876 @@ -Attribute VB_Name = "modSME" -Option Explicit - -Global Const pi As Single = 3.14159265358979 'mmm... pi - -Global gfxDir As String - -Global appPath As String -Global bgClr As Long -Global lblBackClr As Long -Global lblTextClr As Long -Global txtBackClr As Long -Global txtTextClr As Long -Global frameClr As Long - -Global font1 As String, font2 As String - -Public Const BUTTON_WIDTH = 64 -Public Const BUTTON_HEIGHT = 24 - -Public Const MENU_WIDTH = 64 -Public Const MENU_HEIGHT = 16 - -Public Const BUTTON_SMALL = 0 -Public Const BUTTON_LARGE = 1 -Public Const BUTTON_MENU = 2 -Public Const BUTTON_TOOL = 3 - -Public Const BUTTON_X = 48 -Public Const BUTTON_Y = 0 - -Public Const MENU_X = 48 -Public Const MENU_Y = 96 - -Public Const BUTTON_UP = 0 -Public Const BUTTON_MOVE = 1 -Public Const BUTTON_DOWN = 2 - -'bitblt -Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, _ - ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _ - ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long -'stretchblit -Public Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, _ - ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _ - ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _ - ByVal dwRop As Long) As Long - -'mouse over -Public Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long -Public Declare Function GetCapture Lib "user32" () As Long -Public Declare Function ReleaseCapture Lib "user32" () As Long -'dragging window -Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ - (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long - -Public Const WM_NCLBUTTONDOWN = &HA1 - -'taskbar -Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _ - ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long -Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ - (ByVal lpClassName As String, ByVal lpWindowName As String) As Long -Public Const SWP_HIDEWINDOW = &H80 -Public Const SWP_SHOWWINDOW = &H40 - -Public Const SWP_NOSIZE = &H1 -Public Const SWP_NOMOVE = &H2 - -Public Const HWND_TOPMOST = -1 -Public Const HWND_NOTOPMOST = -2 - -'get pixel -Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long - -'browse -Private Type BROWSEINFO - hOwner As Long - pidlRoot As Long - pszDisplayName As String - lpszTitle As String - ulFlags As Long - lpfn As Long - lParam As Long - iImage As Long -End Type - -Private Const BIF_RETURNONLYFSDIRS = &H1 -Private Const BIF_DONTGOBELOWDOMAIN = &H2 -Private Const BIF_STATUSTEXT = &H4 -Private Const BIF_RETURNFSANCESTORS = &H8 -Private Const BIF_BROWSEFORCOMPUTER = &H1000 -Private Const BIF_BROWSEFORPRINTER = &H2000 -Private Const MAX_PATH = 260 - -Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" _ - (ByVal pidl As Long, ByVal pszPath As String) As Long - -Private Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" _ - (lpBrowseInfo As BROWSEINFO) As Long - -Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long) - - -'registry -Private Const HKEY_CLASSES_ROOT = &H80000000 -Private Const HKEY_LOCAL_MACHINE = &H80000002 - -Private Const STANDARD_RIGHTS_READ As Long = &H20000 -Private Const KEY_QUERY_VALUE As Long = &H1 -Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8 -Private Const KEY_NOTIFY As Long = &H10 -Private Const SYNCHRONIZE As Long = &H100000 - -Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _ - KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE)) - -Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _ - (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _ - ByVal samDesired As Long, phkResult As Long) As Long - -Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _ - (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _ - lpType As Long, lpData As Any, lpcbData As Long) As Long - -Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long - -Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long - - -'file time -Public Const OFS_MAXPATHNAME = 128 -Public Const OF_READWRITE = &H2 - -Public Type OFSTRUCT - cBytes As Byte - fFixedDisk As Byte - nErrCode As Integer - Reserved1 As Integer - Reserved2 As Integer - szPathName(0 To OFS_MAXPATHNAME - 1) As Byte '0-based -End Type - -Public Type FILETIME - dwLowDateTime As Long - dwHighDateTime As Long -End Type - -Public Type SYSTEMTIME - wYear As Integer - wMonth As Integer - wDayOfWeek As Integer - wDay As Integer - wHour As Integer - wMinute As Integer - wSecond As Integer - wMilliseconds As Integer -End Type - - -Public Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, _ - lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long - -Public Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, _ - lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long - -Public Declare Function CloseHandle Lib "kernel32" (ByVal hFile As Long) As Long - -Public Declare Function FileTimeToDosDateTime Lib "kernel32" (lpFileTime As FILETIME, _ - ByVal lpFatDate As Long, ByVal lpFatTime As Long) As Long - -Public Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, _ - lpLocalFileTime As FILETIME) As Long - -Public Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long - -'ini file -Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" _ - (ByVal sSectionName As String, ByVal sKeyName As String, _ - ByVal lDefault As Long, ByVal sFileName As String) As Long - -Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" _ - (ByVal sSectionName As String, ByVal sReturnedString As String, _ - ByVal lSize As Long, ByVal sFileName As String) As Long - -Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _ - (ByVal sSectionName As String, ByVal sKeyName As String, ByVal sDefault As String, _ - ByVal sReturnedString As String, ByVal lSize As Long, ByVal sFileName As String) As Long - -Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" _ - (ByVal sSectionName As String, ByVal sString As String, ByVal sFileName As String) As Long - -Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _ - (ByVal sSectionName As String, ByVal sKeyName As String, _ - ByVal sString As String, ByVal sFileName As String) As Long - -'ShellExecute -Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, _ - ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _ - ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long - -'key mapping -Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" _ - (ByVal wCode As Long, ByVal wMapType As Long) As Long - -'gdi+ -Private Type GUID - Data1 As Long - Data2 As Integer - Data3 As Integer - Data4(7) As Byte -End Type - -Private Type PICTDESC - Size As Long - Type As Long - hBmp As Long - hpal As Long - Reserved As Long -End Type - -Private Type GdiplusStartupInput - GdiplusVersion As Long - DebugEventCallback As Long - SuppressBackgroundThread As Long - SuppressExternalCodecs As Long -End Type - -Private Type ImageCodecInfo - Clsid As GUID - FormatID As GUID - CodecNamePtr As Long - DllNamePtr As Long - FormatDescriptionPtr As Long - FilenameExtensionPtr As Long - MimeTypePtr As Long - Flags As Long - Version As Long - SigCount As Long - SigSize As Long - SigPatternPtr As Long - SigMaskPtr As Long -End Type - -'GDI Functions -Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long -Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long -Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long -Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long -Private Declare Function PatBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long -Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long -Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long -Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long -Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long -Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long - -'GDI+ functions -Private Declare Function GdipLoadImageFromFile Lib "gdiplus.dll" (ByVal fileName As Long, GpImage As Long) As Long -Private Declare Function GdiplusStartup Lib "gdiplus.dll" (Token As Long, gdipInput As GdiplusStartupInput, GdiplusStartupOutput As Long) As Long -Private Declare Function GdipCreateFromHDC Lib "gdiplus.dll" (ByVal hDC As Long, GpGraphics As Long) As Long -Private Declare Function GdipDrawImageRectI Lib "gdiplus.dll" (ByVal Graphics As Long, ByVal Img As Long, ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long) As Long -Private Declare Function GdipDeleteGraphics Lib "gdiplus.dll" (ByVal Graphics As Long) As Long -Private Declare Function GdipDisposeImage Lib "gdiplus.dll" (ByVal image As Long) As Long -Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus.dll" (ByVal hBmp As Long, ByVal hpal As Long, GpBitmap As Long) As Long -Private Declare Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal image As Long, Width As Long) As Long -Private Declare Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal image As Long, Height As Long) As Long -Private Declare Sub GdiplusShutdown Lib "gdiplus.dll" (ByVal Token As Long) - -'functions for gif loading -Private Declare Function GdipSaveImageToFile Lib "gdiplus.dll" (ByVal image As Long, ByVal fileName As Long, ByRef clsidEncoder As GUID, ByRef encoderParams As Any) As Long -Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus.dll" (ByVal fileName As Long, ByRef Bitmap As Long) As Long -Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus.dll" (ByVal Bitmap As Long, ByRef hbmReturn As Long, ByVal background As Long) As Long -Private Declare Function GdipGetImageEncodersSize Lib "gdiplus.dll" (ByRef numEncoders As Long, ByRef Size As Long) As Long -Private Declare Function GdipGetImageEncoders Lib "gdiplus.dll" (ByVal numEncoders As Long, ByVal Size As Long, ByRef Encoders As Any) As Long -Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long - - -'GDI and GDI+ constants -Private Const PLANES = 14 'Number of planes -Private Const BITSPIXEL = 12 'Number of bits per pixel -Private Const PATCOPY = &HF00021 '(DWORD) dest = pattern -Private Const PICTYPE_BITMAP = 1 'Bitmap type -Private Const InterpolationModeHighQualityBicubic = 7 -Private Const GDIP_WMF_PLACEABLEKEY = &H9AC6CDD7 -Private Const UnitPixel = 2 - -Public Sub SelectAllText(tb As TextBox) - - tb.SelStart = 0 - tb.SelLength = Len(tb.Text) - -End Sub - -Private Function GetEncoderClsid(mimeType As String, pClsid As GUID) As Boolean - - Dim num As Long - Dim Size As Long - Dim pImageCodecInfo() As ImageCodecInfo - Dim j As Long - Dim buffer As String - - Call GdipGetImageEncodersSize(num, Size) - If (Size = 0) Then - GetEncoderClsid = False - Exit Function - End If - - ReDim pImageCodecInfo(0 To Size \ Len(pImageCodecInfo(0)) - 1) - - Call GdipGetImageEncoders(num, Size, pImageCodecInfo(0)) - - For j = 0 To num - 1 - - buffer = Space$(lstrlenW(ByVal pImageCodecInfo(j).MimeTypePtr)) - - Call lstrcpyW(ByVal StrPtr(buffer), _ - ByVal pImageCodecInfo(j).MimeTypePtr) - - If (StrComp(buffer, mimeType, vbTextCompare) = 0) Then - pClsid = pImageCodecInfo(j).Clsid - Erase pImageCodecInfo - - GetEncoderClsid = True - Exit Function - End If - Next j - - Erase pImageCodecInfo - - GetEncoderClsid = False -End Function - -Private Function SaveImageAsPNG(ByVal sFileName As String, ByVal sDestFileName As String) As Boolean - - Dim lBitmap As Long - Dim hBitmap As Long - Dim Results As Long - Dim tPicEncoder As GUID - - If GdipCreateBitmapFromFile(StrPtr(sFileName), lBitmap) = 0 Then - If GdipCreateHBITMAPFromBitmap(lBitmap, hBitmap, 0) = 0 Then - If GetEncoderClsid("image/png", tPicEncoder) Then - SaveImageAsPNG = (GdipSaveImageToFile(lBitmap, StrPtr(sDestFileName), tPicEncoder, ByVal 0) = 0) - Else - SaveImageAsPNG = False - End If - GdipDisposeImage lBitmap - End If - End If - -End Function - -Public Function GifToPng(ByVal src As String, ByVal dest As String) As Long - - Dim Token As Long - - Token = InitGDIPlus - - If SaveImageAsPNG(src, dest) Then - GifToPng = -1 - Else - GifToPng = 5 - End If - - FreeGDIPlus Token - -End Function - -Public Function GifToBmp(ByVal src As String, ByVal dest As String) As Long - - GifToBmp = GifToPng(src, dest) - -End Function - -'mouse event -Public Function mouseEvent(ByRef pic As PictureBox, ByVal xVal As Integer, ByVal yVal As Integer, xSrc As Integer, ySrc As Integer, Width As Integer, Height As Integer) As Boolean - - If (xVal < 0) Or (xVal > Width) Or (yVal < 0) Or (yVal > Height) Then 'the MOUSELEAVE pseudo-event - ReleaseCapture - BitBlt pic.hDC, 0, 0, Width, Height, frmSoldatMapEditor.picGfx.hDC, xSrc, ySrc, vbSrcCopy - pic.Refresh - mouseEvent = True - ElseIf GetCapture() <> pic.hWnd Then 'the MOUSEENTER pseudo-event - SetCapture pic.hWnd - BitBlt pic.hDC, 0, 0, Width, Height, frmSoldatMapEditor.picGfx.hDC, xSrc + Width, ySrc, vbSrcCopy - pic.Refresh - mouseEvent = True - End If - -End Function - -'mouse event -Public Function mouseEvent2(ByRef pic As PictureBox, ByVal xVal As Integer, ByVal yVal As Integer, ByVal buttonType As Byte, ByVal active As Byte, ByVal action As Byte, Optional exWidth As Integer) As Boolean - - Dim xSrc As Integer, ySrc As Integer - Dim Width As Integer, Height As Integer - - On Error GoTo ErrorHandler - - If buttonType = BUTTON_SMALL Then - Width = 16 - Height = 16 - xSrc = 0 - ySrc = Int(pic.Tag) * Height - ElseIf buttonType = BUTTON_LARGE Then - Width = BUTTON_WIDTH - Height = BUTTON_HEIGHT - xSrc = BUTTON_X - ySrc = BUTTON_Y + Int(pic.Tag) * Height - ElseIf buttonType = BUTTON_MENU Then - Width = MENU_WIDTH - Height = MENU_HEIGHT - xSrc = MENU_X - ySrc = MENU_Y + Int(pic.Index) * Height - End If - - active = active / 255 - - If exWidth = 0 Then exWidth = Width - - If action = BUTTON_UP Or action = BUTTON_DOWN Then - mouseEvent2 = True - ElseIf (xVal < 0) Or (xVal > exWidth) Or (yVal < 0) Or (yVal > Height) Then 'the MOUSELEAVE pseudo-event - ReleaseCapture - mouseEvent2 = True - action = BUTTON_UP - ElseIf GetCapture() <> pic.hWnd Then 'the MOUSEENTER pseudo-event - SetCapture pic.hWnd - mouseEvent2 = True - action = BUTTON_MOVE - End If - - If mouseEvent2 = True Then - BitBlt pic.hDC, 0, 0, Width, Height, frmSoldatMapEditor.picButtonGfx.hDC, xSrc + Width * action, ySrc + active * Height, vbSrcCopy - pic.Refresh - End If - - Exit Function - -ErrorHandler: - - MsgBox Error$ - -End Function - - -'browse -Public Function SelectFolder(ownerForm As Form) As String - - Dim bi As BROWSEINFO - Dim pidl As Long - Dim path As String - Dim pos As Long - - With bi - .hOwner = ownerForm.hWnd - .pidlRoot = 0& - .ulFlags = BIF_RETURNONLYFSDIRS - End With - - pidl = SHBrowseForFolder(bi) - path = Space$(MAX_PATH) - - If SHGetPathFromIDList(ByVal pidl, ByVal path) Then - pos = InStr(path, Chr$(0)) - SelectFolder = LCase$(left(path, pos - 1)) - End If - - Call CoTaskMemFree(pidl) - -End Function - - - -Public Function snapForm(currentForm As Form, otherForm As Form) As String - - snapForm = "" - - 'snap bottom to bottom - If Abs(currentForm.Top + currentForm.Height - otherForm.Top - otherForm.Height) <= 8 * Screen.TwipsPerPixelY Then - If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then - currentForm.Top = otherForm.Top + otherForm.Height - currentForm.Height - snapForm = "snap" - End If - 'snap bottom to top - ElseIf Abs(currentForm.Top + currentForm.Height - otherForm.Top) <= 8 * Screen.TwipsPerPixelY Then - If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then - currentForm.Top = otherForm.Top - currentForm.Height + Screen.TwipsPerPixelY - snapForm = "snap" - End If - End If - 'snap right to right - If Abs(currentForm.left + currentForm.Width - otherForm.left - otherForm.Width) <= 8 * Screen.TwipsPerPixelX Then - If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then - currentForm.left = otherForm.left + otherForm.Width - currentForm.Width - snapForm = "snap" - End If - 'snap right to left - ElseIf Abs(currentForm.left + currentForm.Width - otherForm.left) <= 8 * Screen.TwipsPerPixelX Then - If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then - currentForm.left = otherForm.left - currentForm.Width + Screen.TwipsPerPixelX - snapForm = "snap" - End If - End If - - - 'snap top to top - If Abs(currentForm.Top - otherForm.Top) <= 8 * Screen.TwipsPerPixelY Then - If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then - currentForm.Top = otherForm.Top - snapForm = "snap" - End If - 'snap top to bottom - ElseIf Abs(currentForm.Top - otherForm.Top - otherForm.Height) <= 8 * Screen.TwipsPerPixelY Then - If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then - currentForm.Top = otherForm.Top + otherForm.Height - Screen.TwipsPerPixelY - snapForm = "snap" - End If - End If - 'snap left to left - If Abs(currentForm.left - otherForm.left) <= 8 * Screen.TwipsPerPixelX Then - If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then - currentForm.left = otherForm.left - snapForm = "snap" - End If - 'snap left to right - ElseIf Abs(currentForm.left - otherForm.left - otherForm.Width) <= 8 * Screen.TwipsPerPixelX Then - If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then - currentForm.left = otherForm.left + otherForm.Width - Screen.TwipsPerPixelX - snapForm = "snap" - End If - End If - -End Function - - -Public Function GetSoldatDir() As String - - On Error GoTo ErrorHandler - - 'HKEY_CLASSES_ROOT\Soldat\DefaultIcon - - Dim hKey As Long - Dim sKey As String - - sKey = "Soldat\DefaultIcon" - hKey = OpenRegKey(HKEY_CLASSES_ROOT, sKey) - - If hKey <> 0 Then - - GetSoldatDir = GetRegValue(hKey, "") - RegCloseKey hKey - - Else - 'HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Soldat_is1\Inno Setup: App Path - - sKey = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Soldat_is1" - hKey = OpenRegKey(HKEY_LOCAL_MACHINE, sKey) - - If hKey <> 0 Then - - GetSoldatDir = GetRegValue(hKey, "Inno Setup: App Path") - RegCloseKey hKey - - Else - If Dir("C:\Soldat", vbDirectory) = "" Then - MsgBox "Could not locate the Soldat directory." & vbNewLine & "Please configure the Soldat path, otherwise PolyWorks will not work properly." & vbNewLine & "See: Edit -> Preferences" - Else - GetSoldatDir = "C:\Soldat" - End If - - End If - - End If - - Exit Function - -ErrorHandler: - - MsgBox "Error getting soldat directory from registry" & vbNewLine & Error$ - -End Function - -Private Function OpenRegKey(ByVal hKey As Long, ByVal lpSubKey As String) As Long - - Dim hSubKey As Long - - If RegOpenKeyEx(hKey, lpSubKey, 0, KEY_READ, hSubKey) = 0 Then - - OpenRegKey = hSubKey - - End If - -End Function - -Private Function GetRegValue(hSubKey As Long, sKeyName As String) As String - - Dim lpValue As String 'name of the value to retrieve - Dim lpcbData As Long 'length of the retrieved value - Dim Result As Long - - 'if valid - If hSubKey <> 0 Then - - lpValue = Space$(260) - lpcbData = Len(lpValue) - - 'find the passed value if present - If RegQueryValueEx(hSubKey, sKeyName, 0&, 0&, ByVal lpValue, lpcbData) = 0 Then - - GetRegValue = left$(lpValue, lstrlenW(StrPtr(lpValue))) - - End If - - End If - -End Function - - -Public Function getFileDate(fileName As String) As Long - - On Error GoTo ErrorHandler - - Dim hFile As Long - - Dim OFS As OFSTRUCT - Dim FT_CREATE As FILETIME - Dim FT_ACCESS As FILETIME - Dim FT_WRITE As FILETIME - - Dim dosDate As Integer, dosTime As Integer - Dim timeString As String - Dim localFT As FILETIME - Dim sysTime As SYSTEMTIME - - hFile = OpenFile(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" + fileName, OFS, OF_READWRITE) - Call GetFileTime(hFile, FT_CREATE, FT_ACCESS, FT_WRITE) - Call CloseHandle(hFile) - - Call FileTimeToLocalFileTime(FT_WRITE, localFT) - FT_WRITE = localFT - Call FileTimeToDosDateTime(FT_WRITE, VarPtr(dosDate), VarPtr(dosTime)) - timeString = Hex$(dosTime) - If Len(timeString) < 4 Then - timeString = String$(4 - Len(timeString), "0") & timeString - End If - - getFileDate = CLng("&H" & Hex$(dosDate) & timeString) - - Exit Function - -ErrorHandler: - - MsgBox "get file date" & vbNewLine & Error$ - -End Function - -Public Sub saveSection(sectionName As String, sectionData As String, Optional fileName As String) - - Dim lReturn As Long - - If fileName = "" Then - fileName = appPath & "\polyworks.ini" - End If - - lReturn = WritePrivateProfileSection(sectionName, sectionData, fileName) - -End Sub - -Public Function loadString(section As String, Entry As String, Optional fileName As String, Optional length As Integer) As String - - Dim sString As String - Dim lSize As Long - Dim lReturn As Long - - If fileName = "" Then - fileName = appPath & "\polyworks.ini" - End If - - If length = 0 Then length = 10 - - sString = String$(length, "*") - lSize = Len(sString) - lReturn = GetPrivateProfileString(section, Entry, "", sString, lSize, fileName) - - loadString = left(sString, lReturn) - -End Function - -Public Function loadInt(section As String, Entry As String, Optional fileName As String) As Long - - Dim lReturn As Long - - If fileName = "" Then - fileName = appPath & "\polyworks.ini" - End If - - lReturn = GetPrivateProfileInt(section, Entry, -1, fileName) - - loadInt = lReturn - -End Function - -Public Function loadSection(section As String, ByRef lReturn As String, length As Integer, Optional fileName As String) As String - - If fileName = "" Then - fileName = appPath & "\polyworks.ini" - End If - - GetPrivateProfileSection section, lReturn, length, fileName - - loadSection = lReturn - -End Function - -Public Function RGBtoHex(DecValue As Long) As String - - Dim hexValue As String - - hexValue = Hex$(Val(DecValue)) - - If Len(hexValue) < 6 Then - hexValue = String$(6 - Len(hexValue), "0") + hexValue - End If - - RGBtoHex = hexValue - -End Function - -Public Function HexToLong(hexValue As String) As Long - - On Error GoTo ErrorHandler - - If Len(hexValue) > 8 Then - hexValue = right$(hexValue, 8) - End If - - HexToLong = CLng("&H" & hexValue) - - Exit Function - -ErrorHandler: - - HexToLong = -1 - -End Function - -Public Sub RunSoldat() - - frmSoldatMapEditor.picMinimize_MouseUp 1, 0, 0, 0 - - ShellExecute 0&, vbNullString, frmSoldatMapEditor.soldatDir & "Soldat.exe", "-start", vbNullString, vbNormalFocus - -End Sub - -Public Sub RunHelp() - - Dim iReturn As Long - - iReturn = ShellExecute(frmSoldatMapEditor.hWnd, "Open", appPath & "\PolyWorks Help.html", vbNullString, vbNullString, vbNormalFocus) 'SW_ShowNormal) - -End Sub - -Public Sub SetGameMode(fileName As String) - - Dim lReturn As Long - Dim gameMode As Integer - - If LCase(left(fileName, 4)) = "ctf_" Then - gameMode = 3 - ElseIf LCase(left(fileName, 4)) = "inf_" Then - gameMode = 5 - ElseIf LCase(left(fileName, 4)) = "htf_" Then - gameMode = 6 - Else - gameMode = 0 - End If - - lReturn = WritePrivateProfileString("GAME", "GameStyle", gameMode, frmSoldatMapEditor.soldatDir & "soldat.ini") - -End Sub - -Public Sub SetColors() - - frmSoldatMapEditor.picMenuBar.BackColor = bgClr - frmSoldatMapEditor.picStatus.BackColor = bgClr - frmPreferences.BackColor = bgClr - frmColor.BackColor = bgClr - frmDisplay.BackColor = bgClr - frmInfo.BackColor = bgClr - frmMap.BackColor = bgClr - - frmScenery.BackColor = bgClr - frmTools.BackColor = bgClr - frmWaypoints.BackColor = bgClr - -End Sub - -'Initialises GDI Plus -Public Function InitGDIPlus() As Long - Dim Token As Long - Dim gdipInit As GdiplusStartupInput - - gdipInit.GdiplusVersion = 1 - GdiplusStartup Token, gdipInit, ByVal 0& - InitGDIPlus = Token -End Function - -'Frees GDI Plus -Public Sub FreeGDIPlus(Token As Long) - GdiplusShutdown Token -End Sub - -'Loads the picture (optionally resized) -Public Function LoadPictureGDIPlus(PicFile As String, Optional Width As Long = -1, Optional Height As Long = -1, Optional ByVal BackColor As Long = vbWhite) As IPicture - - On Error GoTo ErrorHandler - - Dim hDC As Long - Dim hBitmap As Long - Dim Img As Long - Dim hBrush As Long - Dim Graphics As Long 'Graphics Object Pointer - - Dim IID_IDispatch As GUID - Dim pic As PICTDESC - Dim IPic As IPicture - - 'Load the image - If Len(Dir$(PicFile)) <> 0 Then - If GdipLoadImageFromFile(StrPtr(PicFile), Img) <> 0 Then - Exit Function - End If - End If - 'Calculate picture's width and height if not specified - If Width = -1 Or Height = -1 Then - GdipGetImageWidth Img, Width - GdipGetImageHeight Img, Height - End If - 'Initialise the hDC - 'Create a memory DC and select a bitmap into it, fill it in with the backcolor - hDC = CreateCompatibleDC(ByVal 0&) - hBitmap = CreateBitmap(Width, Height, GetDeviceCaps(hDC, PLANES), GetDeviceCaps(hDC, BITSPIXEL), ByVal 0&) - hBitmap = SelectObject(hDC, hBitmap) - hBrush = CreateSolidBrush(BackColor) - hBrush = SelectObject(hDC, hBrush) - PatBlt hDC, 0, 0, Width, Height, PATCOPY - DeleteObject SelectObject(hDC, hBrush) - 'Resize the picture - GdipCreateFromHDC hDC, Graphics - GdipDrawImageRectI Graphics, Img, 0, 0, Width, Height - GdipDeleteGraphics Graphics - GdipDisposeImage Img - 'Get the bitmap back - hBitmap = SelectObject(hDC, hBitmap) - DeleteDC hDC - 'Create the picture - 'Fill in OLE IDispatch Interface ID - IID_IDispatch.Data1 = &H20400 - IID_IDispatch.Data4(0) = &HC0 - IID_IDispatch.Data4(7) = &H46 - 'Fill Pic with necessary parts - pic.Size = Len(pic) 'Length of structure - pic.Type = PICTYPE_BITMAP 'Type of Picture (bitmap) - pic.hBmp = hBitmap 'Handle to bitmap - 'Create the picture - OleCreatePictureIndirect pic, IID_IDispatch, True, IPic - Set LoadPictureGDIPlus = IPic - - Exit Function - -ErrorHandler: - - MsgBox Error$ & vbNewLine & "Error loading picture" - -End Function +Attribute VB_Name = "modSME" +Option Explicit + +Global Const pi As Single = 3.14159265358979 'mmm... pi + +Global gfxDir As String + +Global appPath As String +Global bgClr As Long +Global lblBackClr As Long +Global lblTextClr As Long +Global txtBackClr As Long +Global txtTextClr As Long +Global frameClr As Long + +Global font1 As String, font2 As String + +Public Const BUTTON_WIDTH = 64 +Public Const BUTTON_HEIGHT = 24 + +Public Const MENU_WIDTH = 64 +Public Const MENU_HEIGHT = 16 + +Public Const BUTTON_SMALL = 0 +Public Const BUTTON_LARGE = 1 +Public Const BUTTON_MENU = 2 +Public Const BUTTON_TOOL = 3 + +Public Const BUTTON_X = 48 +Public Const BUTTON_Y = 0 + +Public Const MENU_X = 48 +Public Const MENU_Y = 96 + +Public Const BUTTON_UP = 0 +Public Const BUTTON_MOVE = 1 +Public Const BUTTON_DOWN = 2 + +'bitblt +Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, _ + ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _ + ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long +'stretchblit +Public Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, _ + ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _ + ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _ + ByVal dwRop As Long) As Long + +'mouse over +Public Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long +Public Declare Function GetCapture Lib "user32" () As Long +Public Declare Function ReleaseCapture Lib "user32" () As Long +'dragging window +Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ + (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long + +Public Const WM_NCLBUTTONDOWN = &HA1 + +'taskbar +Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _ + ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long +Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ + (ByVal lpClassName As String, ByVal lpWindowName As String) As Long +Public Const SWP_HIDEWINDOW = &H80 +Public Const SWP_SHOWWINDOW = &H40 + +Public Const SWP_NOSIZE = &H1 +Public Const SWP_NOMOVE = &H2 + +Public Const HWND_TOPMOST = -1 +Public Const HWND_NOTOPMOST = -2 + +'get pixel +Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long + +'browse +Private Type BROWSEINFO + hOwner As Long + pidlRoot As Long + pszDisplayName As String + lpszTitle As String + ulFlags As Long + lpfn As Long + lParam As Long + iImage As Long +End Type + +Private Const BIF_RETURNONLYFSDIRS = &H1 +Private Const BIF_DONTGOBELOWDOMAIN = &H2 +Private Const BIF_STATUSTEXT = &H4 +Private Const BIF_RETURNFSANCESTORS = &H8 +Private Const BIF_BROWSEFORCOMPUTER = &H1000 +Private Const BIF_BROWSEFORPRINTER = &H2000 +Private Const MAX_PATH = 260 + +Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" _ + (ByVal pidl As Long, ByVal pszPath As String) As Long + +Private Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" _ + (lpBrowseInfo As BROWSEINFO) As Long + +Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long) + + +'registry +Private Const HKEY_CLASSES_ROOT = &H80000000 +Private Const HKEY_LOCAL_MACHINE = &H80000002 + +Private Const STANDARD_RIGHTS_READ As Long = &H20000 +Private Const KEY_QUERY_VALUE As Long = &H1 +Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8 +Private Const KEY_NOTIFY As Long = &H10 +Private Const SYNCHRONIZE As Long = &H100000 + +Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _ + KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE)) + +Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _ + (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _ + ByVal samDesired As Long, phkResult As Long) As Long + +Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _ + (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _ + lpType As Long, lpData As Any, lpcbData As Long) As Long + +Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long + +Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long + + +'file time +Public Const OFS_MAXPATHNAME = 128 +Public Const OF_READWRITE = &H2 + +Public Type OFSTRUCT + cBytes As Byte + fFixedDisk As Byte + nErrCode As Integer + Reserved1 As Integer + Reserved2 As Integer + szPathName(0 To OFS_MAXPATHNAME - 1) As Byte '0-based +End Type + +Public Type FILETIME + dwLowDateTime As Long + dwHighDateTime As Long +End Type + +Public Type SYSTEMTIME + wYear As Integer + wMonth As Integer + wDayOfWeek As Integer + wDay As Integer + wHour As Integer + wMinute As Integer + wSecond As Integer + wMilliseconds As Integer +End Type + + +Public Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, _ + lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long + +Public Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, _ + lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long + +Public Declare Function CloseHandle Lib "kernel32" (ByVal hFile As Long) As Long + +Public Declare Function FileTimeToDosDateTime Lib "kernel32" (lpFileTime As FILETIME, _ + ByVal lpFatDate As Long, ByVal lpFatTime As Long) As Long + +Public Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, _ + lpLocalFileTime As FILETIME) As Long + +Public Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long + +'ini file +Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" _ + (ByVal sSectionName As String, ByVal sKeyName As String, _ + ByVal lDefault As Long, ByVal sFileName As String) As Long + +Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" _ + (ByVal sSectionName As String, ByVal sReturnedString As String, _ + ByVal lSize As Long, ByVal sFileName As String) As Long + +Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _ + (ByVal sSectionName As String, ByVal sKeyName As String, ByVal sDefault As String, _ + ByVal sReturnedString As String, ByVal lSize As Long, ByVal sFileName As String) As Long + +Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" _ + (ByVal sSectionName As String, ByVal sString As String, ByVal sFileName As String) As Long + +Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _ + (ByVal sSectionName As String, ByVal sKeyName As String, _ + ByVal sString As String, ByVal sFileName As String) As Long + +'ShellExecute +Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, _ + ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _ + ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long + +'key mapping +Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" _ + (ByVal wCode As Long, ByVal wMapType As Long) As Long + +'gdi+ +Private Type GUID + Data1 As Long + Data2 As Integer + Data3 As Integer + Data4(7) As Byte +End Type + +Private Type PICTDESC + Size As Long + Type As Long + hBmp As Long + hpal As Long + Reserved As Long +End Type + +Private Type GdiplusStartupInput + GdiplusVersion As Long + DebugEventCallback As Long + SuppressBackgroundThread As Long + SuppressExternalCodecs As Long +End Type + +Private Type ImageCodecInfo + Clsid As GUID + FormatID As GUID + CodecNamePtr As Long + DllNamePtr As Long + FormatDescriptionPtr As Long + FilenameExtensionPtr As Long + MimeTypePtr As Long + Flags As Long + Version As Long + SigCount As Long + SigSize As Long + SigPatternPtr As Long + SigMaskPtr As Long +End Type + +'GDI Functions +Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long +Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long +Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long +Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long +Private Declare Function PatBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long +Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long +Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long +Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long +Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long +Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long + +'GDI+ functions +Private Declare Function GdipLoadImageFromFile Lib "gdiplus.dll" (ByVal fileName As Long, GpImage As Long) As Long +Private Declare Function GdiplusStartup Lib "gdiplus.dll" (Token As Long, gdipInput As GdiplusStartupInput, GdiplusStartupOutput As Long) As Long +Private Declare Function GdipCreateFromHDC Lib "gdiplus.dll" (ByVal hDC As Long, GpGraphics As Long) As Long +Private Declare Function GdipDrawImageRectI Lib "gdiplus.dll" (ByVal Graphics As Long, ByVal Img As Long, ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long) As Long +Private Declare Function GdipDeleteGraphics Lib "gdiplus.dll" (ByVal Graphics As Long) As Long +Private Declare Function GdipDisposeImage Lib "gdiplus.dll" (ByVal image As Long) As Long +Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus.dll" (ByVal hBmp As Long, ByVal hpal As Long, GpBitmap As Long) As Long +Private Declare Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal image As Long, Width As Long) As Long +Private Declare Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal image As Long, Height As Long) As Long +Private Declare Sub GdiplusShutdown Lib "gdiplus.dll" (ByVal Token As Long) + +'functions for gif loading +Private Declare Function GdipSaveImageToFile Lib "gdiplus.dll" (ByVal image As Long, ByVal fileName As Long, ByRef clsidEncoder As GUID, ByRef encoderParams As Any) As Long +Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus.dll" (ByVal fileName As Long, ByRef Bitmap As Long) As Long +Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus.dll" (ByVal Bitmap As Long, ByRef hbmReturn As Long, ByVal background As Long) As Long +Private Declare Function GdipGetImageEncodersSize Lib "gdiplus.dll" (ByRef numEncoders As Long, ByRef Size As Long) As Long +Private Declare Function GdipGetImageEncoders Lib "gdiplus.dll" (ByVal numEncoders As Long, ByVal Size As Long, ByRef Encoders As Any) As Long +Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long + + +'GDI and GDI+ constants +Private Const PLANES = 14 'Number of planes +Private Const BITSPIXEL = 12 'Number of bits per pixel +Private Const PATCOPY = &HF00021 '(DWORD) dest = pattern +Private Const PICTYPE_BITMAP = 1 'Bitmap type +Private Const InterpolationModeHighQualityBicubic = 7 +Private Const GDIP_WMF_PLACEABLEKEY = &H9AC6CDD7 +Private Const UnitPixel = 2 + +Public Sub SelectAllText(tb As TextBox) + + tb.SelStart = 0 + tb.SelLength = Len(tb.Text) + +End Sub + +Private Function GetEncoderClsid(mimeType As String, pClsid As GUID) As Boolean + + Dim num As Long + Dim Size As Long + Dim pImageCodecInfo() As ImageCodecInfo + Dim j As Long + Dim buffer As String + + Call GdipGetImageEncodersSize(num, Size) + If (Size = 0) Then + GetEncoderClsid = False + Exit Function + End If + + ReDim pImageCodecInfo(0 To Size \ Len(pImageCodecInfo(0)) - 1) + + Call GdipGetImageEncoders(num, Size, pImageCodecInfo(0)) + + For j = 0 To num - 1 + + buffer = Space$(lstrlenW(ByVal pImageCodecInfo(j).MimeTypePtr)) + + Call lstrcpyW(ByVal StrPtr(buffer), _ + ByVal pImageCodecInfo(j).MimeTypePtr) + + If (StrComp(buffer, mimeType, vbTextCompare) = 0) Then + pClsid = pImageCodecInfo(j).Clsid + Erase pImageCodecInfo + + GetEncoderClsid = True + Exit Function + End If + Next j + + Erase pImageCodecInfo + + GetEncoderClsid = False +End Function + +Private Function SaveImageAsPNG(ByVal sFileName As String, ByVal sDestFileName As String) As Boolean + + Dim lBitmap As Long + Dim hBitmap As Long + Dim Results As Long + Dim tPicEncoder As GUID + + If GdipCreateBitmapFromFile(StrPtr(sFileName), lBitmap) = 0 Then + If GdipCreateHBITMAPFromBitmap(lBitmap, hBitmap, 0) = 0 Then + If GetEncoderClsid("image/png", tPicEncoder) Then + SaveImageAsPNG = (GdipSaveImageToFile(lBitmap, StrPtr(sDestFileName), tPicEncoder, ByVal 0) = 0) + Else + SaveImageAsPNG = False + End If + GdipDisposeImage lBitmap + End If + End If + +End Function + +Public Function GifToPng(ByVal src As String, ByVal dest As String) As Long + + Dim Token As Long + + Token = InitGDIPlus + + If SaveImageAsPNG(src, dest) Then + GifToPng = -1 + Else + GifToPng = 5 + End If + + FreeGDIPlus Token + +End Function + +Public Function GifToBmp(ByVal src As String, ByVal dest As String) As Long + + GifToBmp = GifToPng(src, dest) + +End Function + +'mouse event +Public Function mouseEvent(ByRef pic As PictureBox, ByVal xVal As Integer, ByVal yVal As Integer, xSrc As Integer, ySrc As Integer, Width As Integer, Height As Integer) As Boolean + + If (xVal < 0) Or (xVal > Width) Or (yVal < 0) Or (yVal > Height) Then 'the MOUSELEAVE pseudo-event + ReleaseCapture + BitBlt pic.hDC, 0, 0, Width, Height, frmSoldatMapEditor.picGfx.hDC, xSrc, ySrc, vbSrcCopy + pic.Refresh + mouseEvent = True + ElseIf GetCapture() <> pic.hWnd Then 'the MOUSEENTER pseudo-event + SetCapture pic.hWnd + BitBlt pic.hDC, 0, 0, Width, Height, frmSoldatMapEditor.picGfx.hDC, xSrc + Width, ySrc, vbSrcCopy + pic.Refresh + mouseEvent = True + End If + +End Function + +'mouse event +Public Function mouseEvent2(ByRef pic As PictureBox, ByVal xVal As Integer, ByVal yVal As Integer, ByVal buttonType As Byte, ByVal active As Byte, ByVal action As Byte, Optional exWidth As Integer) As Boolean + + Dim xSrc As Integer, ySrc As Integer + Dim Width As Integer, Height As Integer + + On Error GoTo ErrorHandler + + If buttonType = BUTTON_SMALL Then + Width = 16 + Height = 16 + xSrc = 0 + ySrc = Int(pic.Tag) * Height + ElseIf buttonType = BUTTON_LARGE Then + Width = BUTTON_WIDTH + Height = BUTTON_HEIGHT + xSrc = BUTTON_X + ySrc = BUTTON_Y + Int(pic.Tag) * Height + ElseIf buttonType = BUTTON_MENU Then + Width = MENU_WIDTH + Height = MENU_HEIGHT + xSrc = MENU_X + ySrc = MENU_Y + Int(pic.Index) * Height + End If + + active = active / 255 + + If exWidth = 0 Then exWidth = Width + + If action = BUTTON_UP Or action = BUTTON_DOWN Then + mouseEvent2 = True + ElseIf (xVal < 0) Or (xVal > exWidth) Or (yVal < 0) Or (yVal > Height) Then 'the MOUSELEAVE pseudo-event + ReleaseCapture + mouseEvent2 = True + action = BUTTON_UP + ElseIf GetCapture() <> pic.hWnd Then 'the MOUSEENTER pseudo-event + SetCapture pic.hWnd + mouseEvent2 = True + action = BUTTON_MOVE + End If + + If mouseEvent2 = True Then + BitBlt pic.hDC, 0, 0, Width, Height, frmSoldatMapEditor.picButtonGfx.hDC, xSrc + Width * action, ySrc + active * Height, vbSrcCopy + pic.Refresh + End If + + Exit Function + +ErrorHandler: + + MsgBox Error$ + +End Function + + +'browse +Public Function SelectFolder(ownerForm As Form) As String + + Dim bi As BROWSEINFO + Dim pidl As Long + Dim path As String + Dim pos As Long + + With bi + .hOwner = ownerForm.hWnd + .pidlRoot = 0& + .ulFlags = BIF_RETURNONLYFSDIRS + End With + + pidl = SHBrowseForFolder(bi) + path = Space$(MAX_PATH) + + If SHGetPathFromIDList(ByVal pidl, ByVal path) Then + pos = InStr(path, Chr$(0)) + SelectFolder = LCase$(left(path, pos - 1)) + End If + + Call CoTaskMemFree(pidl) + +End Function + + + +Public Function snapForm(currentForm As Form, otherForm As Form) As String + + snapForm = "" + + 'snap bottom to bottom + If Abs(currentForm.Top + currentForm.Height - otherForm.Top - otherForm.Height) <= 8 * Screen.TwipsPerPixelY Then + If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then + currentForm.Top = otherForm.Top + otherForm.Height - currentForm.Height + snapForm = "snap" + End If + 'snap bottom to top + ElseIf Abs(currentForm.Top + currentForm.Height - otherForm.Top) <= 8 * Screen.TwipsPerPixelY Then + If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then + currentForm.Top = otherForm.Top - currentForm.Height + Screen.TwipsPerPixelY + snapForm = "snap" + End If + End If + 'snap right to right + If Abs(currentForm.left + currentForm.Width - otherForm.left - otherForm.Width) <= 8 * Screen.TwipsPerPixelX Then + If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then + currentForm.left = otherForm.left + otherForm.Width - currentForm.Width + snapForm = "snap" + End If + 'snap right to left + ElseIf Abs(currentForm.left + currentForm.Width - otherForm.left) <= 8 * Screen.TwipsPerPixelX Then + If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then + currentForm.left = otherForm.left - currentForm.Width + Screen.TwipsPerPixelX + snapForm = "snap" + End If + End If + + + 'snap top to top + If Abs(currentForm.Top - otherForm.Top) <= 8 * Screen.TwipsPerPixelY Then + If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then + currentForm.Top = otherForm.Top + snapForm = "snap" + End If + 'snap top to bottom + ElseIf Abs(currentForm.Top - otherForm.Top - otherForm.Height) <= 8 * Screen.TwipsPerPixelY Then + If (currentForm.left + currentForm.Width + 8 * Screen.TwipsPerPixelX) >= otherForm.left And currentForm.left <= (otherForm.left + otherForm.Width + 8 * Screen.TwipsPerPixelX) Then + currentForm.Top = otherForm.Top + otherForm.Height - Screen.TwipsPerPixelY + snapForm = "snap" + End If + End If + 'snap left to left + If Abs(currentForm.left - otherForm.left) <= 8 * Screen.TwipsPerPixelX Then + If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then + currentForm.left = otherForm.left + snapForm = "snap" + End If + 'snap left to right + ElseIf Abs(currentForm.left - otherForm.left - otherForm.Width) <= 8 * Screen.TwipsPerPixelX Then + If (currentForm.Top + currentForm.Height + 8 * Screen.TwipsPerPixelY) >= otherForm.Top And currentForm.Top <= (otherForm.Top + otherForm.Height + 8 * Screen.TwipsPerPixelY) Then + currentForm.left = otherForm.left + otherForm.Width - Screen.TwipsPerPixelX + snapForm = "snap" + End If + End If + +End Function + + +Public Function GetSoldatDir() As String + + On Error GoTo ErrorHandler + + 'HKEY_CLASSES_ROOT\Soldat\DefaultIcon + + Dim hKey As Long + Dim sKey As String + + sKey = "Soldat\DefaultIcon" + hKey = OpenRegKey(HKEY_CLASSES_ROOT, sKey) + + If hKey <> 0 Then + + GetSoldatDir = GetRegValue(hKey, "") + RegCloseKey hKey + + Else + 'HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Soldat_is1\Inno Setup: App Path + + sKey = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Soldat_is1" + hKey = OpenRegKey(HKEY_LOCAL_MACHINE, sKey) + + If hKey <> 0 Then + + GetSoldatDir = GetRegValue(hKey, "Inno Setup: App Path") + RegCloseKey hKey + + Else + If Dir("C:\Soldat", vbDirectory) = "" Then + MsgBox "Could not locate the Soldat directory." & vbNewLine & "Please configure the Soldat path, otherwise PolyWorks will not work properly." & vbNewLine & "See: Edit -> Preferences" + Else + GetSoldatDir = "C:\Soldat" + End If + + End If + + End If + + Exit Function + +ErrorHandler: + + MsgBox "Error getting soldat directory from registry" & vbNewLine & Error$ + +End Function + +Private Function OpenRegKey(ByVal hKey As Long, ByVal lpSubKey As String) As Long + + Dim hSubKey As Long + + If RegOpenKeyEx(hKey, lpSubKey, 0, KEY_READ, hSubKey) = 0 Then + + OpenRegKey = hSubKey + + End If + +End Function + +Private Function GetRegValue(hSubKey As Long, sKeyName As String) As String + + Dim lpValue As String 'name of the value to retrieve + Dim lpcbData As Long 'length of the retrieved value + Dim Result As Long + + 'if valid + If hSubKey <> 0 Then + + lpValue = Space$(260) + lpcbData = Len(lpValue) + + 'find the passed value if present + If RegQueryValueEx(hSubKey, sKeyName, 0&, 0&, ByVal lpValue, lpcbData) = 0 Then + + GetRegValue = left$(lpValue, lstrlenW(StrPtr(lpValue))) + + End If + + End If + +End Function + + +Public Function getFileDate(fileName As String) As Long + + On Error GoTo ErrorHandler + + Dim hFile As Long + + Dim OFS As OFSTRUCT + Dim FT_CREATE As FILETIME + Dim FT_ACCESS As FILETIME + Dim FT_WRITE As FILETIME + + Dim dosDate As Integer, dosTime As Integer + Dim timeString As String + Dim localFT As FILETIME + Dim sysTime As SYSTEMTIME + + hFile = OpenFile(frmSoldatMapEditor.soldatDir & "Scenery-gfx\" + fileName, OFS, OF_READWRITE) + Call GetFileTime(hFile, FT_CREATE, FT_ACCESS, FT_WRITE) + Call CloseHandle(hFile) + + Call FileTimeToLocalFileTime(FT_WRITE, localFT) + FT_WRITE = localFT + Call FileTimeToDosDateTime(FT_WRITE, VarPtr(dosDate), VarPtr(dosTime)) + timeString = Hex$(dosTime) + If Len(timeString) < 4 Then + timeString = String$(4 - Len(timeString), "0") & timeString + End If + + getFileDate = CLng("&H" & Hex$(dosDate) & timeString) + + Exit Function + +ErrorHandler: + + MsgBox "get file date" & vbNewLine & Error$ + +End Function + +Public Sub saveSection(sectionName As String, sectionData As String, Optional fileName As String) + + Dim lReturn As Long + + If fileName = "" Then + fileName = appPath & "\polyworks.ini" + End If + + lReturn = WritePrivateProfileSection(sectionName, sectionData, fileName) + +End Sub + +Public Function loadString(section As String, Entry As String, Optional fileName As String, Optional length As Integer) As String + + Dim sString As String + Dim lSize As Long + Dim lReturn As Long + + If fileName = "" Then + fileName = appPath & "\polyworks.ini" + End If + + If length = 0 Then length = 10 + + sString = String$(length, "*") + lSize = Len(sString) + lReturn = GetPrivateProfileString(section, Entry, "", sString, lSize, fileName) + + loadString = left(sString, lReturn) + +End Function + +Public Function loadInt(section As String, Entry As String, Optional fileName As String) As Long + + Dim lReturn As Long + + If fileName = "" Then + fileName = appPath & "\polyworks.ini" + End If + + lReturn = GetPrivateProfileInt(section, Entry, -1, fileName) + + loadInt = lReturn + +End Function + +Public Function loadSection(section As String, ByRef lReturn As String, length As Integer, Optional fileName As String) As String + + If fileName = "" Then + fileName = appPath & "\polyworks.ini" + End If + + GetPrivateProfileSection section, lReturn, length, fileName + + loadSection = lReturn + +End Function + +Public Function RGBtoHex(DecValue As Long) As String + + Dim hexValue As String + + hexValue = Hex$(Val(DecValue)) + + If Len(hexValue) < 6 Then + hexValue = String$(6 - Len(hexValue), "0") + hexValue + End If + + RGBtoHex = hexValue + +End Function + +Public Function HexToLong(hexValue As String) As Long + + On Error GoTo ErrorHandler + + If Len(hexValue) > 8 Then + hexValue = right$(hexValue, 8) + End If + + HexToLong = CLng("&H" & hexValue) + + Exit Function + +ErrorHandler: + + HexToLong = -1 + +End Function + +Public Sub RunSoldat() + + frmSoldatMapEditor.picMinimize_MouseUp 1, 0, 0, 0 + + ShellExecute 0&, vbNullString, frmSoldatMapEditor.soldatDir & "Soldat.exe", "-start", vbNullString, vbNormalFocus + +End Sub + +Public Sub RunHelp() + + Dim iReturn As Long + + iReturn = ShellExecute(frmSoldatMapEditor.hWnd, "Open", appPath & "\PolyWorks Help.html", vbNullString, vbNullString, vbNormalFocus) 'SW_ShowNormal) + +End Sub + +Public Sub SetGameMode(fileName As String) + + Dim lReturn As Long + Dim gameMode As Integer + + If LCase(left(fileName, 4)) = "ctf_" Then + gameMode = 3 + ElseIf LCase(left(fileName, 4)) = "inf_" Then + gameMode = 5 + ElseIf LCase(left(fileName, 4)) = "htf_" Then + gameMode = 6 + Else + gameMode = 0 + End If + + lReturn = WritePrivateProfileString("GAME", "GameStyle", gameMode, frmSoldatMapEditor.soldatDir & "soldat.ini") + +End Sub + +Public Sub SetColors() + + frmSoldatMapEditor.picMenuBar.BackColor = bgClr + frmSoldatMapEditor.picStatus.BackColor = bgClr + frmPreferences.BackColor = bgClr + frmColor.BackColor = bgClr + frmDisplay.BackColor = bgClr + frmInfo.BackColor = bgClr + frmMap.BackColor = bgClr + + frmScenery.BackColor = bgClr + frmTools.BackColor = bgClr + frmWaypoints.BackColor = bgClr + +End Sub + +'Initialises GDI Plus +Public Function InitGDIPlus() As Long + Dim Token As Long + Dim gdipInit As GdiplusStartupInput + + gdipInit.GdiplusVersion = 1 + GdiplusStartup Token, gdipInit, ByVal 0& + InitGDIPlus = Token +End Function + +'Frees GDI Plus +Public Sub FreeGDIPlus(Token As Long) + GdiplusShutdown Token +End Sub + +'Loads the picture (optionally resized) +Public Function LoadPictureGDIPlus(PicFile As String, Optional Width As Long = -1, Optional Height As Long = -1, Optional ByVal BackColor As Long = vbWhite) As IPicture + + On Error GoTo ErrorHandler + + Dim hDC As Long + Dim hBitmap As Long + Dim Img As Long + Dim hBrush As Long + Dim Graphics As Long 'Graphics Object Pointer + + Dim IID_IDispatch As GUID + Dim pic As PICTDESC + Dim IPic As IPicture + + 'Load the image + If Len(Dir$(PicFile)) <> 0 Then + If GdipLoadImageFromFile(StrPtr(PicFile), Img) <> 0 Then + Exit Function + End If + End If + 'Calculate picture's width and height if not specified + If Width = -1 Or Height = -1 Then + GdipGetImageWidth Img, Width + GdipGetImageHeight Img, Height + End If + 'Initialise the hDC + 'Create a memory DC and select a bitmap into it, fill it in with the backcolor + hDC = CreateCompatibleDC(ByVal 0&) + hBitmap = CreateBitmap(Width, Height, GetDeviceCaps(hDC, PLANES), GetDeviceCaps(hDC, BITSPIXEL), ByVal 0&) + hBitmap = SelectObject(hDC, hBitmap) + hBrush = CreateSolidBrush(BackColor) + hBrush = SelectObject(hDC, hBrush) + PatBlt hDC, 0, 0, Width, Height, PATCOPY + DeleteObject SelectObject(hDC, hBrush) + 'Resize the picture + GdipCreateFromHDC hDC, Graphics + GdipDrawImageRectI Graphics, Img, 0, 0, Width, Height + GdipDeleteGraphics Graphics + GdipDisposeImage Img + 'Get the bitmap back + hBitmap = SelectObject(hDC, hBitmap) + DeleteDC hDC + 'Create the picture + 'Fill in OLE IDispatch Interface ID + IID_IDispatch.Data1 = &H20400 + IID_IDispatch.Data4(0) = &HC0 + IID_IDispatch.Data4(7) = &H46 + 'Fill Pic with necessary parts + pic.Size = Len(pic) 'Length of structure + pic.Type = PICTYPE_BITMAP 'Type of Picture (bitmap) + pic.hBmp = hBitmap 'Handle to bitmap + 'Create the picture + OleCreatePictureIndirect pic, IID_IDispatch, True, IPic + Set LoadPictureGDIPlus = IPic + + Exit Function + +ErrorHandler: + + MsgBox Error$ & vbNewLine & "Error loading picture" + +End Function diff --git a/prjSoldatMapEditor.vbp b/prjSoldatMapEditor.vbp index e76063e..3036fa8 100644 --- a/prjSoldatMapEditor.vbp +++ b/prjSoldatMapEditor.vbp @@ -1,56 +1,56 @@ -Type=Exe -Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation -Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#C:\Windows\SysWow64\dx8vb.dll#DirectX 8 for Visual Basic Type Library -Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\Windows\SysWOW64\scrrun.dll#Microsoft Scripting Runtime -Object={DDA53BD0-2CD0-11D4-8ED4-00E07D815373}#1.0#0; MBMouse.ocx -Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX -Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx -Form=frmSoldatMapEditor.frm -Form=frmPreferences.frm -Form=frmTools.frm -Form=frmPalette.frm -Form=frmDisplay.frm -Module=modSME; modSME.bas -Form=frmMap.frm -Form=frmColor.frm -Form=frmTaskBar.frm -Form=frmScenery.frm -Form=frmInfo.frm -Form=frmWaypoints.frm -Form=frmTexture.frm -IconForm="frmSoldatMapEditor" -Startup="frmSoldatMapEditor" -HelpFile="" -Title="Soldat PolyWorks" -ExeName32="Soldat PolyWorks.exe" -Path32="pwinstall" -Command32="" -Name="PolyWorks" -HelpContextID="0" -CompatibleMode="0" -MajorVer=1 -MinorVer=5 -RevisionVer=13 -AutoIncrementVer=0 -ServerSupportFiles=0 -VersionComments="Created by Anna Zajaczkowski, updated by Jacob L. (Fryer)." -VersionCompanyName="Anna Zajaczkowski" -CompilationType=0 -OptimizationType=0 -FavorPentiumPro(tm)=0 -CodeViewDebugInfo=0 -NoAliasing=0 -BoundsCheck=0 -OverflowCheck=0 -FlPointCheck=0 -FDIVCheck=0 -UnroundedFP=0 -StartMode=0 -Unattended=0 -Retained=0 -ThreadPerObject=0 -MaxNumberOfThreads=1 -DebugStartupOption=0 - -[MS Transaction Server] -AutoRefresh=1 +Type=Exe +Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation +Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#C:\Windows\SysWow64\dx8vb.dll#DirectX 8 for Visual Basic Type Library +Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\Windows\SysWOW64\scrrun.dll#Microsoft Scripting Runtime +Object={DDA53BD0-2CD0-11D4-8ED4-00E07D815373}#1.0#0; MBMouse.ocx +Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX +Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx +Form=frmSoldatMapEditor.frm +Form=frmPreferences.frm +Form=frmTools.frm +Form=frmPalette.frm +Form=frmDisplay.frm +Module=modSME; modSME.bas +Form=frmMap.frm +Form=frmColor.frm +Form=frmTaskBar.frm +Form=frmScenery.frm +Form=frmInfo.frm +Form=frmWaypoints.frm +Form=frmTexture.frm +IconForm="frmSoldatMapEditor" +Startup="frmSoldatMapEditor" +HelpFile="" +Title="Soldat PolyWorks" +ExeName32="Soldat PolyWorks.exe" +Path32="pwinstall" +Command32="" +Name="PolyWorks" +HelpContextID="0" +CompatibleMode="0" +MajorVer=1 +MinorVer=5 +RevisionVer=13 +AutoIncrementVer=0 +ServerSupportFiles=0 +VersionComments="Created by Anna Zajaczkowski, updated by Jacob L. (Fryer)." +VersionCompanyName="Anna Zajaczkowski" +CompilationType=0 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 +DebugStartupOption=0 + +[MS Transaction Server] +AutoRefresh=1 From e8ac681a67793de872c2f03e3fcb85382a02c6ee Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 21 Jan 2021 23:45:56 +0100 Subject: [PATCH 35/57] Fix skipping detailed warning for invalid soldat directory setting/registry key --- modSME.bas | 34 ++++++++++++++++++++++++---------- 1 file changed, 24 insertions(+), 10 deletions(-) diff --git a/modSME.bas b/modSME.bas index 142b896..6d146bc 100644 --- a/modSME.bas +++ b/modSME.bas @@ -550,29 +550,32 @@ Public Function GetSoldatDir() As String GetSoldatDir = GetRegValue(hKey, "") RegCloseKey hKey - + Else 'HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Soldat_is1\Inno Setup: App Path sKey = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Soldat_is1" hKey = OpenRegKey(HKEY_LOCAL_MACHINE, sKey) - + If hKey <> 0 Then - + GetSoldatDir = GetRegValue(hKey, "Inno Setup: App Path") RegCloseKey hKey - + Else - If Dir("C:\Soldat", vbDirectory) = "" Then - MsgBox "Could not locate the Soldat directory." & vbNewLine & "Please configure the Soldat path, otherwise PolyWorks will not work properly." & vbNewLine & "See: Edit -> Preferences" - Else - GetSoldatDir = "C:\Soldat" - End If - + + GetSoldatDir = "C:\Soldat" + End If End If + If Not DirExists(GetSoldatDir) Then + + MsgBox "Could not locate the Soldat directory. (" & GetSoldatDir & ")" & vbNewLine & "Please configure the Soldat path, otherwise PolyWorks will not work properly." & vbNewLine & "See: Edit -> Preferences" + + End If + Exit Function ErrorHandler: @@ -581,6 +584,17 @@ ErrorHandler: End Function + +Private Function DirExists(DirName As String) As Boolean + + On Error GoTo ErrorHandler + DirExists = GetAttr(DirName) And vbDirectory + +ErrorHandler: + +End Function + + Private Function OpenRegKey(ByVal hKey As Long, ByVal lpSubKey As String) As Long Dim hSubKey As Long From 0a8acc324db24c71d53e1c3a4b28832dd4d175c6 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sun, 24 Jan 2021 18:07:04 +0100 Subject: [PATCH 36/57] Fix variable casing changes in vb6 --- frmSoldatMapEditor.frm | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 603bb77..e33a635 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -1257,6 +1257,11 @@ Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit +' Fix vb6 ide casing changes +#If False Then + Dim FileName, color, token, b +#End If + Dim DX As DirectX8 Dim D3D As Direct3D8 Dim D3DDevice As Direct3DDevice8 From 5908a03df539a656b26f7a0b00302eca611daebc Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Sun, 24 Jan 2021 18:20:13 +0100 Subject: [PATCH 37/57] Modify let vb6 change casing --- frmSoldatMapEditor.frm | 266 ++++++++++++++++++++--------------------- 1 file changed, 133 insertions(+), 133 deletions(-) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index e33a635..0b2e0ba 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -1339,7 +1339,7 @@ Private Type TCustomVertex Y As Single z As Single rhw As Single - Color As Long + color As Long tu As Single tv As Single End Type @@ -1378,7 +1378,7 @@ Private Type TProp ScaleX As Single ScaleY As Single alpha As Long - Color As Long + color As Long level As Long End Type @@ -1388,7 +1388,7 @@ Private Type TScenery rotation As Single Scaling As D3DVECTOR2 alpha As Byte - Color As Long + color As Long level As Byte selected As Byte screenTr As D3DVECTOR2 @@ -2406,7 +2406,7 @@ Public Sub LoadFile(FileName As String) For j = 1 To 3 PolyCoords(i).vertex(j).X = Polys(i).vertex(j).X PolyCoords(i).vertex(j).Y = Polys(i).vertex(j).Y - vertexList(i).color(j) = getRGB(Polys(i).vertex(j).Color) + vertexList(i).color(j) = getRGB(Polys(i).vertex(j).color) If PolyCoords(i).vertex(j).X > maxX Then maxX = PolyCoords(i).vertex(j).X If PolyCoords(i).vertex(j).X < minX Then minX = PolyCoords(i).vertex(j).X If PolyCoords(i).vertex(j).Y > maxY Then maxY = PolyCoords(i).vertex(j).Y @@ -2465,13 +2465,13 @@ Public Sub LoadFile(FileName As String) Else Scenery(i - offset).alpha = 255 End If - Scenery(i - offset).Color = Prop.Color + Scenery(i - offset).color = Prop.color If Prop.level <= 255 And Prop.level >= 0 Then Scenery(i - offset).level = Prop.level Else Scenery(i - offset).level = 0 End If - Scenery(i - offset).Color = ARGB(Scenery(i - offset).alpha, Scenery(i - offset).Color) + Scenery(i - offset).color = ARGB(Scenery(i - offset).alpha, Scenery(i - offset).color) End If Next @@ -2850,7 +2850,7 @@ Public Sub setCurrentScenery(Optional styleVal As Integer = -1, Optional scenery End If Scenery(0).alpha = opacity * 255 - Scenery(0).Color = ARGB(opacity * 255, RGB(polyClr.blue, polyClr.green, polyClr.red)) + Scenery(0).color = ARGB(opacity * 255, RGB(polyClr.blue, polyClr.green, polyClr.red)) Scenery(0).level = frmScenery.level Scenery(0).Scaling.X = 1 Scenery(0).Scaling.Y = 1 @@ -3090,7 +3090,7 @@ Private Sub SaveFile(FileName As String) Polygon.Poly.vertex(j).X = PolyCoords(i).vertex(j).X Polygon.Poly.vertex(j).Y = PolyCoords(i).vertex(j).Y - Polygon.Poly.vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) + Polygon.Poly.vertex(j).color = ARGB(getAlpha(Polys(i).vertex(j).color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) VertNum = j + 1 If VertNum > 3 Then VertNum = 1 @@ -3128,8 +3128,8 @@ Private Sub SaveFile(FileName As String) For i = 1 To sceneryCount Prop.active = True Prop.alpha = Scenery(i).alpha - tempClr = getRGB(Scenery(i).Color) - Prop.Color = ARGB(255, RGB(tempClr.blue, tempClr.green, tempClr.red)) + tempClr = getRGB(Scenery(i).color) + Prop.color = ARGB(255, RGB(tempClr.blue, tempClr.green, tempClr.red)) Prop.Width = SceneryTextures(Scenery(i).Style).Width Prop.Height = SceneryTextures(Scenery(i).Style).Height Prop.level = Scenery(i).level @@ -3427,8 +3427,8 @@ Public Sub SaveAndCompile(FileName As String) For i = 1 To sceneryCount Prop.active = True Prop.alpha = Scenery(i).alpha - tempClr = getRGB(Scenery(i).Color) - Prop.Color = ARGB(255, RGB(tempClr.blue, tempClr.green, tempClr.red)) + tempClr = getRGB(Scenery(i).color) + Prop.color = ARGB(255, RGB(tempClr.blue, tempClr.green, tempClr.red)) Prop.Width = SceneryTextures(Scenery(i).Style).Width Prop.Height = SceneryTextures(Scenery(i).Style).Height Prop.level = Scenery(i).level @@ -4139,14 +4139,14 @@ Private Sub setGrid() End Sub -Private Function CreateCustomVertex(ByVal X As Single, ByVal Y As Single, z As Single, rhw As Single, Color As Long, _ +Private Function CreateCustomVertex(ByVal X As Single, ByVal Y As Single, z As Single, rhw As Single, color As Long, _ tu As Single, tv As Single) As TCustomVertex CreateCustomVertex.X = X CreateCustomVertex.Y = Y CreateCustomVertex.z = z CreateCustomVertex.rhw = rhw - CreateCustomVertex.Color = Color + CreateCustomVertex.color = color CreateCustomVertex.tu = tu CreateCustomVertex.tv = tv @@ -4321,7 +4321,7 @@ Public Sub Render() End If srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y - scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).Color + scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).color End If Next End If @@ -4357,7 +4357,7 @@ Public Sub Render() End If srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y - scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).Color + scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).color End If Next End If @@ -4369,7 +4369,7 @@ Public Sub Render() sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(0).Scaling.Y * zoomFactor srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y - scenerySprite.Draw SceneryTextures(sVal).Texture, srcRect, sc, rc, Scenery(0).rotation, Scenery(0).screenTr, Scenery(0).Color + scenerySprite.Draw SceneryTextures(sVal).Texture, srcRect, sc, rc, Scenery(0).rotation, Scenery(0).screenTr, Scenery(0).color End If End If @@ -4435,9 +4435,9 @@ Public Sub Render() lineCoords(3).tu = Polys(selectedPolys(i)).vertex(3).X / 128 lineCoords(3).tv = Polys(selectedPolys(i)).vertex(3).Y / 128 - lineCoords(1).Color = 0 - lineCoords(2).Color = 0 - lineCoords(3).Color = 0 + lineCoords(1).color = 0 + lineCoords(2).color = 0 + lineCoords(3).color = 0 lineCoords(1).z = 1 lineCoords(2).z = 1 @@ -4445,9 +4445,9 @@ Public Sub Render() lineCoords(1).rhw = 1 lineCoords(2).rhw = 1 lineCoords(3).rhw = 1 - If vertexList(selectedPolys(i)).vertex(1) = 1 Then lineCoords(1).Color = objClr - If vertexList(selectedPolys(i)).vertex(2) = 1 Then lineCoords(2).Color = objClr - If vertexList(selectedPolys(i)).vertex(3) = 1 Then lineCoords(3).Color = objClr + If vertexList(selectedPolys(i)).vertex(1) = 1 Then lineCoords(1).color = objClr + If vertexList(selectedPolys(i)).vertex(2) = 1 Then lineCoords(2).color = objClr + If vertexList(selectedPolys(i)).vertex(3) = 1 Then lineCoords(3).color = objClr D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, lineCoords(1), Len(lineCoords(1)) Next @@ -4479,9 +4479,9 @@ Public Sub Render() lineCoords(3) = Polys(i).vertex(3) If Polys(i).vertex(1).z >= 0 And Polys(i).vertex(2).z >= 0 And Polys(i).vertex(3).z >= 0 Then - lineCoords(1).Color = ARGB(255, RGB(Polys(i).vertex(1).z, Polys(i).vertex(1).z, Polys(i).vertex(1).z)) - lineCoords(2).Color = ARGB(255, RGB(Polys(i).vertex(2).z, Polys(i).vertex(2).z, Polys(i).vertex(2).z)) - lineCoords(3).Color = ARGB(255, RGB(Polys(i).vertex(3).z, Polys(i).vertex(3).z, Polys(i).vertex(3).z)) + lineCoords(1).color = ARGB(255, RGB(Polys(i).vertex(1).z, Polys(i).vertex(1).z, Polys(i).vertex(1).z)) + lineCoords(2).color = ARGB(255, RGB(Polys(i).vertex(2).z, Polys(i).vertex(2).z, Polys(i).vertex(2).z)) + lineCoords(3).color = ARGB(255, RGB(Polys(i).vertex(3).z, Polys(i).vertex(3).z, Polys(i).vertex(3).z)) End If D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, lineCoords(1), Len(lineCoords(1)) @@ -4522,7 +4522,7 @@ Public Sub Render() End If srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y - scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).Color + scenerySprite.Draw SceneryTextures(sVal).Texture, ByVal 0, sc, rc, scenR, Scenery(i).screenTr, Scenery(i).color End If Next End If @@ -4535,7 +4535,7 @@ Public Sub Render() sc.Y = SceneryTextures(sVal).reScale.Y * Scenery(0).Scaling.Y * zoomFactor srcRect.right = SceneryTextures(sVal).Width / SceneryTextures(sVal).reScale.X + 0 srcRect.bottom = SceneryTextures(sVal).Height / SceneryTextures(sVal).reScale.Y + 0 - scenerySprite.Draw SceneryTextures(sVal).Texture, srcRect, sc, rc, Scenery(0).rotation, Scenery(0).screenTr, Scenery(0).Color + scenerySprite.Draw SceneryTextures(sVal).Texture, srcRect, sc, rc, Scenery(0).rotation, Scenery(0).screenTr, Scenery(0).color End If End If @@ -4717,9 +4717,9 @@ Public Sub Render() sVal = Scenery(i).Style - sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, ARGB(255, Scenery(i).Color), 0, 0) + sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, ARGB(255, Scenery(i).color), 0, 0) If Scenery(i).selected = 1 Or Scenery(i).selected = 3 Then - sceneryCoords(0).Color = ARGB(255, pointClr) + sceneryCoords(0).color = ARGB(255, pointClr) End If sceneryCoords(1) = sceneryCoords(0) sceneryCoords(2) = sceneryCoords(0) @@ -4776,10 +4776,10 @@ Public Sub Render() Next If currentTool = TOOL_SCENERY And Scenery(0).Style > 0 And Not (ctrlDown Or altDown) Then sVal = Scenery(0).Style - sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) - sceneryCoords(1) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) - sceneryCoords(2) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) - sceneryCoords(3) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) + sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).color, 0, 0) + sceneryCoords(1) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).color, 0, 0) + sceneryCoords(2) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).color, 0, 0) + sceneryCoords(3) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).color, 0, 0) sceneryCoords(0).X = Scenery(0).screenTr.X sceneryCoords(0).Y = Scenery(0).screenTr.Y sceneryCoords(1).X = sceneryCoords(0).X + Cos(Scenery(0).rotation) * (SceneryTextures(sVal).Width + 0) * Scenery(0).Scaling.X * zoomFactor @@ -4826,14 +4826,14 @@ Public Sub Render() End If If showPoints And showObjects And colliderCount > 0 Then - sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).Color, 0, 0) + sceneryCoords(0) = CreateCustomVertex(0, 0, 1, 1, Scenery(0).color, 0, 0) For i = 1 To colliderCount sceneryCoords(0).X = (Colliders(i).X - scrollCoords(2).X) * zoomFactor sceneryCoords(0).Y = (Colliders(i).Y - scrollCoords(2).Y) * zoomFactor If Colliders(i).active = 1 Then - sceneryCoords(0).Color = selectionClr + sceneryCoords(0).color = selectionClr Else - sceneryCoords(0).Color = ARGB(255, RGB(255, 255, 255)) + sceneryCoords(0).color = ARGB(255, RGB(255, 255, 255)) End If D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 1, sceneryCoords(0), Len(sceneryCoords(0)) Next @@ -4853,21 +4853,21 @@ Public Sub Render() lineCoords(3).z = 1: lineCoords(3).rhw = 1 If vertexList(selectedPolys(i)).vertex(1) = 1 Or vertexList(selectedPolys(i)).vertex(1) = 3 Then - lineCoords(1).Color = pointClr + lineCoords(1).color = pointClr End If If vertexList(selectedPolys(i)).vertex(2) = 1 Or vertexList(selectedPolys(i)).vertex(2) = 3 Then - lineCoords(2).Color = pointClr + lineCoords(2).color = pointClr End If If vertexList(selectedPolys(i)).vertex(3) = 1 Or vertexList(selectedPolys(i)).vertex(3) = 3 Then - lineCoords(3).Color = pointClr + lineCoords(3).color = pointClr End If D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, lineCoords(1), Len(lineCoords(1)) If showPoints Then - If vertexList(selectedPolys(i)).vertex(1) = 1 Then lineCoords(1).Color = pointClr - If vertexList(selectedPolys(i)).vertex(2) = 1 Then lineCoords(2).Color = pointClr - If vertexList(selectedPolys(i)).vertex(3) = 1 Then lineCoords(3).Color = pointClr + If vertexList(selectedPolys(i)).vertex(1) = 1 Then lineCoords(1).color = pointClr + If vertexList(selectedPolys(i)).vertex(2) = 1 Then lineCoords(2).color = pointClr + If vertexList(selectedPolys(i)).vertex(3) = 1 Then lineCoords(3).color = pointClr D3DDevice.setTexture 0, particleTexture D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, 3, lineCoords(1), Len(lineCoords(1)) D3DDevice.setTexture 0, Nothing @@ -4984,23 +4984,23 @@ Public Sub Render() lineCoords(2).X = (Waypoints(Connections(i).point2).X - scrollCoords(2).X) * zoomFactor lineCoords(2).Y = (Waypoints(Connections(i).point2).Y - scrollCoords(2).Y) * zoomFactor If Waypoints(Connections(i).point2).wayType(2) Then - lineCoords(1).Color = &HFFFFFF22 - lineCoords(2).Color = &HFFFFFF22 + lineCoords(1).color = &HFFFFFF22 + lineCoords(2).color = &HFFFFFF22 ElseIf Waypoints(Connections(i).point2).wayType(3) Then - lineCoords(1).Color = &HFF22FFFF - lineCoords(2).Color = &HFF22FFFF + lineCoords(1).color = &HFF22FFFF + lineCoords(2).color = &HFF22FFFF ElseIf Waypoints(Connections(i).point2).wayType(0) Then - lineCoords(1).Color = &HFF22FF22 - lineCoords(2).Color = &HFF22FF22 + lineCoords(1).color = &HFF22FF22 + lineCoords(2).color = &HFF22FF22 ElseIf Waypoints(Connections(i).point2).wayType(1) Then - lineCoords(1).Color = &HFFFF2222 - lineCoords(2).Color = &HFFFF2222 + lineCoords(1).color = &HFFFF2222 + lineCoords(2).color = &HFFFF2222 ElseIf Waypoints(Connections(i).point2).wayType(4) Then - lineCoords(1).Color = &HFFFFFFFF - lineCoords(2).Color = &HFFFFFFFF + lineCoords(1).color = &HFFFFFFFF + lineCoords(2).color = &HFFFFFFFF Else - lineCoords(1).Color = &HFF000000 - lineCoords(2).Color = &HFF000000 + lineCoords(1).color = &HFF000000 + lineCoords(2).color = &HFF000000 End If lineCoords(1).tu = 0 lineCoords(1).tv = 0 @@ -5017,23 +5017,23 @@ Public Sub Render() lineCoords(2).X = mouseCoords.X lineCoords(2).Y = mouseCoords.Y If mnuWayType(2).Checked Then - lineCoords(1).Color = &HFFFFFF22 - lineCoords(2).Color = &HFFFFFF22 + lineCoords(1).color = &HFFFFFF22 + lineCoords(2).color = &HFFFFFF22 ElseIf mnuWayType(3).Checked Then - lineCoords(1).Color = &HFF22FFFF - lineCoords(2).Color = &HFF22FFFF + lineCoords(1).color = &HFF22FFFF + lineCoords(2).color = &HFF22FFFF ElseIf mnuWayType(0).Checked Then - lineCoords(1).Color = &HFF22FF22 - lineCoords(2).Color = &HFF22FF22 + lineCoords(1).color = &HFF22FF22 + lineCoords(2).color = &HFF22FF22 ElseIf mnuWayType(1).Checked Then - lineCoords(1).Color = &HFFFF2222 - lineCoords(2).Color = &HFFFF2222 + lineCoords(1).color = &HFFFF2222 + lineCoords(2).color = &HFFFF2222 ElseIf mnuWayType(4).Checked Then - lineCoords(1).Color = &HFFFFFFFF - lineCoords(2).Color = &HFFFFFFFF + lineCoords(1).color = &HFFFFFFFF + lineCoords(2).color = &HFFFFFFFF Else - lineCoords(1).Color = &HFF000000 - lineCoords(2).Color = &HFF000000 + lineCoords(1).color = &HFF000000 + lineCoords(2).color = &HFF000000 End If lineCoords(1).tu = 0 lineCoords(1).tv = 0 @@ -5066,7 +5066,7 @@ Public Sub Render() 'draw circle If circleOn Then For i = 0 To 32 - circleCoords(i).Color = ARGB(255, RGB(255, 255, 255)) + circleCoords(i).color = ARGB(255, RGB(255, 255, 255)) circleCoords(i).X = mouseCoords.X + zoomFactor * clrRadius * Math.Cos(pi * i / 16) circleCoords(i).Y = mouseCoords.Y + zoomFactor * clrRadius * Math.Sin(pi * i / 16) Next @@ -5076,11 +5076,11 @@ Public Sub Render() 'vertex selection -------- If currentFunction = TOOL_VSELECT Or currentFunction = TOOL_VSELADD Or currentFunction = TOOL_VSELSUB Then If toolAction Then - circleCoords(0).Color = ARGB(255, RGB(255, 255, 255)) - circleCoords(1).Color = ARGB(255, RGB(255, 255, 255)) - circleCoords(2).Color = ARGB(255, RGB(255, 255, 255)) - circleCoords(3).Color = ARGB(255, RGB(255, 255, 255)) - circleCoords(4).Color = ARGB(255, RGB(255, 255, 255)) + circleCoords(0).color = ARGB(255, RGB(255, 255, 255)) + circleCoords(1).color = ARGB(255, RGB(255, 255, 255)) + circleCoords(2).color = ARGB(255, RGB(255, 255, 255)) + circleCoords(3).color = ARGB(255, RGB(255, 255, 255)) + circleCoords(4).color = ARGB(255, RGB(255, 255, 255)) circleCoords(0).X = selectedCoords(1).X circleCoords(1).X = mouseCoords.X circleCoords(2).X = mouseCoords.X @@ -5930,7 +5930,7 @@ Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y A polyClr.red = tempClr.blue polyClr.green = tempClr.green polyClr.blue = tempClr.red - Scenery(0).Color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) + Scenery(0).color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue End If @@ -6211,7 +6211,7 @@ Private Sub applyLights(Optional toSel As Boolean = False) If gVal > 255 Then gVal = 255 If bVal > 255 Then bVal = 255 - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(Int(bVal), Int(gVal), Int(rVal))) + Polys(i).vertex(j).color = ARGB(getAlpha(Polys(i).vertex(j).color), RGB(Int(bVal), Int(gVal), Int(rVal))) rVal = 0 gVal = 0 @@ -6303,7 +6303,7 @@ Private Sub applyLightsToVert(pIndex As Integer, vIndex As Integer) If gVal > 255 Then gVal = 255 If bVal > 255 Then bVal = 255 - Polys(pIndex).vertex(vIndex).Color = ARGB(getAlpha(Polys(pIndex).vertex(vIndex).Color), RGB(Int(bVal), Int(gVal), Int(rVal))) + Polys(pIndex).vertex(vIndex).color = ARGB(getAlpha(Polys(pIndex).vertex(vIndex).color), RGB(Int(bVal), Int(gVal), Int(rVal))) rVal = 0 gVal = 0 @@ -6390,7 +6390,7 @@ Private Sub AverageVerts() For i = 1 To numSelectedPolys For j = 1 To 3 If vertexList(selectedPolys(i)).vertex(j) = 1 Then - tehClr = getRGB(Polys(selectedPolys(i)).vertex(j).Color) + tehClr = getRGB(Polys(selectedPolys(i)).vertex(j).color) finalR = finalR + tehClr.red finalG = finalG + tehClr.green finalB = finalB + tehClr.blue @@ -6405,7 +6405,7 @@ Private Sub AverageVerts() For i = 1 To numSelectedPolys For j = 1 To 3 If vertexList(selectedPolys(i)).vertex(j) = 1 Then - Polys(selectedPolys(i)).vertex(j).Color = ARGB(getAlpha(Polys(selectedPolys(i)).vertex(j).Color), RGB(finalR, finalG, finalB)) + Polys(selectedPolys(i)).vertex(j).color = ARGB(getAlpha(Polys(selectedPolys(i)).vertex(j).color), RGB(finalR, finalG, finalB)) End If Next Next @@ -6469,7 +6469,7 @@ Private Sub AverageVertices() vertexList(connectedPolys(P)).color(V).red = finalR vertexList(connectedPolys(P)).color(V).green = finalG vertexList(connectedPolys(P)).color(V).blue = finalB - Polys(connectedPolys(P)).vertex(V).Color = ARGB(getAlpha(Polys(connectedPolys(P)).vertex(V).Color), RGB(finalB, finalG, finalR)) + Polys(connectedPolys(P)).vertex(V).color = ARGB(getAlpha(Polys(connectedPolys(P)).vertex(V).color), RGB(finalB, finalG, finalR)) End If Next Next @@ -6525,7 +6525,7 @@ Private Sub AverageVertices() vertexList(connectedPolys(P)).color(V).red = finalR vertexList(connectedPolys(P)).color(V).green = finalG vertexList(connectedPolys(P)).color(V).blue = finalB - Polys(connectedPolys(P)).vertex(V).Color = ARGB(getAlpha(Polys(connectedPolys(P)).vertex(V).Color), RGB(finalB, finalG, finalR)) + Polys(connectedPolys(P)).vertex(V).color = ARGB(getAlpha(Polys(connectedPolys(P)).vertex(V).color), RGB(finalB, finalG, finalR)) End If Next Next @@ -6757,7 +6757,7 @@ Private Sub CreatingPoly(Shift As Integer, X As Single, Y As Single) Polys(polyCount + 1).vertex(numVerts + 1).tv = (yVal / zoomFactor + scrollCoords(2).Y) / yTexture End If - Polys(polyCount + 1).vertex(numVerts + 1).Color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) + Polys(polyCount + 1).vertex(numVerts + 1).color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) Render @@ -6915,7 +6915,7 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A polyClr.red = tempClr.blue polyClr.green = tempClr.green polyClr.blue = tempClr.red - Scenery(0).Color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) + Scenery(0).color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue End If @@ -7836,9 +7836,9 @@ Private Sub PrecisionColoring(X As Single, Y As Single) Next If closestPoly > 0 And closestVert > 0 Then - destClr = getRGB(Polys(closestPoly).vertex(closestVert).Color) + destClr = getRGB(Polys(closestPoly).vertex(closestVert).color) destClr = applyBlend(destClr) - Polys(closestPoly).vertex(closestVert).Color = ARGB(getAlpha(Polys(closestPoly).vertex(closestVert).Color), RGB(destClr.blue, destClr.green, destClr.red)) + Polys(closestPoly).vertex(closestVert).color = ARGB(getAlpha(Polys(closestPoly).vertex(closestVert).color), RGB(destClr.blue, destClr.green, destClr.red)) vertexList(closestPoly).color(closestVert).red = destClr.red vertexList(closestPoly).color(closestVert).green = destClr.green vertexList(closestPoly).color(closestVert).blue = destClr.blue @@ -7862,9 +7862,9 @@ Private Sub PrecisionColoring(X As Single, Y As Single) Next If closestPoly > 0 And closestVert > 0 Then - destClr = getRGB(Polys(closestPoly).vertex(closestVert).Color) + destClr = getRGB(Polys(closestPoly).vertex(closestVert).color) destClr = applyBlend(destClr) - Polys(closestPoly).vertex(closestVert).Color = ARGB(getAlpha(Polys(closestPoly).vertex(closestVert).Color), RGB(destClr.blue, destClr.green, destClr.red)) + Polys(closestPoly).vertex(closestVert).color = ARGB(getAlpha(Polys(closestPoly).vertex(closestVert).color), RGB(destClr.blue, destClr.green, destClr.red)) vertexList(closestPoly).color(closestVert).red = destClr.red vertexList(closestPoly).color(closestVert).green = destClr.green vertexList(closestPoly).color(closestVert).blue = destClr.blue @@ -7896,9 +7896,9 @@ Private Sub VertexColoring(X As Single, Y As Single) If vertexList(pNum).vertex(j) = 1 Then If nearCoord(X, Polys(pNum).vertex(j).X, R) And nearCoord(Y, Polys(pNum).vertex(j).Y, R) Then If (Polys(pNum).vertex(j).X - X) ^ 2 + (Polys(pNum).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then - destClr = getRGB(Polys(pNum).vertex(j).Color) + destClr = getRGB(Polys(pNum).vertex(j).color) destClr = applyBlend(destClr) - Polys(pNum).vertex(j).Color = ARGB(getAlpha(Polys(pNum).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) + Polys(pNum).vertex(j).color = ARGB(getAlpha(Polys(pNum).vertex(j).color), RGB(destClr.blue, destClr.green, destClr.red)) vertexList(pNum).color(j).red = destClr.red vertexList(pNum).color(j).green = destClr.green vertexList(pNum).color(j).blue = destClr.blue @@ -7918,9 +7918,9 @@ Private Sub VertexColoring(X As Single, Y As Single) If vertexList(i).vertex(j) = 0 Then If nearCoord(X, Polys(i).vertex(j).X, R) And nearCoord(Y, Polys(i).vertex(j).Y, R) Then If (Polys(i).vertex(j).X - X) ^ 2 + (Polys(i).vertex(j).Y - Y) ^ 2 <= R ^ 2 Then - destClr = getRGB(Polys(i).vertex(j).Color) + destClr = getRGB(Polys(i).vertex(j).color) destClr = applyBlend(destClr) - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) + Polys(i).vertex(j).color = ARGB(getAlpha(Polys(i).vertex(j).color), RGB(destClr.blue, destClr.green, destClr.red)) vertexList(i).color(j).red = destClr.red vertexList(i).color(j).green = destClr.green vertexList(i).color(j).blue = destClr.blue @@ -7941,9 +7941,9 @@ Private Sub VertexColoring(X As Single, Y As Single) If Scenery(i).selected = 1 Then If nearCoord(X, Scenery(i).screenTr.X, R) And nearCoord(Y, Scenery(i).screenTr.Y, R) Then If (Scenery(i).screenTr.X - X) ^ 2 + (Scenery(i).screenTr.Y - Y) ^ 2 <= R ^ 2 Then - destClr = getRGB(Scenery(i).Color) + destClr = getRGB(Scenery(i).color) destClr = applyBlend(destClr) - Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) + Scenery(i).color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) If colorMode = 1 Then Scenery(i).selected = 3 colored = True End If @@ -7957,9 +7957,9 @@ Private Sub VertexColoring(X As Single, Y As Single) If Scenery(i).selected = 0 Then If nearCoord(X, Scenery(i).screenTr.X, R) And nearCoord(Y, Scenery(i).screenTr.Y, R) Then If (Scenery(i).screenTr.X - X) ^ 2 + (Scenery(i).screenTr.Y - Y) ^ 2 <= R ^ 2 Then - destClr = getRGB(Scenery(i).Color) + destClr = getRGB(Scenery(i).color) destClr = applyBlend(destClr) - Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) + Scenery(i).color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) If colorMode = 1 Then Scenery(i).selected = 2 colored = True End If @@ -8063,7 +8063,7 @@ Private Sub ColorPicker(X As Single, Y As Single) frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue Else polyClr = tempClr - Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) + Scenery(0).color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).color) frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue End If @@ -8074,14 +8074,14 @@ Private Sub ColorPicker(X As Single, Y As Single) End If Next If vNum > 0 Then - tempClr = getRGB(Scenery(vNum).Color) + tempClr = getRGB(Scenery(vNum).color) If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then ElseIf frmPalette.Enabled = False Then 'non modal frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue Else polyClr = tempClr - Scenery(0).Color = ARGB(Scenery(0).alpha, Scenery(vNum).Color) + Scenery(0).color = ARGB(Scenery(0).alpha, Scenery(vNum).color) frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue End If @@ -8126,7 +8126,7 @@ Private Sub depthPicker(X As Single, Y As Single) End If polyClr.green = polyClr.red polyClr.blue = polyClr.red - Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) + Scenery(0).color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).color) frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue End If @@ -8162,14 +8162,14 @@ Private Sub lightPicker(X As Single, Y As Single) If vNum > 0 Then 'poly color absorbed - tempClr = getRGB(Polys(pNum).vertex(vNum).Color) + tempClr = getRGB(Polys(pNum).vertex(vNum).color) If tempClr.red = polyClr.red And tempClr.green = polyClr.green And tempClr.blue = polyClr.blue Then ElseIf frmPalette.Enabled = False Then 'non modal frmColor.InitClr tempClr.red, tempClr.green, tempClr.blue Else polyClr = tempClr - Scenery(0).Color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).Color) + Scenery(0).color = ARGB(Scenery(0).alpha, Polys(pNum).vertex(vNum).color) frmPalette.setValues polyClr.red, polyClr.green, polyClr.blue frmPalette.checkPalette polyClr.red, polyClr.green, polyClr.blue End If @@ -10053,9 +10053,9 @@ Private Sub ColorFill(X As Single, Y As Single) SaveUndo selectionChanged = False End If - destClr = getRGB(Polys(PolyNum).vertex(j).Color) + destClr = getRGB(Polys(PolyNum).vertex(j).color) destClr = applyBlend(destClr) - Polys(PolyNum).vertex(j).Color = ARGB(getAlpha(Polys(PolyNum).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) + Polys(PolyNum).vertex(j).color = ARGB(getAlpha(Polys(PolyNum).vertex(j).color), RGB(destClr.blue, destClr.green, destClr.red)) vertexList(PolyNum).color(j).red = destClr.red vertexList(PolyNum).color(j).green = destClr.green vertexList(PolyNum).color(j).blue = destClr.blue @@ -10073,9 +10073,9 @@ Private Sub ColorFill(X As Single, Y As Single) SaveUndo selectionChanged = False End If - destClr = getRGB(Scenery(i).Color) + destClr = getRGB(Scenery(i).color) destClr = applyBlend(destClr) - Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) + Scenery(i).color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) polyColored = True End If Next @@ -10095,9 +10095,9 @@ Private Sub ColorFill(X As Single, Y As Single) SaveUndo selectionChanged = False End If - destClr = getRGB(Polys(i).vertex(j).Color) 'get clr of poly + destClr = getRGB(Polys(i).vertex(j).color) 'get clr of poly destClr = applyBlend(destClr) - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(destClr.blue, destClr.green, destClr.red)) + Polys(i).vertex(j).color = ARGB(getAlpha(Polys(i).vertex(j).color), RGB(destClr.blue, destClr.green, destClr.red)) vertexList(i).color(j).red = destClr.red vertexList(i).color(j).green = destClr.green vertexList(i).color(j).blue = destClr.blue @@ -10115,9 +10115,9 @@ Private Sub ColorFill(X As Single, Y As Single) SaveUndo selectionChanged = False End If - destClr = getRGB(Scenery(i).Color) + destClr = getRGB(Scenery(i).color) destClr = applyBlend(destClr) - Scenery(i).Color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) + Scenery(i).color = ARGB(Scenery(i).alpha, RGB(destClr.blue, destClr.green, destClr.red)) polyColored = True End If Next @@ -10324,7 +10324,7 @@ Private Sub deletePolys() ElseIf lightCount = 0 Then For i = 1 To polyCount For j = 1 To 3 - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) + Polys(i).vertex(j).color = ARGB(getAlpha(Polys(i).vertex(j).color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) Next Next End If @@ -11519,7 +11519,7 @@ Private Sub setLightsMode(lightsOn As Boolean) If Not lightsOn Then For i = 1 To polyCount For j = 1 To 3 - Polys(i).vertex(j).Color = ARGB(getAlpha(Polys(i).vertex(j).Color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) + Polys(i).vertex(j).color = ARGB(getAlpha(Polys(i).vertex(j).color), RGB(vertexList(i).color(j).blue, vertexList(i).color(j).green, vertexList(i).color(j).red)) Next Next Else @@ -11640,10 +11640,10 @@ Public Sub setPolyColor(Index As Integer, value As Byte) opacity = value / 100 End If If numVerts > 0 And (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) Then - Polys(polyCount + 1).vertex(numVerts + 1).Color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) + Polys(polyCount + 1).vertex(numVerts + 1).color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) End If Scenery(0).alpha = opacity * 255 - Scenery(0).Color = ARGB(opacity * 255, RGB(polyClr.blue, polyClr.green, polyClr.red)) + Scenery(0).color = ARGB(opacity * 255, RGB(polyClr.blue, polyClr.green, polyClr.red)) End Sub @@ -11654,10 +11654,10 @@ Public Sub setPaletteColor(red As Byte, green As Byte, blue As Byte) polyClr.green = green polyClr.blue = blue If numVerts > 0 And (currentFunction = TOOL_CREATE Or currentFunction = TOOL_QUAD) Then - Polys(polyCount + 1).vertex(numVerts + 1).Color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) + Polys(polyCount + 1).vertex(numVerts + 1).color = ARGB(255 * opacity, RGB(polyClr.blue, polyClr.green, polyClr.red)) End If Scenery(0).alpha = opacity * 255 - Scenery(0).Color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) + Scenery(0).color = ARGB(Scenery(0).alpha, RGB(polyClr.blue, polyClr.green, polyClr.red)) End Sub @@ -11840,10 +11840,10 @@ Public Function setBGColor(Index As Integer) As Long bgColors(Index).green = frmColor.green bgColors(Index).blue = frmColor.blue - bgPolys(1).Color = RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red) - bgPolys(2).Color = RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red) - bgPolys(3).Color = RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red) - bgPolys(4).Color = RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red) + bgPolys(1).color = RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red) + bgPolys(2).color = RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red) + bgPolys(3).color = RGB(bgColors(1).blue, bgColors(1).green, bgColors(1).red) + bgPolys(4).color = RGB(bgColors(2).blue, bgColors(2).green, bgColors(2).red) setBGColor = RGB(bgColors(Index).red, bgColors(Index).green, bgColors(Index).blue) @@ -12825,8 +12825,8 @@ Private Sub savePrefab(FileName As String) Polygon.vertex(j).X = PolyCoords(selectedPolys(i)).vertex(j).X Polygon.vertex(j).Y = PolyCoords(selectedPolys(i)).vertex(j).Y vertexList(selectedPolys(i)).vertex(j) = 1 - alpha = getAlpha(Polys(selectedPolys(i)).vertex(j).Color) - Polygon.vertex(j).Color = ARGB(alpha, RGB(vertexList(selectedPolys(i)).color(j).blue, vertexList(selectedPolys(i)).color(j).green, vertexList(selectedPolys(i)).color(j).red)) + alpha = getAlpha(Polys(selectedPolys(i)).vertex(j).color) + Polygon.vertex(j).color = ARGB(alpha, RGB(vertexList(selectedPolys(i)).color(j).blue, vertexList(selectedPolys(i)).color(j).green, vertexList(selectedPolys(i)).color(j).red)) Next Put #1, , Polygon Put #1, , vertexList(selectedPolys(i)).vertex(1) @@ -12939,7 +12939,7 @@ Private Sub loadPrefab(FileName As String) PolyCoords(tehValue).vertex(j).Y = Polys(tehValue).vertex(j).Y Polys(tehValue).vertex(j).X = (PolyCoords(tehValue).vertex(j).X - scrollCoords(2).X) * zoomFactor Polys(tehValue).vertex(j).Y = (PolyCoords(tehValue).vertex(j).Y - scrollCoords(2).Y) * zoomFactor - tempClr = getRGB(Polys(tehValue).vertex(j).Color) + tempClr = getRGB(Polys(tehValue).vertex(j).color) vertexList(tehValue).color(j).red = tempClr.red vertexList(tehValue).color(j).green = tempClr.green vertexList(tehValue).color(j).blue = tempClr.blue @@ -13327,7 +13327,7 @@ Private Sub mnuSelColor_Click() For i = 1 To polyCount For j = 1 To 3 vertexList(i).vertex(j) = 0 - clrVal = getRGB(Polys(i).vertex(j).Color) + clrVal = getRGB(Polys(i).vertex(j).color) If clrVal.red = polyClr.red And clrVal.green = polyClr.green And clrVal.blue = polyClr.blue Then addPoly = 1 vertexList(i).vertex(j) = 1 @@ -13697,7 +13697,7 @@ Private Sub mnuApplyLight_Click() For i = 1 To numSelectedPolys For j = 1 To 3 'apply poly color to base color - tehClr = getRGB(Polys(selectedPolys(i)).vertex(j).Color) + tehClr = getRGB(Polys(selectedPolys(i)).vertex(j).color) vertexList(selectedPolys(i)).color(j).red = tehClr.red vertexList(selectedPolys(i)).color(j).green = tehClr.green vertexList(selectedPolys(i)).color(j).blue = tehClr.blue @@ -13709,7 +13709,7 @@ Private Sub mnuApplyLight_Click() For i = 1 To polyCount For j = 1 To 3 'apply poly color to base color - tehClr = getRGB(Polys(i).vertex(j).Color) + tehClr = getRGB(Polys(i).vertex(j).color) vertexList(i).color(j).red = tehClr.red vertexList(i).color(j).green = tehClr.green vertexList(i).color(j).blue = tehClr.blue @@ -13801,11 +13801,11 @@ Private Sub mnuSplit_Click() vertexList(selectedPolys(i)).color(left) = vertexList(polyCount).color(right) - clr1 = getRGB(Polys(selectedPolys(i)).vertex(right).Color) - clr2 = getRGB(Polys(polyCount).vertex(left).Color) - alpha1 = getAlpha(Polys(selectedPolys(i)).vertex(right).Color) - alpha2 = getAlpha(Polys(polyCount).vertex(left).Color) - Polys(polyCount).vertex(right).Color = ARGB((alpha1 * 0.5 + alpha2 * 0.5), RGB((clr1.blue * 0.5 + clr2.blue * 0.5), (clr1.green * 0.5 + clr2.green * 0.5), (clr1.red * 0.5 + clr2.red * 0.5))) + clr1 = getRGB(Polys(selectedPolys(i)).vertex(right).color) + clr2 = getRGB(Polys(polyCount).vertex(left).color) + alpha1 = getAlpha(Polys(selectedPolys(i)).vertex(right).color) + alpha2 = getAlpha(Polys(polyCount).vertex(left).color) + Polys(polyCount).vertex(right).color = ARGB((alpha1 * 0.5 + alpha2 * 0.5), RGB((clr1.blue * 0.5 + clr2.blue * 0.5), (clr1.green * 0.5 + clr2.green * 0.5), (clr1.red * 0.5 + clr2.red * 0.5))) Polys(selectedPolys(i)).vertex(left) = Polys(polyCount).vertex(right) @@ -14501,7 +14501,7 @@ Public Sub getInfo() End If frmInfo.txtTexture(0).Text = Int(Polys(selectedPolys(1)).vertex(j).tu * 10000 + 0.5) / 10000 frmInfo.txtTexture(1).Text = Int(Polys(selectedPolys(1)).vertex(j).tv * 10000 + 0.5) / 10000 - frmInfo.txtVertexAlpha.Text = Int((getAlpha(Polys(selectedPolys(1)).vertex(j).Color) / 255 * 100) * 100 + 0.5) / 100 + frmInfo.txtVertexAlpha.Text = Int((getAlpha(Polys(selectedPolys(1)).vertex(j).color) / 255 * 100) * 100 + 0.5) / 100 frmInfo.lblCoords.Caption = Int(PolyCoords(selectedPolys(1)).vertex(j).X * 100 + 0.5) / 100 & ", " & Int(PolyCoords(selectedPolys(1)).vertex(j).Y * 100) / 100 Exit For End If @@ -14644,7 +14644,7 @@ Public Sub applyVertexAlpha(tehValue As Single) For i = 1 To numSelectedPolys For j = 1 To 3 If vertexList(selectedPolys(i)).vertex(j) = 1 Then - Polys(selectedPolys(i)).vertex(j).Color = ARGB(tehValue * 255, Polys(selectedPolys(i)).vertex(j).Color) + Polys(selectedPolys(i)).vertex(j).color = ARGB(tehValue * 255, Polys(selectedPolys(i)).vertex(j).color) End If Next Next @@ -14691,9 +14691,9 @@ Public Sub applySceneryProp(ByVal tehValue As Single, Index As Integer) ElseIf Index = 1 Then 'y scale Scenery(i).Scaling.Y = tehValue ElseIf Index = 2 Then 'alpha - tempClr = getRGB(Scenery(i).Color) + tempClr = getRGB(Scenery(i).color) Scenery(i).alpha = tehValue - Scenery(i).Color = ARGB(tehValue, RGB(tempClr.blue, tempClr.green, tempClr.red)) + Scenery(i).color = ARGB(tehValue, RGB(tempClr.blue, tempClr.green, tempClr.red)) ElseIf Index = 3 Then 'rotation Scenery(i).rotation = tehValue ElseIf Index = 4 Then 'level From 5bbe226454e32bfbbf8c1ac24755afc67b842149 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Tue, 26 Jan 2021 01:32:51 +0100 Subject: [PATCH 38/57] Fix error on startup due to uninitialized variables --- frmSoldatMapEditor.frm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 0b2e0ba..b0fbbd6 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -1656,7 +1656,6 @@ Private Sub Form_Load() initialized = False loadINI - loadWorkspace loadColors err = "Error setting colors" @@ -1736,6 +1735,8 @@ Private Sub Form_Load() err = "Error setting up palette windows" + loadWorkspace + 'show windows frmTaskBar.Show frmTools.Show 0, frmSoldatMapEditor From 7d06bceb8f0af44d655fc40f133c866ad283870f Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Tue, 26 Jan 2021 01:33:37 +0100 Subject: [PATCH 39/57] Add remember sticky state of tools windows after reopening workspace/pw --- frmSoldatMapEditor.frm | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index b0fbbd6..99833f9 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -12142,7 +12142,8 @@ Private Sub saveWindow(sectionName As String, window As Form, collapsed As Boole topVal = window.Top / Screen.TwipsPerPixelY iniString = "Visible=" & window.Visible & sNull & "Left=" & leftVal & sNull & "Top=" & topVal & sNull _ - & "Collapsed=" & collapsed & sNull & sNull + & "Collapsed=" & collapsed & sNull & "Snapped=" & Tag & sNull & sNull + saveSection sectionName, iniString, appPath & "\workspace\" & FileName @@ -12362,36 +12363,44 @@ Private Sub loadWorkspace(Optional FileName As String = "current.ini") frmTools.xPos = loadInt("Tools", "Left", appPath & "\workspace\" & FileName) frmTools.yPos = loadInt("Tools", "Top", appPath & "\workspace\" & FileName) frmTools.collapsed = loadString("Tools", "Collapsed", appPath & "\workspace\" & FileName) + frmTools.Tag = loadString("Tools", "Snapped", appPath & "\workspace\" & FileName) mnuDisplay.Checked = loadString("Display", "Visible", appPath & "\workspace\" & FileName) frmDisplay.xPos = loadInt("Display", "Left", appPath & "\workspace\" & FileName) frmDisplay.yPos = loadInt("Display", "Top", appPath & "\workspace\" & FileName) frmDisplay.collapsed = loadString("Display", "Collapsed", appPath & "\workspace\" & FileName) + frmDisplay.Tag = loadString("Display", "Snapped", appPath & "\workspace\" & FileName) mnuInfo.Checked = loadString("Properties", "Visible", appPath & "\workspace\" & FileName) frmInfo.xPos = loadInt("Properties", "Left", appPath & "\workspace\" & FileName) frmInfo.yPos = loadInt("Properties", "Top", appPath & "\workspace\" & FileName) frmInfo.collapsed = loadString("Properties", "Collapsed", appPath & "\workspace\" & FileName) + frmInfo.Tag = loadString("Properties", "Snapped", appPath & "\workspace\" & FileName) mnuPalette.Checked = loadString("Palette", "Visible", appPath & "\workspace\" & FileName) frmPalette.xPos = loadInt("Palette", "Left", appPath & "\workspace\" & FileName) frmPalette.yPos = loadInt("Palette", "Top", appPath & "\workspace\" & FileName) frmPalette.collapsed = loadString("Palette", "Collapsed", appPath & "\workspace\" & FileName) + frmPalette.Tag = loadString("Palette", "Snapped", appPath & "\workspace\" & FileName) mnuScenery.Checked = loadString("Scenery", "Visible", appPath & "\workspace\" & FileName) frmScenery.xPos = loadInt("Scenery", "Left", appPath & "\workspace\" & FileName) frmScenery.yPos = loadInt("Scenery", "Top", appPath & "\workspace\" & FileName) frmScenery.collapsed = loadString("Scenery", "Collapsed", appPath & "\workspace\" & FileName) - + frmScenery.Tag = loadString("Scenery", "Snapped", appPath & "\workspace\" & FileName) + + frmScenery.Tag = "www" mnuWaypoints.Checked = loadString("Waypoints", "Visible", appPath & "\workspace\" & FileName) frmWaypoints.xPos = loadInt("Waypoints", "Left", appPath & "\workspace\" & FileName) frmWaypoints.yPos = loadInt("Waypoints", "Top", appPath & "\workspace\" & FileName) frmWaypoints.collapsed = loadString("Waypoints", "Collapsed", appPath & "\workspace\" & FileName) + frmWaypoints.Tag = loadString("Waypoints", "Snapped", appPath & "\workspace\" & FileName) mnuTexture.Checked = loadString("Texture", "Visible", appPath & "\workspace\" & FileName) frmTexture.xPos = loadInt("Texture", "Left", appPath & "\workspace\" & FileName) frmTexture.yPos = loadInt("Texture", "Top", appPath & "\workspace\" & FileName) frmTexture.collapsed = loadString("Texture", "Collapsed", appPath & "\workspace\" & FileName) + frmTexture.Tag = loadString("Texture", "Snapped", appPath & "\workspace\" & FileName) Exit Sub From 652b8bdd306d4827376e77b0c4b5098513d18283 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Tue, 26 Jan 2021 01:35:17 +0100 Subject: [PATCH 40/57] Modify let vb6 correct form field order --- frmSoldatMapEditor.frm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 99833f9..6035f62 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -46,8 +46,8 @@ Begin VB.Form frmSoldatMapEditor TabIndex = 13 TabStop = 0 'False Top = 1200 - Width = 3615 Visible = 0 'False + Width = 3615 End Begin MSComctlLib.ImageList ImageList Left = 4080 @@ -461,8 +461,8 @@ Begin VB.Form frmSoldatMapEditor TabIndex = 1 TabStop = 0 'False Top = 1200 - Width = 1455 Visible = 0 'False + Width = 1455 End Begin MSComctlLib.TreeView tvwScenery Height = 8085 @@ -470,8 +470,8 @@ Begin VB.Form frmSoldatMapEditor TabIndex = 18 Tag = "font1" Top = 600 - Width = 5730 Visible = 0 'False + Width = 5730 _ExtentX = 10107 _ExtentY = 14261 _Version = 393217 From 44084ca5c3663407b31da7efa4bb2f6d48cb055f Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Tue, 26 Jan 2021 18:10:01 +0100 Subject: [PATCH 41/57] Fix use correct window tag for saving snapping --- frmSoldatMapEditor.frm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 6035f62..0dc301d 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -12142,7 +12142,7 @@ Private Sub saveWindow(sectionName As String, window As Form, collapsed As Boole topVal = window.Top / Screen.TwipsPerPixelY iniString = "Visible=" & window.Visible & sNull & "Left=" & leftVal & sNull & "Top=" & topVal & sNull _ - & "Collapsed=" & collapsed & sNull & "Snapped=" & Tag & sNull & sNull + & "Collapsed=" & collapsed & sNull & "Snapped=" & window.Tag & sNull & sNull saveSection sectionName, iniString, appPath & "\workspace\" & FileName From 3aa17913c92297e9bf5f1cfbdc228927776ac372 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Wed, 27 Jan 2021 02:15:10 +0100 Subject: [PATCH 42/57] Modify all controls in preference form in ide --- frmPreferences.frm | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/frmPreferences.frm b/frmPreferences.frm index 6a6313e..9269ced 100644 --- a/frmPreferences.frm +++ b/frmPreferences.frm @@ -2,7 +2,7 @@ VERSION 5.00 Begin VB.Form frmPreferences BackColor = &H004A3C31& BorderStyle = 1 'Fixed Single - ClientHeight = 6600 + ClientHeight = 8175 ClientLeft = 15 ClientTop = 15 ClientWidth = 6840 @@ -10,7 +10,7 @@ Begin VB.Form frmPreferences LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False - ScaleHeight = 440 + ScaleHeight = 545 ScaleMode = 3 'Pixel ScaleWidth = 456 ShowInTaskbar = 0 'False @@ -1741,6 +1741,9 @@ Private Type TColor blue As Byte End Type +Const MinHeight = 440 +Const MaxHeight = 547 + Dim blendModes(0 To 7) As Integer Dim backClr As TColor @@ -1764,10 +1767,10 @@ End Sub Private Sub picSekrit_Click() - If Me.ScaleHeight < 460 Then - Me.Height = 544 * Screen.TwipsPerPixelY + If Me.ScaleHeight < MaxHeight - 20 Then + Me.Height = MaxHeight * Screen.TwipsPerPixelY Else - Me.Height = 440 * Screen.TwipsPerPixelY + Me.Height = MinHeight * Screen.TwipsPerPixelY End If End Sub @@ -1937,6 +1940,8 @@ Private Sub Form_Load() Dim i As Integer On Error GoTo ErrorHandler + + Me.Height = MinHeight * Screen.TwipsPerPixelY sceneryVerts = frmSoldatMapEditor.sceneryVerts topmost = frmSoldatMapEditor.topmost From 2264c67fffd886903c913bac5c7fc6e14a9c627b Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Wed, 27 Jan 2021 02:16:46 +0100 Subject: [PATCH 43/57] Modify remove unnecessary form height reset Height reset happens on form load no need to reset it on close anymore --- frmPreferences.frm | 3 --- 1 file changed, 3 deletions(-) diff --git a/frmPreferences.frm b/frmPreferences.frm index 9269ced..bfc2e28 100644 --- a/frmPreferences.frm +++ b/frmPreferences.frm @@ -1759,7 +1759,6 @@ Dim sceneryVerts As Boolean, topmost As Boolean Private Sub picHide_Click() - Me.ScaleHeight = 408 Unload Me frmSoldatMapEditor.RegainFocus @@ -1790,7 +1789,6 @@ End Sub Private Sub picCancel_Click() - Me.ScaleHeight = 408 Unload Me frmSoldatMapEditor.RegainFocus @@ -1924,7 +1922,6 @@ End Function Private Sub picOK_Click() - Me.ScaleHeight = 408 Me.Hide If applyPreferences Then Unload Me From b47c66c2eb0efab070bc68409d1d72c79d420e74 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Wed, 27 Jan 2021 02:17:47 +0100 Subject: [PATCH 44/57] Fix preferences dialog disappears and cannot be opened after save error popup --- frmPreferences.frm | 3 --- 1 file changed, 3 deletions(-) diff --git a/frmPreferences.frm b/frmPreferences.frm index bfc2e28..f52c6d6 100644 --- a/frmPreferences.frm +++ b/frmPreferences.frm @@ -1922,12 +1922,9 @@ End Function Private Sub picOK_Click() - Me.Hide If applyPreferences Then Unload Me frmSoldatMapEditor.RegainFocus - Else - Me.Show End If End Sub From 2f014f26a52dd5c2ffa32e715775fe8ba38ce80b Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Wed, 27 Jan 2021 02:18:52 +0100 Subject: [PATCH 45/57] Fix make text in extended preference form readable --- frmPreferences.frm | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/frmPreferences.frm b/frmPreferences.frm index f52c6d6..32f0785 100644 --- a/frmPreferences.frm +++ b/frmPreferences.frm @@ -29,7 +29,7 @@ Begin VB.Form frmPreferences TabIndex = 78 TabStop = 0 'False Tag = "4" - Top = 7440 + Top = 7515 Visible = 0 'False Width = 240 End @@ -922,14 +922,14 @@ Begin VB.Form frmPreferences Italic = 0 'False Strikethrough = 0 'False EndProperty - Height = 315 + Height = 360 ItemData = "frmPreferences.frx":0000 Left = 1200 List = "frmPreferences.frx":001C Style = 2 'Dropdown List TabIndex = 29 TabStop = 0 'False - Top = 7080 + Top = 7230 Width = 1455 End Begin VB.ComboBox cboWireDest @@ -942,14 +942,14 @@ Begin VB.Form frmPreferences Italic = 0 'False Strikethrough = 0 'False EndProperty - Height = 315 + Height = 360 ItemData = "frmPreferences.frx":0072 Left = 1200 List = "frmPreferences.frx":008E Style = 2 'Dropdown List TabIndex = 30 TabStop = 0 'False - Top = 7440 + Top = 7590 Width = 1455 End Begin VB.ComboBox cboPolyDest @@ -962,14 +962,14 @@ Begin VB.Form frmPreferences Italic = 0 'False Strikethrough = 0 'False EndProperty - Height = 315 + Height = 360 ItemData = "frmPreferences.frx":00E4 Left = 2760 List = "frmPreferences.frx":0100 Style = 2 'Dropdown List TabIndex = 32 TabStop = 0 'False - Top = 7440 + Top = 7590 Width = 1455 End Begin VB.ComboBox cboPolySrc @@ -982,14 +982,14 @@ Begin VB.Form frmPreferences Italic = 0 'False Strikethrough = 0 'False EndProperty - Height = 315 + Height = 360 ItemData = "frmPreferences.frx":0156 Left = 2760 List = "frmPreferences.frx":0172 Style = 2 'Dropdown List TabIndex = 31 TabStop = 0 'False - Top = 7080 + Top = 7230 Width = 1455 End Begin VB.PictureBox picTitle @@ -1038,12 +1038,12 @@ Begin VB.Form frmPreferences Strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& - Height = 375 + Height = 450 Index = 24 Left = 5040 TabIndex = 80 Tag = "font2" - Top = 7440 + Top = 7515 Visible = 0 'False Width = 1575 End @@ -1060,7 +1060,7 @@ Begin VB.Form frmPreferences Strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& - Height = 375 + Height = 450 Index = 23 Left = 5040 TabIndex = 79 @@ -1089,7 +1089,7 @@ Begin VB.Form frmPreferences End Begin VB.Shape fraPref BorderColor = &H000B3C0D& - Height = 1215 + Height = 1365 Index = 5 Left = 4560 Top = 6720 @@ -1515,7 +1515,7 @@ Begin VB.Form frmPreferences Index = 18 Left = 1200 TabIndex = 51 - Top = 6840 + Top = 6915 Width = 1455 End Begin VB.Label lblPref @@ -1536,7 +1536,7 @@ Begin VB.Form frmPreferences Index = 19 Left = 2880 TabIndex = 50 - Top = 6840 + Top = 6915 Width = 1455 End Begin VB.Label lblDirs @@ -1627,7 +1627,7 @@ Begin VB.Form frmPreferences Index = 20 Left = 360 TabIndex = 43 - Top = 7080 + Top = 7230 Width = 735 End Begin VB.Label lblPref @@ -1647,7 +1647,7 @@ Begin VB.Form frmPreferences Index = 21 Left = 360 TabIndex = 42 - Top = 7440 + Top = 7590 Width = 735 End Begin VB.Label lblPref @@ -1721,7 +1721,7 @@ Begin VB.Form frmPreferences End Begin VB.Shape fraPref BorderColor = &H000B3C0D& - Height = 1215 + Height = 1365 Index = 4 Left = 120 Top = 6720 From b85d28b8521ff8a4aebbe11b838aa8703f053ef7 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Wed, 3 Feb 2021 08:42:41 +0100 Subject: [PATCH 46/57] Modify bump version number --- prjSoldatMapEditor.vbp | 4 ++-- pwinstall/pw.nsi | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/prjSoldatMapEditor.vbp b/prjSoldatMapEditor.vbp index 3036fa8..ba8fccf 100644 --- a/prjSoldatMapEditor.vbp +++ b/prjSoldatMapEditor.vbp @@ -29,8 +29,8 @@ Name="PolyWorks" HelpContextID="0" CompatibleMode="0" MajorVer=1 -MinorVer=5 -RevisionVer=13 +MinorVer=6 +RevisionVer=0 AutoIncrementVer=0 ServerSupportFiles=0 VersionComments="Created by Anna Zajaczkowski, updated by Jacob L. (Fryer)." diff --git a/pwinstall/pw.nsi b/pwinstall/pw.nsi index 181d0d3..028e49d 100644 --- a/pwinstall/pw.nsi +++ b/pwinstall/pw.nsi @@ -1,7 +1,7 @@ ; Script generated by the HM NIS Edit Script Wizard. ; HM NIS Edit Wizard helper defines !define PRODUCT_NAME "Soldat PolyWorks" -!define PRODUCT_VERSION "1.5.0.13" +!define PRODUCT_VERSION "1.6.0.0" !define PRODUCT_PUBLISHER "Copyright Anna Zajaczkowski" !define PRODUCT_WEB_SITE "http://forums.soldat.pl" !define PRODUCT_DIR_REGKEY "Software\Microsoft\Windows\CurrentVersion\App Paths\Soldat PolyWorks.exe" From 09fefd0c8abd371070e7896e33b41099a4841c89 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Wed, 3 Feb 2021 08:44:17 +0100 Subject: [PATCH 47/57] Add preliminary change log for 1.6.0.0 --- pwinstall/ReadMe.txt | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/pwinstall/ReadMe.txt b/pwinstall/ReadMe.txt index 0a25956..6e0bdce 100644 --- a/pwinstall/ReadMe.txt +++ b/pwinstall/ReadMe.txt @@ -2,10 +2,10 @@ -Soldat Polyworks 1.5.0.13 +Soldat Polyworks 1.6.0.0 -updated 2014-02-16 +updated 2021-02-03 @@ -61,6 +61,28 @@ Right click with the scenery tool to bring up the main scenery list. +Changes in v1.6.0.0 +- added remember sticky state of tools windows after reopening workspace/pw +- added snapped subwindows stay by the main window if it moved +- added support for collapsing Tools Window +- modified execute form snapping for palette wndow like for other windows +- modified use Arial in Display form +- modified switch from colour to color in filenames and files +- modified switch to Arial as default font +- modified use lowercase pms file extension +- modified replaced pwlib.dll with vb6 gif loading +- modified refresh scenery reloads the complete scenery list not just the selected scenery +- modified sort scenery in 'Scenery' panel +- fixed make text in extended mode in preference form readable with arial font +- fixed preferences dialog disappears and cannot be opened after save error popup +- fixed error on startup due to uninitialized variables +- fixed skipping detailed warning for invalid soldat directory setting/registry key +- fixed position of texture window close button not all the way to the right +- fixed missing textures reset polygons on maximize +- fixed polyworks can't find Soldat directory +- fixed text selection on focus doesn't work +- fixed texture loading errors on startup +- fixed error on missing undo folder Changes in v1.5.0.13 - added flag collides, background, and background transition polygon types From 2aa7907e970d65ed38f9054d4f576d7de1b33719 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Wed, 3 Feb 2021 08:44:43 +0100 Subject: [PATCH 48/57] Modify update version info comments --- prjSoldatMapEditor.vbp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prjSoldatMapEditor.vbp b/prjSoldatMapEditor.vbp index ba8fccf..f9c0339 100644 --- a/prjSoldatMapEditor.vbp +++ b/prjSoldatMapEditor.vbp @@ -33,7 +33,7 @@ MinorVer=6 RevisionVer=0 AutoIncrementVer=0 ServerSupportFiles=0 -VersionComments="Created by Anna Zajaczkowski, updated by Jacob L. (Fryer)." +VersionComments="Created by Anna Zajaczkowski, updated by Jacob L. (Fryer), Gregor A. Cieslak (Shoozza)" VersionCompanyName="Anna Zajaczkowski" CompilationType=0 OptimizationType=0 From 2068ddab6daa2cfbb7cf376400dbe12d168a5ff9 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 4 Feb 2021 01:04:14 +0100 Subject: [PATCH 49/57] Modify save snapped value with either True or False instead of any string --- frmSoldatMapEditor.frm | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 0dc301d..941890a 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -12142,8 +12142,7 @@ Private Sub saveWindow(sectionName As String, window As Form, collapsed As Boole topVal = window.Top / Screen.TwipsPerPixelY iniString = "Visible=" & window.Visible & sNull & "Left=" & leftVal & sNull & "Top=" & topVal & sNull _ - & "Collapsed=" & collapsed & sNull & "Snapped=" & window.Tag & sNull & sNull - + & "Collapsed=" & collapsed & sNull & "Snapped=" & IIf(Len(window.Tag) > 0, "True", "False") & sNull & sNull saveSection sectionName, iniString, appPath & "\workspace\" & FileName @@ -12363,44 +12362,44 @@ Private Sub loadWorkspace(Optional FileName As String = "current.ini") frmTools.xPos = loadInt("Tools", "Left", appPath & "\workspace\" & FileName) frmTools.yPos = loadInt("Tools", "Top", appPath & "\workspace\" & FileName) frmTools.collapsed = loadString("Tools", "Collapsed", appPath & "\workspace\" & FileName) - frmTools.Tag = loadString("Tools", "Snapped", appPath & "\workspace\" & FileName) + frmTools.Tag = IIf(loadString("Tools", "Snapped", appPath & "\workspace\" & FileName) = "True", "snap", "") mnuDisplay.Checked = loadString("Display", "Visible", appPath & "\workspace\" & FileName) frmDisplay.xPos = loadInt("Display", "Left", appPath & "\workspace\" & FileName) frmDisplay.yPos = loadInt("Display", "Top", appPath & "\workspace\" & FileName) frmDisplay.collapsed = loadString("Display", "Collapsed", appPath & "\workspace\" & FileName) - frmDisplay.Tag = loadString("Display", "Snapped", appPath & "\workspace\" & FileName) + frmDisplay.Tag = IIf(loadString("Display", "Snapped", appPath & "\workspace\" & FileName) = "True", "snap", "") mnuInfo.Checked = loadString("Properties", "Visible", appPath & "\workspace\" & FileName) frmInfo.xPos = loadInt("Properties", "Left", appPath & "\workspace\" & FileName) frmInfo.yPos = loadInt("Properties", "Top", appPath & "\workspace\" & FileName) frmInfo.collapsed = loadString("Properties", "Collapsed", appPath & "\workspace\" & FileName) - frmInfo.Tag = loadString("Properties", "Snapped", appPath & "\workspace\" & FileName) + frmInfo.Tag = IIf(loadString("Properties", "Snapped", appPath & "\workspace\" & FileName) = "True", "snap", "") mnuPalette.Checked = loadString("Palette", "Visible", appPath & "\workspace\" & FileName) frmPalette.xPos = loadInt("Palette", "Left", appPath & "\workspace\" & FileName) frmPalette.yPos = loadInt("Palette", "Top", appPath & "\workspace\" & FileName) frmPalette.collapsed = loadString("Palette", "Collapsed", appPath & "\workspace\" & FileName) - frmPalette.Tag = loadString("Palette", "Snapped", appPath & "\workspace\" & FileName) + frmPalette.Tag = IIf(loadString("Palette", "Snapped", appPath & "\workspace\" & FileName) = "True", "snap", "") mnuScenery.Checked = loadString("Scenery", "Visible", appPath & "\workspace\" & FileName) frmScenery.xPos = loadInt("Scenery", "Left", appPath & "\workspace\" & FileName) frmScenery.yPos = loadInt("Scenery", "Top", appPath & "\workspace\" & FileName) frmScenery.collapsed = loadString("Scenery", "Collapsed", appPath & "\workspace\" & FileName) - frmScenery.Tag = loadString("Scenery", "Snapped", appPath & "\workspace\" & FileName) + frmScenery.Tag = IIf(loadString("Scenery", "Snapped", appPath & "\workspace\" & FileName) = "True", "snap", "") frmScenery.Tag = "www" mnuWaypoints.Checked = loadString("Waypoints", "Visible", appPath & "\workspace\" & FileName) frmWaypoints.xPos = loadInt("Waypoints", "Left", appPath & "\workspace\" & FileName) frmWaypoints.yPos = loadInt("Waypoints", "Top", appPath & "\workspace\" & FileName) frmWaypoints.collapsed = loadString("Waypoints", "Collapsed", appPath & "\workspace\" & FileName) - frmWaypoints.Tag = loadString("Waypoints", "Snapped", appPath & "\workspace\" & FileName) + frmWaypoints.Tag = IIf(loadString("Waypoints", "Snapped", appPath & "\workspace\" & FileName) = "True", "snap", "") mnuTexture.Checked = loadString("Texture", "Visible", appPath & "\workspace\" & FileName) frmTexture.xPos = loadInt("Texture", "Left", appPath & "\workspace\" & FileName) frmTexture.yPos = loadInt("Texture", "Top", appPath & "\workspace\" & FileName) frmTexture.collapsed = loadString("Texture", "Collapsed", appPath & "\workspace\" & FileName) - frmTexture.Tag = loadString("Texture", "Snapped", appPath & "\workspace\" & FileName) + frmTexture.Tag = IIf(loadString("Texture", "Snapped", appPath & "\workspace\" & FileName) = "True", "snap", "") Exit Sub From 1cd2f665a3111ee2ef13708f6fd20a7f0876e3b6 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 4 Feb 2021 01:04:37 +0100 Subject: [PATCH 50/57] Add comment with correct formatting of ide casing variables --- frmSoldatMapEditor.frm | 1 + 1 file changed, 1 insertion(+) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 941890a..131f9f2 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -1260,6 +1260,7 @@ Option Explicit ' Fix vb6 ide casing changes #If False Then Dim FileName, color, token, b + ' Dim FileName, color, token, b #End If Dim DX As DirectX8 From c6060a9699170c368cb7aa07916ffa69dfb8da12 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 4 Feb 2021 01:17:55 +0100 Subject: [PATCH 51/57] Modify update release date --- pwinstall/ReadMe.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pwinstall/ReadMe.txt b/pwinstall/ReadMe.txt index 6e0bdce..12965fe 100644 --- a/pwinstall/ReadMe.txt +++ b/pwinstall/ReadMe.txt @@ -5,7 +5,7 @@ Soldat Polyworks 1.6.0.0 -updated 2021-02-03 +updated 2021-02-04 From d8f012f662220a67ee6370ea536b8b8034925a90 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 4 Feb 2021 01:21:34 +0100 Subject: [PATCH 52/57] Modify rename gif files --- .../Help/{tool_pcolour.gif => tool_pcolor.gif} | Bin .../Help/{tool_vcolour.gif => tool_vcolor.gif} | Bin 2 files changed, 0 insertions(+), 0 deletions(-) rename pwinstall/Help/{tool_pcolour.gif => tool_pcolor.gif} (100%) rename pwinstall/Help/{tool_vcolour.gif => tool_vcolor.gif} (100%) diff --git a/pwinstall/Help/tool_pcolour.gif b/pwinstall/Help/tool_pcolor.gif similarity index 100% rename from pwinstall/Help/tool_pcolour.gif rename to pwinstall/Help/tool_pcolor.gif diff --git a/pwinstall/Help/tool_vcolour.gif b/pwinstall/Help/tool_vcolor.gif similarity index 100% rename from pwinstall/Help/tool_vcolour.gif rename to pwinstall/Help/tool_vcolor.gif From 17ce94ea852c599430c490b93f33cd1a4a71ae53 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 4 Feb 2021 01:43:09 +0100 Subject: [PATCH 53/57] Modify format LICENSE file to be best readable in installer --- LICENSE | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/LICENSE b/LICENSE index 409fce3..2503f78 100644 --- a/LICENSE +++ b/LICENSE @@ -13,10 +13,10 @@ furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. From b476dbdc5c2172127849e9454e12a03905333ac8 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 4 Feb 2021 01:43:22 +0100 Subject: [PATCH 54/57] Modify hide branding in installer --- pwinstall/pw.nsi | 3 +++ 1 file changed, 3 insertions(+) diff --git a/pwinstall/pw.nsi b/pwinstall/pw.nsi index 028e49d..353778b 100644 --- a/pwinstall/pw.nsi +++ b/pwinstall/pw.nsi @@ -48,6 +48,9 @@ InstallDir "$PROGRAMFILES\Soldat PolyWorks" InstallDirRegKey HKLM "${PRODUCT_DIR_REGKEY}" "" ShowInstDetails show ShowUnInstDetails show + +BrandingText " " + Section "MainSection" SEC01 SetOutPath "$INSTDIR" From abc467d113ddd51026affc309241565bca8e56b9 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 4 Feb 2021 01:43:42 +0100 Subject: [PATCH 55/57] Modify show license instead of readme on installer license page --- pwinstall/pw.nsi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pwinstall/pw.nsi b/pwinstall/pw.nsi index 353778b..7e3f366 100644 --- a/pwinstall/pw.nsi +++ b/pwinstall/pw.nsi @@ -20,7 +20,7 @@ ; Welcome page !insertmacro MUI_PAGE_WELCOME ; License page -!insertmacro MUI_PAGE_LICENSE "Readme.txt" +!insertmacro MUI_PAGE_LICENSE "../LICENSE" ; Directory page !insertmacro MUI_PAGE_DIRECTORY ; Instfiles page From b27dee14b8d2b21b2a5ee63f7b835b16089f6725 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 4 Feb 2021 01:53:03 +0100 Subject: [PATCH 56/57] Fix scenery window is always snappy on restart (regression) --- frmSoldatMapEditor.frm | 1 - 1 file changed, 1 deletion(-) diff --git a/frmSoldatMapEditor.frm b/frmSoldatMapEditor.frm index 131f9f2..0be5581 100644 --- a/frmSoldatMapEditor.frm +++ b/frmSoldatMapEditor.frm @@ -12389,7 +12389,6 @@ Private Sub loadWorkspace(Optional FileName As String = "current.ini") frmScenery.collapsed = loadString("Scenery", "Collapsed", appPath & "\workspace\" & FileName) frmScenery.Tag = IIf(loadString("Scenery", "Snapped", appPath & "\workspace\" & FileName) = "True", "snap", "") - frmScenery.Tag = "www" mnuWaypoints.Checked = loadString("Waypoints", "Visible", appPath & "\workspace\" & FileName) frmWaypoints.xPos = loadInt("Waypoints", "Left", appPath & "\workspace\" & FileName) frmWaypoints.yPos = loadInt("Waypoints", "Top", appPath & "\workspace\" & FileName) From 271fe3acf0d308ad893e09a5f75f4f2178ea7fd7 Mon Sep 17 00:00:00 2001 From: "Gregor A. Cieslak" Date: Thu, 4 Feb 2021 02:06:45 +0100 Subject: [PATCH 57/57] Add snapped ini setting to default workspace --- pwinstall/Workspace/current.ini | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/pwinstall/Workspace/current.ini b/pwinstall/Workspace/current.ini index 2d4d63c..39457c6 100644 --- a/pwinstall/Workspace/current.ini +++ b/pwinstall/Workspace/current.ini @@ -10,38 +10,46 @@ Visible=True Left=-1 Top=40 Collapsed=False +Snapped=False [Display] Visible=True Left=1071 Top=311 Collapsed=False +Snapped=False [Properties] Visible=True Left=-1 Top=639 Collapsed=False +Snapped=False [Palette] Visible=True Left=1071 Top=40 Collapsed=False +Snapped=False [Scenery] Visible=True Left=1071 Top=470 Collapsed=False +Snapped=False [Waypoints] Visible=True Left=-1 Top=846 Collapsed=False +Snapped=False + [Texture] Visible=True Left=990 Top=40 Collapsed=False +Snapped=False