file_100kb.file 96 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668
  1. VERSION 5.00
  2. Begin VB.UserControl ctl_Gis
  3. BackColor = &H00CBE4F8&
  4. ClientHeight = 7305
  5. ClientLeft = 0
  6. ClientTop = 0
  7. ClientWidth = 7785
  8. DrawWidth = 1000
  9. ScaleHeight = 487
  10. ScaleMode = 3 'Pixel
  11. ScaleWidth = 519
  12. Begin VB.TextBox txt_Tour_Vergleich_Muss_alt
  13. BackColor = &H00C0C0C0&
  14. BeginProperty Font
  15. Name = "MS Sans Serif"
  16. Size = 9.75
  17. Charset = 0
  18. Weight = 400
  19. Underline = 0 'False
  20. Italic = 0 'False
  21. Strikethrough = 0 'False
  22. EndProperty
  23. Height = 270
  24. Left = 1680
  25. TabIndex = 53
  26. Top = 360
  27. Visible = 0 'False
  28. Width = 1095
  29. End
  30. Begin VB.TextBox txt_Tour_Vergleich_Muss
  31. BeginProperty Font
  32. Name = "MS Sans Serif"
  33. Size = 9.75
  34. Charset = 0
  35. Weight = 400
  36. Underline = 0 'False
  37. Italic = 0 'False
  38. Strikethrough = 0 'False
  39. EndProperty
  40. Height = 270
  41. Left = 3900
  42. TabIndex = 52
  43. Tag = "M92"
  44. Top = 1425
  45. Visible = 0 'False
  46. Width = 1455
  47. End
  48. Begin VB.TextBox txt_MausOver_Typ
  49. BackColor = &H00C0FFC0&
  50. Height = 285
  51. Left = 0
  52. TabIndex = 46
  53. Top = 6600
  54. Visible = 0 'False
  55. Width = 1095
  56. End
  57. Begin VB.Frame fme_Eingabewerte
  58. BackColor = &H00C0C0C0&
  59. BorderStyle = 0 'Kein
  60. Caption = "Eingabewerte"
  61. Enabled = 0 'False
  62. Height = 7215
  63. Left = 0
  64. TabIndex = 1
  65. Top = 0
  66. Visible = 0 'False
  67. Width = 2895
  68. Begin VB.TextBox txt_TOUR_muss
  69. BeginProperty Font
  70. Name = "MS Sans Serif"
  71. Size = 9.75
  72. Charset = 0
  73. Weight = 400
  74. Underline = 0 'False
  75. Italic = 0 'False
  76. Strikethrough = 0 'False
  77. EndProperty
  78. Height = 270
  79. Left = 120
  80. TabIndex = 50
  81. Tag = "M82"
  82. Top = 3600
  83. Width = 1455
  84. End
  85. Begin VB.TextBox txt_Tour_Muss_alt
  86. BackColor = &H00C0C0C0&
  87. BeginProperty Font
  88. Name = "MS Sans Serif"
  89. Size = 9.75
  90. Charset = 0
  91. Weight = 400
  92. Underline = 0 'False
  93. Italic = 0 'False
  94. Strikethrough = 0 'False
  95. EndProperty
  96. Height = 270
  97. Left = 1680
  98. TabIndex = 49
  99. Top = 3600
  100. Width = 1095
  101. End
  102. Begin VB.TextBox txt_Fid_kann_alt
  103. BackColor = &H00C0C0C0&
  104. BeginProperty Font
  105. Name = "MS Sans Serif"
  106. Size = 9.75
  107. Charset = 0
  108. Weight = 400
  109. Underline = 0 'False
  110. Italic = 0 'False
  111. Strikethrough = 0 'False
  112. EndProperty
  113. Height = 270
  114. Left = 1680
  115. TabIndex = 48
  116. Top = 2400
  117. Width = 1095
  118. End
  119. Begin VB.TextBox txt_MausOver_ID
  120. BackColor = &H00C0FFC0&
  121. Height = 285
  122. Left = 1080
  123. TabIndex = 47
  124. Top = 6840
  125. Visible = 0 'False
  126. Width = 1095
  127. End
  128. Begin VB.TextBox txt_Mo_Id
  129. Height = 285
  130. Left = 1920
  131. TabIndex = 44
  132. Top = 3120
  133. Width = 855
  134. End
  135. Begin VB.TextBox txt_Kontext
  136. Height = 285
  137. Left = 120
  138. TabIndex = 43
  139. Top = 2880
  140. Width = 2655
  141. End
  142. Begin VB.CheckBox bol_Transportart_alt
  143. Caption = "Check1"
  144. Enabled = 0 'False
  145. Height = 255
  146. Left = 2520
  147. TabIndex = 42
  148. Top = 2640
  149. Width = 255
  150. End
  151. Begin VB.CheckBox bol_Transportart
  152. Caption = "Check1"
  153. Enabled = 0 'False
  154. Height = 255
  155. Left = 2160
  156. TabIndex = 41
  157. Tag = "K21"
  158. Top = 2640
  159. Width = 255
  160. End
  161. Begin VB.TextBox txt_Sofortfahrt_muss_alt
  162. BackColor = &H00C0C0C0&
  163. BeginProperty Font
  164. Name = "MS Sans Serif"
  165. Size = 9.75
  166. Charset = 0
  167. Weight = 400
  168. Underline = 0 'False
  169. Italic = 0 'False
  170. Strikethrough = 0 'False
  171. EndProperty
  172. Height = 270
  173. Left = 1680
  174. TabIndex = 39
  175. Top = 1560
  176. Width = 1095
  177. End
  178. Begin VB.TextBox txt_WID_kann_alt
  179. BackColor = &H00C0C0C0&
  180. BeginProperty Font
  181. Name = "MS Sans Serif"
  182. Size = 9.75
  183. Charset = 0
  184. Weight = 400
  185. Underline = 0 'False
  186. Italic = 0 'False
  187. Strikethrough = 0 'False
  188. EndProperty
  189. Height = 270
  190. Left = 1680
  191. TabIndex = 38
  192. Top = 2040
  193. Width = 1095
  194. End
  195. Begin VB.TextBox txt_FID_muss_alt
  196. BackColor = &H00C0C0C0&
  197. BeginProperty Font
  198. Name = "MS Sans Serif"
  199. Size = 9.75
  200. Charset = 0
  201. Weight = 400
  202. Underline = 0 'False
  203. Italic = 0 'False
  204. Strikethrough = 0 'False
  205. EndProperty
  206. Height = 270
  207. Left = 1680
  208. TabIndex = 37
  209. Top = 1080
  210. Width = 1095
  211. End
  212. Begin VB.TextBox txt_Kid_muss_alt
  213. BackColor = &H00C0C0C0&
  214. BeginProperty Font
  215. Name = "MS Sans Serif"
  216. Size = 9.75
  217. Charset = 0
  218. Weight = 400
  219. Underline = 0 'False
  220. Italic = 0 'False
  221. Strikethrough = 0 'False
  222. EndProperty
  223. Height = 270
  224. Left = 1680
  225. TabIndex = 36
  226. Top = 600
  227. Width = 1095
  228. End
  229. Begin VB.TextBox l_GM_Y_muss
  230. BackColor = &H80000004&
  231. Enabled = 0 'False
  232. BeginProperty Font
  233. Name = "MS Sans Serif"
  234. Size = 9.75
  235. Charset = 0
  236. Weight = 400
  237. Underline = 0 'False
  238. Italic = 0 'False
  239. Strikethrough = 0 'False
  240. EndProperty
  241. Height = 270
  242. Left = 1440
  243. Locked = -1 'True
  244. TabIndex = 35
  245. Tag = "M"
  246. Top = 6480
  247. Width = 1215
  248. End
  249. Begin VB.TextBox l_GM_X_Muss
  250. BackColor = &H80000004&
  251. Enabled = 0 'False
  252. BeginProperty Font
  253. Name = "MS Sans Serif"
  254. Size = 9.75
  255. Charset = 0
  256. Weight = 400
  257. Underline = 0 'False
  258. Italic = 0 'False
  259. Strikethrough = 0 'False
  260. EndProperty
  261. Height = 270
  262. Left = 120
  263. Locked = -1 'True
  264. TabIndex = 33
  265. Tag = "M"
  266. Top = 6480
  267. Width = 1215
  268. End
  269. Begin VB.CheckBox b_Zeige_Objekt
  270. Caption = "Check1"
  271. Enabled = 0 'False
  272. Height = 255
  273. Left = 2400
  274. TabIndex = 31
  275. Top = 6840
  276. Width = 255
  277. End
  278. Begin VB.TextBox l_RR_Anzahl
  279. BackColor = &H80000004&
  280. Enabled = 0 'False
  281. BeginProperty Font
  282. Name = "MS Sans Serif"
  283. Size = 9.75
  284. Charset = 0
  285. Weight = 400
  286. Underline = 0 'False
  287. Italic = 0 'False
  288. Strikethrough = 0 'False
  289. EndProperty
  290. Height = 270
  291. Left = 1440
  292. Locked = -1 'True
  293. TabIndex = 29
  294. Tag = "M"
  295. Top = 6000
  296. Width = 1215
  297. End
  298. Begin VB.TextBox l_RR_Zeitspanne
  299. BackColor = &H80000004&
  300. Enabled = 0 'False
  301. BeginProperty Font
  302. Name = "MS Sans Serif"
  303. Size = 9.75
  304. Charset = 0
  305. Weight = 400
  306. Underline = 0 'False
  307. Italic = 0 'False
  308. Strikethrough = 0 'False
  309. EndProperty
  310. Height = 270
  311. Left = 120
  312. Locked = -1 'True
  313. TabIndex = 27
  314. Tag = "M"
  315. Top = 6000
  316. Width = 1215
  317. End
  318. Begin VB.TextBox txt_Sofortfahrt_muss
  319. BeginProperty Font
  320. Name = "MS Sans Serif"
  321. Size = 9.75
  322. Charset = 0
  323. Weight = 400
  324. Underline = 0 'False
  325. Italic = 0 'False
  326. Strikethrough = 0 'False
  327. EndProperty
  328. Height = 270
  329. Left = 120
  330. TabIndex = 25
  331. Tag = "M42"
  332. Top = 1560
  333. Width = 1455
  334. End
  335. Begin VB.TextBox dat_Fid_bis
  336. BackColor = &H80000004&
  337. Enabled = 0 'False
  338. BeginProperty Font
  339. Name = "MS Sans Serif"
  340. Size = 9.75
  341. Charset = 0
  342. Weight = 400
  343. Underline = 0 'False
  344. Italic = 0 'False
  345. Strikethrough = 0 'False
  346. EndProperty
  347. Height = 270
  348. Left = 1440
  349. Locked = -1 'True
  350. TabIndex = 23
  351. Tag = "M"
  352. Top = 5040
  353. Width = 1215
  354. End
  355. Begin VB.TextBox txt_Adid_muss
  356. BackColor = &H80000004&
  357. Enabled = 0 'False
  358. BeginProperty Font
  359. Name = "MS Sans Serif"
  360. Size = 9.75
  361. Charset = 0
  362. Weight = 400
  363. Underline = 0 'False
  364. Italic = 0 'False
  365. Strikethrough = 0 'False
  366. EndProperty
  367. Height = 270
  368. Left = 120
  369. Locked = -1 'True
  370. TabIndex = 21
  371. Tag = "M"
  372. Top = 5520
  373. Width = 1215
  374. End
  375. Begin VB.TextBox dat_Fid_von
  376. BackColor = &H80000004&
  377. Enabled = 0 'False
  378. BeginProperty Font
  379. Name = "MS Sans Serif"
  380. Size = 9.75
  381. Charset = 0
  382. Weight = 400
  383. Underline = 0 'False
  384. Italic = 0 'False
  385. Strikethrough = 0 'False
  386. EndProperty
  387. Height = 270
  388. Left = 120
  389. Locked = -1 'True
  390. TabIndex = 19
  391. Tag = "M"
  392. Top = 5040
  393. Width = 1215
  394. End
  395. Begin VB.TextBox txt_Lyid_Muss
  396. BackColor = &H80000004&
  397. Enabled = 0 'False
  398. BeginProperty Font
  399. Name = "MS Sans Serif"
  400. Size = 9.75
  401. Charset = 0
  402. Weight = 400
  403. Underline = 0 'False
  404. Italic = 0 'False
  405. Strikethrough = 0 'False
  406. EndProperty
  407. Height = 270
  408. Left = 1440
  409. Locked = -1 'True
  410. TabIndex = 17
  411. Tag = "M"
  412. Top = 4560
  413. Width = 1215
  414. End
  415. Begin VB.TextBox txt_Fid_kann
  416. BeginProperty Font
  417. Name = "MS Sans Serif"
  418. Size = 9.75
  419. Charset = 0
  420. Weight = 400
  421. Underline = 0 'False
  422. Italic = 0 'False
  423. Strikethrough = 0 'False
  424. EndProperty
  425. Height = 270
  426. Left = 120
  427. Locked = -1 'True
  428. TabIndex = 15
  429. Tag = "K32"
  430. Top = 2520
  431. Width = 1095
  432. End
  433. Begin VB.TextBox txt_Wid_muss
  434. BackColor = &H80000004&
  435. Enabled = 0 'False
  436. BeginProperty Font
  437. Name = "MS Sans Serif"
  438. Size = 9.75
  439. Charset = 0
  440. Weight = 400
  441. Underline = 0 'False
  442. Italic = 0 'False
  443. Strikethrough = 0 'False
  444. EndProperty
  445. Height = 270
  446. Left = 120
  447. Locked = -1 'True
  448. TabIndex = 13
  449. Tag = "M"
  450. Top = 4560
  451. Width = 1215
  452. End
  453. Begin VB.TextBox txt_Kid_kann
  454. BackColor = &H80000004&
  455. Enabled = 0 'False
  456. BeginProperty Font
  457. Name = "MS Sans Serif"
  458. Size = 9.75
  459. Charset = 0
  460. Weight = 400
  461. Underline = 0 'False
  462. Italic = 0 'False
  463. Strikethrough = 0 'False
  464. EndProperty
  465. Height = 270
  466. Left = 120
  467. Locked = -1 'True
  468. TabIndex = 11
  469. Tag = "M"
  470. Top = 4080
  471. Width = 1215
  472. End
  473. Begin VB.TextBox txt_WID_kann
  474. BeginProperty Font
  475. Name = "MS Sans Serif"
  476. Size = 9.75
  477. Charset = 0
  478. Weight = 400
  479. Underline = 0 'False
  480. Italic = 0 'False
  481. Strikethrough = 0 'False
  482. EndProperty
  483. Height = 285
  484. Left = 120
  485. TabIndex = 6
  486. Tag = "K21"
  487. Top = 2040
  488. Width = 1455
  489. End
  490. Begin VB.TextBox txt_FID_muss
  491. BeginProperty Font
  492. Name = "MS Sans Serif"
  493. Size = 9.75
  494. Charset = 0
  495. Weight = 400
  496. Underline = 0 'False
  497. Italic = 0 'False
  498. Strikethrough = 0 'False
  499. EndProperty
  500. Height = 285
  501. Left = 120
  502. TabIndex = 4
  503. Tag = "M31"
  504. Top = 1080
  505. Width = 1455
  506. End
  507. Begin VB.TextBox txt_Kid_muss
  508. BeginProperty Font
  509. Name = "MS Sans Serif"
  510. Size = 9.75
  511. Charset = 0
  512. Weight = 400
  513. Underline = 0 'False
  514. Italic = 0 'False
  515. Strikethrough = 0 'False
  516. EndProperty
  517. Height = 270
  518. Left = 120
  519. TabIndex = 2
  520. Tag = "M12"
  521. Top = 600
  522. Width = 1455
  523. End
  524. Begin VB.Label Label5
  525. BackStyle = 0 'Transparent
  526. Caption = "s_Tourpunkte_Muss"
  527. BeginProperty Font
  528. Name = "MS Sans Serif"
  529. Size = 9.75
  530. Charset = 0
  531. Weight = 400
  532. Underline = 0 'False
  533. Italic = 0 'False
  534. Strikethrough = 0 'False
  535. EndProperty
  536. Height = 255
  537. Left = 0
  538. TabIndex = 51
  539. Top = 3360
  540. Width = 2535
  541. End
  542. Begin VB.Label Label11
  543. BackStyle = 0 'Transparent
  544. Caption = "Maus über Element"
  545. BeginProperty Font
  546. Name = "MS Sans Serif"
  547. Size = 9.75
  548. Charset = 0
  549. Weight = 400
  550. Underline = 0 'False
  551. Italic = 0 'False
  552. Strikethrough = 0 'False
  553. EndProperty
  554. Height = 255
  555. Left = 120
  556. TabIndex = 45
  557. Top = 3120
  558. Width = 1815
  559. End
  560. Begin VB.Label Label10
  561. BackStyle = 0 'Transparent
  562. Caption = "b_transportartgerecht"
  563. BeginProperty Font
  564. Name = "MS Sans Serif"
  565. Size = 9.75
  566. Charset = 0
  567. Weight = 400
  568. Underline = 0 'False
  569. Italic = 0 'False
  570. Strikethrough = 0 'False
  571. EndProperty
  572. Height = 255
  573. Left = 120
  574. TabIndex = 40
  575. Top = 2640
  576. Width = 1935
  577. End
  578. Begin VB.Label Label8
  579. BackStyle = 0 'Transparent
  580. Caption = "l_GM_Y_muss"
  581. BeginProperty Font
  582. Name = "MS Sans Serif"
  583. Size = 9.75
  584. Charset = 0
  585. Weight = 400
  586. Underline = 0 'False
  587. Italic = 0 'False
  588. Strikethrough = 0 'False
  589. EndProperty
  590. Height = 255
  591. Index = 7
  592. Left = 1440
  593. TabIndex = 34
  594. Top = 6240
  595. Width = 1215
  596. End
  597. Begin VB.Label deref
  598. BackStyle = 0 'Transparent
  599. Caption = "l_GM_X_muss"
  600. BeginProperty Font
  601. Name = "MS Sans Serif"
  602. Size = 9.75
  603. Charset = 0
  604. Weight = 400
  605. Underline = 0 'False
  606. Italic = 0 'False
  607. Strikethrough = 0 'False
  608. EndProperty
  609. Height = 255
  610. Index = 6
  611. Left = 120
  612. TabIndex = 32
  613. Top = 6240
  614. Width = 1215
  615. End
  616. Begin VB.Label dfere
  617. BackStyle = 0 'Transparent
  618. Caption = "b_Zeige_Obekt"
  619. BeginProperty Font
  620. Name = "MS Sans Serif"
  621. Size = 9.75
  622. Charset = 0
  623. Weight = 400
  624. Underline = 0 'False
  625. Italic = 0 'False
  626. Strikethrough = 0 'False
  627. EndProperty
  628. Height = 255
  629. Left = 120
  630. TabIndex = 30
  631. Top = 6840
  632. Width = 1575
  633. End
  634. Begin VB.Label Label8
  635. BackStyle = 0 'Transparent
  636. Caption = "l_RR_Anzahl"
  637. BeginProperty Font
  638. Name = "MS Sans Serif"
  639. Size = 9.75
  640. Charset = 0
  641. Weight = 400
  642. Underline = 0 'False
  643. Italic = 0 'False
  644. Strikethrough = 0 'False
  645. EndProperty
  646. Height = 255
  647. Index = 5
  648. Left = 1440
  649. TabIndex = 28
  650. Top = 5760
  651. Width = 1215
  652. End
  653. Begin VB.Label Label8
  654. BackStyle = 0 'Transparent
  655. Caption = "l_RR_Zeitsp."
  656. BeginProperty Font
  657. Name = "MS Sans Serif"
  658. Size = 9.75
  659. Charset = 0
  660. Weight = 400
  661. Underline = 0 'False
  662. Italic = 0 'False
  663. Strikethrough = 0 'False
  664. EndProperty
  665. Height = 255
  666. Index = 4
  667. Left = 120
  668. TabIndex = 26
  669. Top = 5760
  670. Width = 1215
  671. End
  672. Begin VB.Label cddfdfdf
  673. BackStyle = 0 'Transparent
  674. Caption = "l_Sofortfahrt_muss"
  675. BeginProperty Font
  676. Name = "MS Sans Serif"
  677. Size = 9.75
  678. Charset = 0
  679. Weight = 400
  680. Underline = 0 'False
  681. Italic = 0 'False
  682. Strikethrough = 0 'False
  683. EndProperty
  684. Height = 375
  685. Left = 120
  686. TabIndex = 24
  687. Top = 1320
  688. Width = 1935
  689. End
  690. Begin VB.Label ldbld
  691. BackStyle = 0 'Transparent
  692. Caption = "dat_Fid_bis"
  693. BeginProperty Font
  694. Name = "MS Sans Serif"
  695. Size = 9.75
  696. Charset = 0
  697. Weight = 400
  698. Underline = 0 'False
  699. Italic = 0 'False
  700. Strikethrough = 0 'False
  701. EndProperty
  702. Height = 255
  703. Left = 1440
  704. TabIndex = 22
  705. Top = 4800
  706. Width = 1095
  707. End
  708. Begin VB.Label Label8
  709. BackStyle = 0 'Transparent
  710. Caption = "s_Aid_muss"
  711. BeginProperty Font
  712. Name = "MS Sans Serif"
  713. Size = 9.75
  714. Charset = 0
  715. Weight = 400
  716. Underline = 0 'False
  717. Italic = 0 'False
  718. Strikethrough = 0 'False
  719. EndProperty
  720. Height = 255
  721. Index = 3
  722. Left = 120
  723. TabIndex = 20
  724. Top = 5280
  725. Width = 1215
  726. End
  727. Begin VB.Label Label9
  728. BackStyle = 0 'Transparent
  729. Caption = "dat_Fid_von"
  730. BeginProperty Font
  731. Name = "MS Sans Serif"
  732. Size = 9.75
  733. Charset = 0
  734. Weight = 400
  735. Underline = 0 'False
  736. Italic = 0 'False
  737. Strikethrough = 0 'False
  738. EndProperty
  739. Height = 255
  740. Left = 120
  741. TabIndex = 18
  742. Top = 4800
  743. Width = 1095
  744. End
  745. Begin VB.Label Label8
  746. BackStyle = 0 'Transparent
  747. Caption = "l_Lyid_muss"
  748. BeginProperty Font
  749. Name = "MS Sans Serif"
  750. Size = 9.75
  751. Charset = 0
  752. Weight = 400
  753. Underline = 0 'False
  754. Italic = 0 'False
  755. Strikethrough = 0 'False
  756. EndProperty
  757. Height = 255
  758. Index = 2
  759. Left = 1440
  760. TabIndex = 16
  761. Top = 4320
  762. Width = 1215
  763. End
  764. Begin VB.Label Label8
  765. BackStyle = 0 'Transparent
  766. Caption = "s_Tourpunkte_muss"
  767. BeginProperty Font
  768. Name = "MS Sans Serif"
  769. Size = 9.75
  770. Charset = 0
  771. Weight = 400
  772. Underline = 0 'False
  773. Italic = 0 'False
  774. Strikethrough = 0 'False
  775. EndProperty
  776. Height = 255
  777. Index = 1
  778. Left = 120
  779. TabIndex = 14
  780. Top = 2280
  781. Width = 1095
  782. End
  783. Begin VB.Label Label8
  784. BackStyle = 0 'Transparent
  785. Caption = "s_Wid_muss"
  786. BeginProperty Font
  787. Name = "MS Sans Serif"
  788. Size = 9.75
  789. Charset = 0
  790. Weight = 400
  791. Underline = 0 'False
  792. Italic = 0 'False
  793. Strikethrough = 0 'False
  794. EndProperty
  795. Height = 255
  796. Index = 0
  797. Left = 120
  798. TabIndex = 12
  799. Top = 4320
  800. Width = 1215
  801. End
  802. Begin VB.Label Label7
  803. BackStyle = 0 'Transparent
  804. Caption = "s_Kid_kann"
  805. BeginProperty Font
  806. Name = "MS Sans Serif"
  807. Size = 9.75
  808. Charset = 0
  809. Weight = 400
  810. Underline = 0 'False
  811. Italic = 0 'False
  812. Strikethrough = 0 'False
  813. EndProperty
  814. Height = 255
  815. Left = 1560
  816. TabIndex = 10
  817. Top = 4080
  818. Width = 1095
  819. End
  820. Begin VB.Label Label6
  821. BackStyle = 0 'Transparent
  822. Caption = "noch nicht umgesetzt:"
  823. BeginProperty Font
  824. Name = "MS Sans Serif"
  825. Size = 9.75
  826. Charset = 0
  827. Weight = 700
  828. Underline = 0 'False
  829. Italic = 0 'False
  830. Strikethrough = 0 'False
  831. EndProperty
  832. Height = 255
  833. Left = 120
  834. TabIndex = 9
  835. Top = 3840
  836. Width = 2535
  837. End
  838. Begin VB.Label Label4
  839. Caption = "Label4"
  840. Height = 255
  841. Left = 0
  842. TabIndex = 8
  843. Top = 0
  844. Width = 15
  845. End
  846. Begin VB.Label Label3
  847. BackStyle = 0 'Transparent
  848. Caption = "s_Wid_kann"
  849. BeginProperty Font
  850. Name = "MS Sans Serif"
  851. Size = 9.75
  852. Charset = 0
  853. Weight = 400
  854. Underline = 0 'False
  855. Italic = 0 'False
  856. Strikethrough = 0 'False
  857. EndProperty
  858. Height = 255
  859. Left = 120
  860. TabIndex = 7
  861. Top = 1800
  862. Width = 2535
  863. End
  864. Begin VB.Label Label2
  865. BackStyle = 0 'Transparent
  866. Caption = "s_Fid_muss"
  867. BeginProperty Font
  868. Name = "MS Sans Serif"
  869. Size = 9.75
  870. Charset = 0
  871. Weight = 400
  872. Underline = 0 'False
  873. Italic = 0 'False
  874. Strikethrough = 0 'False
  875. EndProperty
  876. Height = 255
  877. Left = 120
  878. TabIndex = 5
  879. Top = 840
  880. Width = 2535
  881. End
  882. Begin VB.Label Label1
  883. BackStyle = 0 'Transparent
  884. Caption = "s_Kid_muss"
  885. BeginProperty Font
  886. Name = "MS Sans Serif"
  887. Size = 9.75
  888. Charset = 0
  889. Weight = 400
  890. Underline = 0 'False
  891. Italic = 0 'False
  892. Strikethrough = 0 'False
  893. EndProperty
  894. Height = 255
  895. Left = 120
  896. TabIndex = 3
  897. Top = 360
  898. Width = 2535
  899. End
  900. End
  901. Begin VB.PictureBox pic_Karte
  902. AutoRedraw = -1 'True
  903. BackColor = &H00FFFFFF&
  904. Height = 855
  905. Left = 3000
  906. ScaleHeight = 53
  907. ScaleMode = 3 'Pixel
  908. ScaleWidth = 45
  909. TabIndex = 0
  910. ToolTipText = "Jö schau es funktioniert"
  911. Top = 120
  912. Width = 735
  913. End
  914. Begin VB.Label Label12
  915. BackStyle = 0 'Transparent
  916. Caption = "s_Tourpunkte_Muss"
  917. BeginProperty Font
  918. Name = "MS Sans Serif"
  919. Size = 9.75
  920. Charset = 0
  921. Weight = 400
  922. Underline = 0 'False
  923. Italic = 0 'False
  924. Strikethrough = 0 'False
  925. EndProperty
  926. Height = 255
  927. Left = 120
  928. TabIndex = 54
  929. Top = 120
  930. Width = 2535
  931. End
  932. Begin VB.Menu mnuAuswahl
  933. Caption = "Auswahl"
  934. Begin VB.Menu mnuNeuerMittelpunkt
  935. Caption = "neuer Mittelpunkt"
  936. End
  937. End
  938. End
  939. Attribute VB_Name = "ctl_Gis"
  940. Attribute VB_GlobalNameSpace = False
  941. Attribute VB_Creatable = True
  942. Attribute VB_PredeclaredId = False
  943. Attribute VB_Exposed = False
  944. Option Explicit
  945. '1 (Kunden) 3 Muss/Kann
  946. '2 (Wagen) 4 Muss/Kann
  947. '3 (Fahrten) 2 Muss/Kann
  948. '4 (Rückholer F.) 6 Muss
  949. '5 (Objekte) 1 Muss/Kann
  950. '6 (Karten) 0 Kann
  951. '7 (Adressen) 7 Muss/Kann
  952. '8 (Tourpunkte) 8 Muss '*Konstante im Code mit Typen enthalten !!!
  953. '9 (Tp_Vergleich) 9 Muss '*Konstante im Code mit Typen enthalten !!!
  954. 'Präfix:
  955. 'Als Elemente werden alle darzustellenden Informationspunkte (Kartenteile, Fahrten, Kunden ...) bezeichnet
  956. 'Objekte sind wichtige oder bekannte Punkte im Darsellungsbereich (Krankenhäuser, Theater etc...)
  957. '*** Einstellungen für Zeichnen von Regionen
  958. Private Type LOGBRUSH
  959. lbStyle As Long
  960. lbColor As Long
  961. lbHatch As Long
  962. End Type
  963. 'Regionsfunktionen: - weitere Typen unten
  964. Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
  965. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  966. Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
  967. Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
  968. Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
  969. Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, _
  970. lpPoint As POINTAPI, ByVal nCount As Long) As Long
  971. 'Brush Styles: - weitere Themen unten
  972. Private Const BS_SOLID = 0
  973. 'Hatch Styles
  974. Private Const HS_SOLID = 8
  975. 'Pen Styles
  976. Private Const PS_SOLID = 0
  977. 'PolyFill() Modes
  978. Private Const WINDING = 2
  979. 'Object Definitions for EnumObjects()
  980. Private Const OBJ_PEN = 1
  981. Private Const OBJ_BRUSH = 2
  982. Dim hPenSave As Long, hBrushSave As Long
  983. Dim hRegion() As Long
  984. '**************** Const für derzeitige Doku in Ordnung *******************************
  985. Const C__Teilbild_Grösse_X = 525
  986. Const C__Teilbild_Grösse_Y = 376
  987. Const cVerzBilder = "GisBilder\"
  988. Const C__Muss = "M" 'für automatisiertes Auslesen: ob Kann/Muss Feld
  989. Const C__Kann = "K"
  990. Const cMax_Ebenen = 2 'Anzahl der Darstellungsebenen
  991. Const C__TOUR = 8 'TYP Definition für Tour
  992. Const C__TOUR_Vergleich = 9 'TYP Definition für Tour
  993. 'Interne Variablen
  994. Dim b_Hoechste_Ebene As Boolean 'für Sofortfahrt - ganz zuletzt zeichnen, damit immer sichtbar
  995. 'Eckpunkte für das SQL-Select erweiterter Darstellungsbereiches
  996. Dim d__Get_Px1 As Double
  997. Dim d__Get_Py1 As Double
  998. Dim d__Get_Px2 As Double
  999. Dim d__Get_Py2 As Double
  1000. Dim l__Paint_Status As Long 'Status für Funktion Paint()
  1001. '**************** Variablen bereits in Ordnung ****************************
  1002. 'Interne Hilfsvariabeln für Eigenschaften "
  1003. 'Mittelpunkt Geokoordinaten + -alt
  1004. Dim d__M_Gx As Double
  1005. Dim d__M_Gy As Double
  1006. Dim d__M_Gx_alt As Double
  1007. Dim d__M_Gy_alt As Double
  1008. 'Layerstufe
  1009. Dim l__LYID As Long 'dargestellte LayerID: 10: 64dpi, 20: 128dpi, 30: 338 dpi 0: Automatic
  1010. Dim l__LYID_alt As Long 'dargestellte LayerID: 10: 64dpi, 20: 128dpi, 30: 338 dpi
  1011. Dim d__Zoom As Double 'Umrechnungsfaktor: Pixel in Geokoordinaten
  1012. 'Fixmittelpunkt definieren
  1013. Dim d__M_Gx_Fix As Double
  1014. Dim d__M_Gx_Fix_alt As Double
  1015. Dim d__M_Gy_Fix As Double
  1016. Dim d__M_Gy_Fix_alt As Double
  1017. 'Letzte Mauskoordinaten im Darstellungsbereich für Popupmenü
  1018. Dim si_Maus_X_Popup As Single
  1019. Dim si_Maus_Y_Popup As Single
  1020. 'Mittelpunkt auch anzeigen
  1021. Dim b__Mittelpunkt_anzeigen As Boolean
  1022. 'Variablen grafische Disponierungn
  1023. Dim l_gra_Fid As Long 'Fahrt ID
  1024. Dim l_gra_Wid As Long 'Wagen ID
  1025. Dim l_gra_Lid As Long 'Lenker ID
  1026. '**********************************************************************************************
  1027. '********************* Code alt und undokumentiert ***************************************************
  1028. Dim b_Muss_Felder_Gefunden As Boolean 'Anzahl der Mussfelder fürs Zeichnen
  1029. 'Diese Deklarationen werden teilweise noch nicht verwendet bzw noch nicht richtig dokumentiert
  1030. 'Deklaration für Darstellungsoptionen
  1031. Dim l__RR_Zeitspanne As Long 'Plus-Minus Zeit in Minuten, für die für die
  1032. 'Rückholung in Frage kommende Fahrzeuge
  1033. Dim l__RR_Zeitspanne_alt As Long
  1034. Dim s__KID_muss_alt As String
  1035. Dim s__FID_muss_alt As String
  1036. Dim s__WID_kann_alt As String
  1037. 'Beschreibt Umrandung von Darstellungsfläche
  1038. Private Type typDarstellungsrahmen
  1039. Region As Long
  1040. End Type
  1041. Dim Darstellungsrahmen As typDarstellungsrahmen
  1042. 'Internes Elementarray - Verwaltet alle darzustellende Elemenete
  1043. Private Type st__Elemente
  1044. TYP As Long 'Art des Objektes
  1045. Kontext As String 'Info über beutzerdefinierte Anzeige bei Auswahl Kontext für Element
  1046. Pos1Gx As Long 'GeoX Startposition dieses Elementes
  1047. Pos1Gy As Long 'GeoY Startposition dieses Elementes
  1048. Pos2Gx As Long 'GeoX Endposition dieses Elementes
  1049. Pos2Gy As Long 'GeoY Endposition dieses Elementes
  1050. Pos1Px As Single 'PixX Startposition dieses Elementes
  1051. Pos1Py As Single 'PixY Startposition dieses Elementes
  1052. 'Wenn Element ohne Endposition wird sie durch Startposition ergänzt
  1053. Pos2Px As Single 'PixX Endposition dieses Elementes
  1054. Pos2Py As Single 'PixY Endposition dieses Elementes
  1055. Ebene As Long 'Beschreibt in welchen Ebenendurchlauf das Element gezeichnet wird
  1056. Muss As Boolean 'Definiert Element Ergebnis einer Mussabfrage ist
  1057. RollerPlätze As Long 'Für Wagen Anzahl Rollerplätze
  1058. Transportart As String 'Für Sofortfahrt - Transportart
  1059. Pkw As Boolean 'Für Sofortfahrt
  1060. Id As Long 'ID für Typ
  1061. von_Region As Long
  1062. zw_Region As Long 'Region der Fahrt
  1063. nach_Region As Long 'Region Zielpunkt
  1064. End Type
  1065. Private Type st__Touren_Typ
  1066. st__Touren() As st__Elemente
  1067. Color As Long
  1068. End Type
  1069. Const LOG_Dateiname = "GisCtl.log"
  1070. Dim st__Element() As st__Elemente
  1071. Dim st__Touren() As st__Elemente
  1072. Dim st__Touren_Vergleich() As st__Elemente
  1073. '************ ENDE Code alt und undokumentiert ***************************************************
  1074. 'Events:
  1075. Event MausÜberRegion()
  1076. Event MausÜberRegionKontext(Kontext As String)
  1077. Event Mittelpunktverschiebung(GeoX As Long, GeoY As Long)
  1078. Event FahrtDisponieren(lfid As Long, lshift As Long)
  1079. Event WagenFahrtenZuweisen(lWid As Long, lshift As Long)
  1080. Event RegionfürDisposition(TYP As Long, Id As Long)
  1081. Event ListenAktualisieren(Id As Long)
  1082. Public Sub Mittelpunkt_Fix_Initalisieren()
  1083. d_M_Gx_Fix = 0
  1084. d_M_Gy_Fix = 0
  1085. End Sub
  1086. Private Sub UserControl_Resize() 'Bild für Kartendarstellung an Controlgröße anpassen
  1087. '"UsCoRS"
  1088. ' Anpassen der Figurgröße, damit der sichtbare
  1089. ' Bereich vom Figurbeschriftung-Steuerelement
  1090. ' ausgefüllt wird.
  1091. On Error Resume Next
  1092. Dim s As String
  1093. Debug.Print "Breite Gesamt: " & ScaleWidth
  1094. Debug.Print "Breite Frame: " & fme_Eingabewerte.Width
  1095. Debug.Print "Breite Differenz: " & ScaleWidth - fme_Eingabewerte.Width
  1096. 'Hier wird gecheckt ob Frame links ein- bzw ausgeblendet ist
  1097. 'Wichtig für Größenformatierung
  1098. If fme_Eingabewerte.Visible Then 'eingeblendet
  1099. 'Frame für Eingabewerte an Darstellungsgröße anpassen "UsCoRS-1"
  1100. fme_Eingabewerte.Top = fme_Eingabewerte.Top + 10
  1101. fme_Eingabewerte.Height = ScaleHeight - 20
  1102. 'Darstellungsbereich an Darstellungsgröße anpassen "UsCoRS-2"
  1103. pic_Karte.Move fme_Eingabewerte.Width + 10, _
  1104. 0 + 10, _
  1105. ScaleWidth - fme_Eingabewerte.Width - 20, _
  1106. ScaleHeight - 20
  1107. Else 'nicht eingeblendet
  1108. 'Darstellungsbereich an Darstellungsgröße anpassen "UsCoRS-2"
  1109. pic_Karte.Move 10, _
  1110. 0 + 10, _
  1111. ScaleWidth - 20, _
  1112. ScaleHeight - 20
  1113. End If
  1114. Debug.Print pic_Karte.Left & ", " & pic_Karte.ScaleWidth & ", " & pic_Karte.Top & ", " & pic_Karte.ScaleHeight
  1115. ReDim Preserve st__Element(0) '"UsCoRS-3"
  1116. ReDim Preserve st__Touren(0) '"UsCoRS-3"
  1117. ''Frame für Eingabewerte an Darstellungsgröße anpassen "UsCoRS-1"
  1118. 'fme_Eingabewerte.Top = fme_Eingabewerte.Top + 10
  1119. 'fme_Eingabewerte.Height = ScaleHeight - 20
  1120. '
  1121. ''Darstellungsbereich an Darstellungsgröße anpassen "UsCoRS-2"
  1122. 'pic_Karte.Move fme_Eingabewerte.Width + 10, _
  1123. ' 0 + 10, _
  1124. ' ScaleWidth - fme_Eingabewerte.Width - 20, _
  1125. ' ScaleHeight - 20
  1126. 'Debug.Print pic_Karte.Left & ", " & pic_Karte.ScaleWidth & ", " & pic_Karte.Top & ", " & pic_Karte.ScaleHeight
  1127. 'ReDim Preserve st__Element(0) '"UsCoRS-3"
  1128. 'Darstellungsrahmen definieren
  1129. 'Darstellungsrahmen_definieren Später für Mouseover und Karte verschieben
  1130. End Sub
  1131. Private Sub Darstellungsrahmen_definieren()
  1132. 'MsgBox "Links oben: " & pic_Karte.Left & ", " & pic_Karte.Top & vbCr & _
  1133. ' "Rechts oben: " & pic_Karte.Left + pic_Karte.ScaleWidth & ", " & pic_Karte.Top & vbCr & _
  1134. ' "Rechts unten: " & pic_Karte.Left + pic_Karte.ScaleWidth & ", " & pic_Karte.Top - pic_Karte.ScaleHeight & vbCr & _
  1135. ' "Links unten: " & pic_Karte.Left & ", " & pic_Karte.Top - pic_Karte.ScaleHeight & vbCr
  1136. End Sub
  1137. 'Neuer Mittelpunkt
  1138. Private Sub mnuNeuerMittelpunkt_Click()
  1139. On Error Resume Next
  1140. Dim GDiffX As Long
  1141. Dim GDiffY As Long
  1142. On Error Resume Next
  1143. 'X Berchnung - (1/2 Pixellänge - Mauskkordinaten) / Vergr. Faktor = Diff in GeoKo
  1144. GDiffX = ((pic_Karte.ScaleWidth / 2) - si_Maus_X_Popup) * Me.d_Zoom
  1145. GDiffX = Me.Mp_Gx - GDiffX 'GeoWert von Mittelpunktwert abziehen
  1146. 'Y Berchnung
  1147. GDiffY = ((pic_Karte.ScaleHeight / 2) - si_Maus_Y_Popup) * Me.d_Zoom '(1/2 Pixellänge - Mauskkordinaten) / Vergr. Faktor = Diff in GeoKo
  1148. GDiffY = Me.Mp_Gy + GDiffY 'GeoWert von Mittelpunktwert abziehen
  1149. RaiseEvent Mittelpunktverschiebung(GDiffX, GDiffY) 'Ereignis Mittelpunkt verändern - Wunsch
  1150. End Sub
  1151. Private Sub pic_Karte_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  1152. On Error GoTo ende
  1153. Dim rs As ADODB.Recordset
  1154. Dim SQL As String
  1155. 'Eingefügt Gü. am 15.06.2006
  1156. 'Fahrt grafisch(Maus taste - Drag and Drop) disponieren
  1157. '1.Maus über Region Wagen?
  1158. If txt_MausOver_Typ = 2 Then
  1159. If l_gra_Fid > 0 Then
  1160. 'Wageninfos auslesen
  1161. l_gra_Wid = MausOver_ID 'WagenID = ausgew.Region ID
  1162. Get_Dispo_Wagen_Lenker 'Schreibt 'LenkerID für Wagen
  1163. If l_gra_Lid = 0 Then
  1164. MsgBox "Bitte diesem Wagen erst einen Lenker zuordnen"
  1165. GoTo ende
  1166. End If
  1167. 'Frage ob Disposition?
  1168. Dim k As Long
  1169. k = MsgBox("Ausgewählte Fahrt " & vbCr & _
  1170. "auf Wagen Nr: " & l_gra_Wid & vbCr & _
  1171. "Lenker Nr: " & l_gra_Lid & vbCr & _
  1172. "disponieren?", vbYesNo, "Fahrt disponieren")
  1173. 'Durchführen
  1174. If k = 6 Then 'Yes - disponieren
  1175. If Fahrt_disponieren = 1 Then 'Aufruf Fahrt disponieren
  1176. sub_Info_Anzeigen "Speichern der Fahrt erfolgreich"
  1177. RaiseEvent ListenAktualisieren(fun_Get_Nummer(l_gra_Fid))
  1178. Else
  1179. MsgBox "Beim Disponieren der Fahrt ist ein Fehler aufgetreten"
  1180. End If
  1181. End If
  1182. End If
  1183. End If
  1184. ende:
  1185. 'Status herstellen 'vielleicht nur wenn auch notwendig
  1186. l_gra_Fid = 0
  1187. l_gra_Wid = 0
  1188. l_gra_Lid = 0
  1189. MousePointer = vbNormal
  1190. End Sub
  1191. Private Function Fahrt_disponieren() As Long
  1192. 'Fahrt disponieren hab ich ausgelager, da man hier jetzt auch
  1193. 'bequem Rechte etc einbauen kann - der Hauptcode bleibt übersichtlich
  1194. Dim rs As ADODB.Recordset
  1195. Dim SQL As String
  1196. On Error GoTo fehler
  1197. 'Nochmals checken ob alle Daten vorhanden
  1198. If l_gra_Fid > 0 And _
  1199. l_gra_Wid > 0 Then
  1200. If l_gra_Fid > 0 Then
  1201. SQL = "Update t_fahrten " & _
  1202. " Set Wid = " & fun_Get_Nummer(l_gra_Wid) & ", " & _
  1203. " Lid = " & fun_Get_Nummer(l_gra_Lid) & _
  1204. " WHERE Fid = " & fun_Get_Nummer(l_gra_Fid)
  1205. Set rs = fun_get_RS(SQL)
  1206. If Connection_Fehlerbehandlung("Fehler beim Einlesen " & vbCr & "Standardlenker für Wagen") Then
  1207. sub_Info_Anzeigen "Fahrt erfolgreich disponiert"
  1208. Fahrt_disponieren = 1 'kein Fehler gefunden
  1209. End If
  1210. Else
  1211. MsgBox "Keine Fahrt zum disponieren gefunden"
  1212. End If
  1213. Else
  1214. MsgBox "Wagen oder Lenker nicht vorhanden"
  1215. End If
  1216. Exit Function
  1217. fehler:
  1218. End Function
  1219. Private Sub Get_Dispo_Wagen_Lenker()
  1220. 'Für die Disponierung einer Fahrt wird für
  1221. 'den Wagen auch der Lenker festgelegt
  1222. Dim rs As ADODB.Recordset
  1223. Dim SQL As String
  1224. On Error Resume Next
  1225. SQL = "SELECT lid " & _
  1226. " FROM t_wagen " & _
  1227. " WHERE NOT del " & _
  1228. " AND aktiv " & _
  1229. " AND wid = " & fun_Get_Nummer(l_gra_Wid)
  1230. Set rs = fun_get_RS(SQL)
  1231. If Connection_Fehlerbehandlung("Fehler beim Einlesen " & vbCr & "Standardlenker für Wagen") Then
  1232. l_gra_Lid = fun_Get_Nummer(rs.Fields(0))
  1233. End If
  1234. End Sub
  1235. Private Sub pic_Karte_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1236. si_Maus_X_Popup = x
  1237. si_Maus_Y_Popup = y
  1238. On Error Resume Next
  1239. 'Direktverschiebung über linke Taste
  1240. If Button = 1 Then
  1241. 'Eingefügt Gü. am 15.06.2006
  1242. 'Fahrt grafisch(Maus taste - Drag and Drop) disponieren
  1243. '1.Maus über Region Fahrt?
  1244. Debug.Print "X:" & txt_MausOver_Typ & ":"
  1245. If fun_Get_Nummer(txt_MausOver_Typ) >= 2 And fun_Get_Nummer(txt_MausOver_Typ) <= 4 Then
  1246. RaiseEvent RegionfürDisposition(txt_MausOver_Typ, txt_MausOver_ID)
  1247. MousePointer = ccSize
  1248. If (fun_Get_Nummer(txt_MausOver_Typ) = 3 Or fun_Get_Nummer(txt_MausOver_Typ) = 4) Then
  1249. '1a:ja: 'Fahrt ID merken 'kann man aus txt_MausOver_ID auslesen
  1250. l_gra_Fid = MausOver_ID
  1251. 'kein neuer Mittelpunkt
  1252. Else
  1253. mnuNeuerMittelpunkt_Click
  1254. End If
  1255. Else
  1256. mnuNeuerMittelpunkt_Click
  1257. End If
  1258. Else
  1259. PopupMenu mnuAuswahl 'Popupmenü neuer Mittelpunkt
  1260. End If
  1261. End Sub
  1262. '**************** Eigenschaften sauber ++++++++++
  1263. 'Eigenschaften dieses Ctls
  1264. 'Darstellungsbereich
  1265. Public Property Get DarstB_Left() As String
  1266. On Error Resume Next
  1267. DarstB_Left = pic_Karte.Left
  1268. End Property
  1269. Public Property Get DarstB_Top() As String
  1270. On Error Resume Next
  1271. DarstB_Top = pic_Karte.Top
  1272. End Property
  1273. Public Property Get DarstB_Width() As String
  1274. On Error Resume Next
  1275. DarstB_Width = pic_Karte.ScaleWidth
  1276. End Property
  1277. Public Property Get DarstB_Height() As String
  1278. On Error Resume Next
  1279. DarstB_Height = pic_Karte.Height
  1280. End Property
  1281. 'Mittelpunktbereich
  1282. Public Property Get Mp_Gx() As Double
  1283. On Error Resume Next
  1284. Mp_Gx = d__M_Gx
  1285. End Property
  1286. Private Property Let Mp_Gx(ByVal vNewValue As Double)
  1287. On Error Resume Next
  1288. d__M_Gx = vNewValue
  1289. End Property
  1290. Public Property Get Mp_Gy() As Double
  1291. On Error Resume Next
  1292. Mp_Gy = d__M_Gy
  1293. End Property
  1294. Private Property Let Mp_Gy(ByVal vNewValue As Double)
  1295. On Error Resume Next
  1296. d__M_Gy = vNewValue
  1297. End Property
  1298. Public Property Get Mp_Gx_alt() As Double
  1299. On Error Resume Next
  1300. Mp_Gx_alt = d__M_Gx_alt
  1301. End Property
  1302. Private Property Let Mp_Gx_alt(ByVal vNewValue As Double)
  1303. On Error Resume Next
  1304. d__M_Gx_alt = vNewValue
  1305. End Property
  1306. Public Property Get Mp_Gy_alt() As Double
  1307. On Error Resume Next
  1308. Mp_Gy_alt = d__M_Gy_alt
  1309. End Property
  1310. Private Property Let Mp_Gy_alt(ByVal vNewValue As Double)
  1311. On Error Resume Next
  1312. d__M_Gy_alt = vNewValue
  1313. End Property
  1314. 'SQL - Abfrage Where Parameter
  1315. Public Property Get s_KID_muss() As String
  1316. On Error Resume Next
  1317. s_KID_muss = txt_KID_muss
  1318. End Property
  1319. Public Property Let s_KID_muss(ByVal vNewValue As String)
  1320. On Error Resume Next
  1321. txt_KID_muss = vNewValue
  1322. End Property
  1323. Public Property Get s_FID_muss() As String
  1324. On Error Resume Next
  1325. s_FID_muss = txt_FID_muss
  1326. End Property
  1327. Public Property Let s_FID_muss(ByVal vNewValue As String)
  1328. On Error Resume Next
  1329. txt_FID_muss = vNewValue
  1330. End Property
  1331. Public Property Get s_FID_kann() As String
  1332. On Error Resume Next
  1333. s_FID_kann = txt_FID_kann
  1334. End Property
  1335. Public Property Let s_FID_kann(ByVal vNewValue As String)
  1336. On Error Resume Next
  1337. txt_FID_kann = vNewValue
  1338. End Property
  1339. Public Property Get s_WID_kann() As String
  1340. On Error Resume Next
  1341. s_WID_kann = txt_Wid_kann
  1342. End Property
  1343. Public Property Let s_WID_kann(ByVal vNewValue As String)
  1344. On Error Resume Next
  1345. txt_Wid_kann = vNewValue
  1346. End Property
  1347. Public Property Get s_Tour_muss() As String
  1348. On Error Resume Next
  1349. s_Tour_muss = txt_TOUR_muss
  1350. End Property
  1351. Public Property Let s_Tour_muss(ByVal vNewValue As String)
  1352. On Error Resume Next
  1353. txt_TOUR_muss = vNewValue
  1354. End Property
  1355. Public Property Get s_Tour_Vergleich_muss() As String
  1356. On Error Resume Next
  1357. s_Tour_muss = txt_Tour_Vergleich_Muss
  1358. End Property
  1359. Public Property Let s_Tour_Vergleich_muss(ByVal vNewValue As String)
  1360. On Error Resume Next
  1361. txt_Tour_Vergleich_Muss = vNewValue
  1362. End Property
  1363. 'Sofortfahrt
  1364. Public Property Get l_Sofortfahrt_muss() As String
  1365. On Error Resume Next
  1366. l_Sofortfahrt_muss = txt_Sofortfahrt_muss
  1367. End Property
  1368. Public Property Let s_Sofortfahrt_muss(ByVal vNewValue As String)
  1369. On Error Resume Next
  1370. txt_Sofortfahrt_muss = vNewValue
  1371. End Property
  1372. 'Layerstufe
  1373. Public Property Get l_LYID() As Long
  1374. On Error Resume Next
  1375. l_LYID = l__LYID
  1376. End Property
  1377. Public Property Let l_LYID(ByVal vNewValue As Long)
  1378. On Error Resume Next
  1379. l__LYID = vNewValue
  1380. End Property
  1381. Private Property Get l_LYID_alt() As Long
  1382. On Error Resume Next
  1383. l_LYID_alt = l__LYID_alt
  1384. End Property
  1385. Private Property Let l_LYID_alt(ByVal vNewValue As Long)
  1386. On Error Resume Next
  1387. l__LYID_alt = vNewValue
  1388. End Property
  1389. Public Property Get d_Zoom() As Double
  1390. On Error Resume Next
  1391. d_Zoom = d__Zoom
  1392. End Property
  1393. Public Property Let d_Zoom(ByVal vNewValue As Double)
  1394. On Error Resume Next
  1395. d__Zoom = vNewValue
  1396. End Property
  1397. 'Größe der Karte (als Bild)
  1398. Public Property Get l_Bild_x() As Double
  1399. On Error Resume Next
  1400. l_Bild_x = C__Teilbild_Grösse_X
  1401. End Property
  1402. Public Property Get l_Bild_y() As Double
  1403. On Error Resume Next
  1404. l_Bild_y = C__Teilbild_Grösse_Y
  1405. End Property
  1406. 'Darstellungsebenen
  1407. Public Property Get Darstellungsebenen() As Double
  1408. On Error Resume Next
  1409. Darstellungsebenen = cMax_Ebenen
  1410. End Property
  1411. 'Maus über Region
  1412. Public Property Get MausOver_Typ() As Long
  1413. On Error Resume Next
  1414. MausOver_Typ = fun_Get_Nummer(txt_MausOver_Typ)
  1415. End Property
  1416. Public Property Get MausOver_ID() As Long
  1417. On Error Resume Next
  1418. MausOver_ID = fun_Get_Nummer(txt_MausOver_ID)
  1419. End Property
  1420. 'FixMittelpunkt zuweisen
  1421. Public Property Get d_M_Gx_Fix() As Double
  1422. On Error Resume Next
  1423. d_M_Gx_Fix = d__M_Gx_Fix
  1424. End Property
  1425. Public Property Let d_M_Gx_Fix(ByVal vNewValue As Double)
  1426. On Error Resume Next
  1427. d__M_Gx_Fix = vNewValue
  1428. End Property
  1429. Public Property Get d_M_Gy_Fix() As Double
  1430. On Error Resume Next
  1431. d_M_Gy_Fix = d__M_Gy_Fix
  1432. End Property
  1433. Public Property Let d_M_Gy_Fix(ByVal vNewValue As Double)
  1434. On Error Resume Next
  1435. d__M_Gy_Fix = vNewValue
  1436. End Property
  1437. Public Property Get b_Mittelpunkt_anzeigen() As Boolean
  1438. On Error Resume Next
  1439. b_Mittelpunkt_anzeigen = b__Mittelpunkt_anzeigen
  1440. End Property
  1441. Public Property Let b_Mittelpunkt_anzeigen(ByVal vNewValue As Boolean)
  1442. On Error Resume Next
  1443. b__Mittelpunkt_anzeigen = vNewValue
  1444. End Property
  1445. '**************** Ende *******************+++
  1446. Sub GISLOG(s_Aufruf_Stelle As String) '"GISLOG"
  1447. 'Informationen über Parameter werden in eine Datei geschrieben eher unbedeutend derzeit
  1448. Dim s As String
  1449. On Error Resume Next
  1450. s = LOG_Dateiname
  1451. txt_AppendLine s, " "
  1452. txt_AppendLine s, "*****" & s_Aufruf_Stelle & " " & Now & " ********"
  1453. txt_AppendLine LOG_Dateiname, "l__Paint_Status: " & l__Paint_Status
  1454. txt_AppendLine LOG_Dateiname, "d__Zoom: " & d__Zoom
  1455. txt_AppendLine LOG_Dateiname, "Layerstufe alt: " & l_LYID_alt & " neu: " & l_LYID
  1456. txt_AppendLine LOG_Dateiname, "d__Get_Px1: " & d__Get_Px1
  1457. txt_AppendLine LOG_Dateiname, "d__Get_Py1: " & d__Get_Py1
  1458. txt_AppendLine LOG_Dateiname, "d__Get_Px2: " & d__Get_Px2
  1459. txt_AppendLine LOG_Dateiname, "d__Get_Py2: " & d__Get_Py2
  1460. txt_AppendLine LOG_Dateiname, "d__M_Gx: " & Mp_Gx
  1461. txt_AppendLine LOG_Dateiname, "d__M_Gy: " & Mp_Gy
  1462. End Sub
  1463. Public Sub Initalize(i As Long) '"Initalize"
  1464. 'Initalisiert Paint_Status mit übergegebenen Wert
  1465. 'Diese Routine ist mehr als fraglich ??
  1466. On Error Resume Next
  1467. l__Paint_Status = i
  1468. End Sub
  1469. Private Sub Pixelkoordinaten_für_Elemente() '"PiKoo_Elemente"
  1470. 'Bestimmt für jedes Element die Pixelposition aufgrund Koordinaten, Typen und Layerinformation
  1471. Dim M As GeoPunkt
  1472. Dim B As GeoPunkt
  1473. Dim Diff As GeoPunkt
  1474. Dim R As GeoPunkt
  1475. Dim R1 As GeoPunkt
  1476. Dim l_Faktor_X As Long
  1477. Dim l_Faktor_Y As Long
  1478. On Error Resume Next
  1479. 'Interner GeoMittelpunkt (diese Werte sind schon wo festgelegt
  1480. '"PiKoo_Elemente - 1"
  1481. M.Gx = Mp_Gx
  1482. M.Gy = Mp_Gy
  1483. M.Px = DarstB_Width / 2
  1484. M.Py = DarstB_Height / 2
  1485. Dim J As Long
  1486. Dim x As Long
  1487. Dim i As Long
  1488. 'Erstmals Ecke Rechts oben von Bilder holen "PiKoo_Elemente - 2"
  1489. For J = 0 To UBound(st__Element) - 1 '1.Element von diesem Typ ist richtiger Darstellungsbereich
  1490. If st__Element(J).TYP = 6 Then 'Das Bild rechts oben wird von allen Bildern immer das 1.sein,
  1491. 'da nach x, y sortiert eingelesen wird
  1492. R1.Gx = st__Element(J).Pos1Gx
  1493. R1.Gy = st__Element(J).Pos1Gy
  1494. R1.Px = M.Px - (M.Gx - R1.Gx) / d__Zoom
  1495. R1.Py = M.Py + (M.Gy - R1.Gy) / d__Zoom
  1496. Exit For
  1497. End If
  1498. Next
  1499. ''Für jedes Element Positionen errechnen "PiKoo_Elemente - 3"
  1500. For J = 0 To UBound(st__Element) - 1
  1501. For x = 1 To 2 'Von und Zieladresse
  1502. If x = 1 Then
  1503. Debug.Print st__Element(J).TYP
  1504. B.Gx = st__Element(J).Pos1Gx 'Geokoordinaten zuweisen
  1505. B.Gy = st__Element(J).Pos1Gy
  1506. Else
  1507. B.Gx = st__Element(J).Pos2Gx
  1508. B.Gy = st__Element(J).Pos2Gy
  1509. End If
  1510. Dim dDiff_in_Meter_Abzug_X As Double
  1511. Dim dDiff_in_Meter_Abzug_Y As Double
  1512. Select Case st__Element(J).TYP
  1513. Case 6
  1514. 'Geodifferenz Rechteck - Bild
  1515. dDiff_in_Meter_Abzug_X = R1.Gx
  1516. dDiff_in_Meter_Abzug_Y = R1.Gy
  1517. Case Else
  1518. 'Differenz in Meter ausrechnen
  1519. dDiff_in_Meter_Abzug_X = Mp_Gx
  1520. dDiff_in_Meter_Abzug_Y = Mp_Gy
  1521. End Select
  1522. Diff.Gx = B.Gx - dDiff_in_Meter_Abzug_X 'Geodifferenz
  1523. Diff.Gy = B.Gy - dDiff_in_Meter_Abzug_Y
  1524. Diff.Px = Diff.Gx / d__Zoom 'Pixeldifferenz Rechteck - Bild
  1525. Diff.Py = Diff.Gy / d__Zoom
  1526. Select Case st__Element(J).TYP
  1527. Case 6
  1528. 'Warum weiß ich noch nicht genau ??
  1529. l_Faktor_X = Diff.Px / l_Bild_x
  1530. l_Faktor_Y = Diff.Py / l_Bild_y
  1531. 'Pixelfaktor für Bild zuweisen
  1532. st__Element(J).Pos1Px = R1.Px + l_Faktor_X * l_Bild_x
  1533. st__Element(J).Pos1Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
  1534. 'Gibt's nur einen Punkt, das ist eigentlich unnötig
  1535. st__Element(J).Pos2Px = R1.Px + l_Faktor_X * l_Bild_x
  1536. st__Element(J).Pos2Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
  1537. Case Else
  1538. If x = 1 Then
  1539. ' Punkt auf der Karte ausrechnen
  1540. st__Element(J).Pos1Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
  1541. st__Element(J).Pos1Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
  1542. Else
  1543. st__Element(J).Pos2Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
  1544. st__Element(J).Pos2Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
  1545. End If
  1546. End Select
  1547. Next
  1548. Next
  1549. 'Für jede Tour Pixelkoordinaten errechnen
  1550. For J = 0 To UBound(st__Touren) - 1
  1551. For x = 1 To 2 'Von und Zieladresse
  1552. If x = 1 Then
  1553. Debug.Print st__Touren(J).TYP
  1554. B.Gx = st__Touren(J).Pos1Gx 'Geokoordinaten zuweisen
  1555. B.Gy = st__Touren(J).Pos1Gy
  1556. Else
  1557. B.Gx = st__Touren(J).Pos2Gx
  1558. B.Gy = st__Touren(J).Pos2Gy
  1559. End If
  1560. Select Case st__Touren(J).TYP
  1561. Case 6
  1562. 'Geodifferenz Rechteck - Bild
  1563. dDiff_in_Meter_Abzug_X = R1.Gx
  1564. dDiff_in_Meter_Abzug_Y = R1.Gy
  1565. Case Else
  1566. 'Differenz in Meter ausrechnen
  1567. dDiff_in_Meter_Abzug_X = Mp_Gx
  1568. dDiff_in_Meter_Abzug_Y = Mp_Gy
  1569. End Select
  1570. Diff.Gx = B.Gx - dDiff_in_Meter_Abzug_X 'Geodifferenz
  1571. Diff.Gy = B.Gy - dDiff_in_Meter_Abzug_Y
  1572. Diff.Px = Diff.Gx / d__Zoom 'Pixeldifferenz Rechteck - Bild
  1573. Diff.Py = Diff.Gy / d__Zoom
  1574. Select Case st__Touren(J).TYP
  1575. Case 6
  1576. 'Warum weiß ich noch nicht genau ??
  1577. l_Faktor_X = Diff.Px / l_Bild_x
  1578. l_Faktor_Y = Diff.Py / l_Bild_y
  1579. 'Pixelfaktor für Bild zuweisen
  1580. st__Touren(J).Pos1Px = R1.Px + l_Faktor_X * l_Bild_x
  1581. st__Touren(J).Pos1Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
  1582. 'Gibt's nur einen Punkt, das ist eigentlich unnötig
  1583. st__Touren(J).Pos2Px = R1.Px + l_Faktor_X * l_Bild_x
  1584. st__Touren(J).Pos2Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
  1585. Case Else
  1586. If x = 1 Then
  1587. ' Punkt auf der Karte ausrechnen
  1588. st__Touren(J).Pos1Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
  1589. st__Touren(J).Pos1Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
  1590. Else
  1591. st__Touren(J).Pos2Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
  1592. st__Touren(J).Pos2Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
  1593. End If
  1594. End Select
  1595. Next
  1596. Next
  1597. 'Für jede Tour Pixelkoordinaten errechnen
  1598. For J = 0 To UBound(st__Touren_Vergleich) - 1
  1599. For x = 1 To 2 'Von und Zieladresse
  1600. If x = 1 Then
  1601. Debug.Print st__Touren_Vergleich(J).TYP
  1602. B.Gx = st__Touren_Vergleich(J).Pos1Gx 'Geokoordinaten zuweisen
  1603. B.Gy = st__Touren_Vergleich(J).Pos1Gy
  1604. Else
  1605. B.Gx = st__Touren_Vergleich(J).Pos2Gx
  1606. B.Gy = st__Touren_Vergleich(J).Pos2Gy
  1607. End If
  1608. Select Case st__Touren_Vergleich(J).TYP
  1609. Case 6
  1610. 'Geodifferenz Rechteck - Bild
  1611. dDiff_in_Meter_Abzug_X = R1.Gx
  1612. dDiff_in_Meter_Abzug_Y = R1.Gy
  1613. Case Else
  1614. 'Differenz in Meter ausrechnen
  1615. dDiff_in_Meter_Abzug_X = Mp_Gx
  1616. dDiff_in_Meter_Abzug_Y = Mp_Gy
  1617. End Select
  1618. Diff.Gx = B.Gx - dDiff_in_Meter_Abzug_X 'Geodifferenz
  1619. Diff.Gy = B.Gy - dDiff_in_Meter_Abzug_Y
  1620. Diff.Px = Diff.Gx / d__Zoom 'Pixeldifferenz Rechteck - Bild
  1621. Diff.Py = Diff.Gy / d__Zoom
  1622. Select Case st__Touren_Vergleich(J).TYP
  1623. Case 6
  1624. 'Warum weiß ich noch nicht genau ??
  1625. l_Faktor_X = Diff.Px / l_Bild_x
  1626. l_Faktor_Y = Diff.Py / l_Bild_y
  1627. 'Pixelfaktor für Bild zuweisen
  1628. st__Touren_Vergleich(J).Pos1Px = R1.Px + l_Faktor_X * l_Bild_x
  1629. st__Touren_Vergleich(J).Pos1Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
  1630. 'Gibt's nur einen Punkt, das ist eigentlich unnötig
  1631. st__Touren_Vergleich(J).Pos2Px = R1.Px + l_Faktor_X * l_Bild_x
  1632. st__Touren_Vergleich(J).Pos2Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
  1633. Case Else
  1634. If x = 1 Then
  1635. ' Punkt auf der Karte ausrechnen
  1636. st__Touren_Vergleich(J).Pos1Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
  1637. st__Touren_Vergleich(J).Pos1Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
  1638. Else
  1639. st__Touren_Vergleich(J).Pos2Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
  1640. st__Touren_Vergleich(J).Pos2Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
  1641. End If
  1642. End Select
  1643. Next
  1644. Next
  1645. End Sub
  1646. Public Sub sub_Finden_Region(Button As Integer, Shift As Integer, x As Single, y As Single)
  1647. '* "FinReg"
  1648. '* Diese Routine checkt ob sich die aktuelle Mausposition auf einer Elementenregion befindet
  1649. Dim i As Long
  1650. On Error Resume Next
  1651. pic_Karte.ToolTipText = "" 'Zurücksetzen
  1652. txt_MausOver_ID = vbNullString 'Auch zurücksezten
  1653. txt_MausOver_Typ = vbNullString 'Auch zurücksetzen
  1654. For i = 0 To UBound(st__Element) - 1
  1655. Debug.Print st__Element(i).Kontext & ": " & st__Element(i).von_Region
  1656. If PtInRegion(st__Element(i).von_Region, x, y) Or _
  1657. PtInRegion(st__Element(i).nach_Region, x, y) Or _
  1658. PtInRegion(st__Element(i).zw_Region, x, y) Then
  1659. pic_Karte.ToolTipText = st__Element(i).Kontext 'Zurücksetzen
  1660. 'Dieses Event kann eingesetzt werden um den GisViewer maßgeblich am erstellen
  1661. 'des Kontextmenü mitwirken zu lassen
  1662. 'RaiseEvent MausÜberRegionKontext(st__Element(i).Kontext) 'An GisViewer übergeben
  1663. txt_Mo_Id = st__Element(i).Id ' ??schreibt ID für Typ auf das sich das Mouseover bezieht
  1664. 'Checkt ob sich Region verändert hat
  1665. 'Gehört wahrscheinlich noch weiter rauf
  1666. Dim Id As String
  1667. Dim TYP As String
  1668. Id = st__Element(i).Id
  1669. TYP = st__Element(i).TYP
  1670. If (txt_MausOver_ID <> Id) Or _
  1671. (txt_MausOver_Typ <> TYP) Then
  1672. 'Schreibt Typ und ID von gefundener Region für externe Verarbeitung
  1673. txt_MausOver_ID = Id
  1674. txt_MausOver_Typ = TYP
  1675. Select Case TYP
  1676. 'Für Typenspezifische Behandlung
  1677. End Select
  1678. 'Wenn sich Region verändert hat, Ereignis auslösen
  1679. RaiseEvent MausÜberRegion 'löst ein Ereignis aus
  1680. End If
  1681. Exit Sub 'Abbruch, da sonst drunterliegende Regionen noch gefunden werden
  1682. End If
  1683. Next
  1684. End Sub
  1685. Private Sub pic_Karte_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  1686. '* "MouMov" -- Maus wurde bewegt, ist sie über Elementregion?
  1687. On Error Resume Next
  1688. sub_Finden_Region Button, Shift, x, y 'Sucht Region zu ausgewählten Mausbereich
  1689. 'Schreibt gewollte Informationen
  1690. End Sub
  1691. Sub Elemente_Reload_muss()
  1692. '"Ele-Rel"
  1693. 'Alle lemente für die Paint Funktion werden neu augebaut
  1694. '* Auch diese Funktion ist mehr als fraglich
  1695. On Error GoTo Abbr
  1696. ReDim st__Element(0)
  1697. ReDim st__Touren(0)
  1698. ReDim st__Touren_Vergleich(0)
  1699. Exit Sub
  1700. Abbr:
  1701. MsgBox "Fehler in Gis Darstellung -> Elemente_muss_Reload()"
  1702. End Sub
  1703. Public Sub Wertzuweisen(ctrName As String, ctrWert As Variant, Optional ctrBackColor As String)
  1704. '"Wert_zuw"
  1705. '* Diese Funktion weist einem bestimmten Feld Farbe und Wert zu.
  1706. On Error Resume Next
  1707. If LCase(MID(ctrName, 1, 3)) = "bol" Then
  1708. Controls(ctrName).Value = ctrWert
  1709. Else
  1710. Controls(ctrName).Text = ctrWert
  1711. End If
  1712. If ctrBackColor <> vbNullString Then
  1713. Controls(ctrName).BackColor = ctrBackColor
  1714. End If
  1715. End Sub
  1716. Public Property Get s_Darstellungsbereich_Where() As String
  1717. '"Dar_Where"
  1718. '*Liefert für SQl Abfrage die GeoKoordinaten für den Darstellungsbereich
  1719. On Error Resume Next
  1720. s_Darstellungsbereich_Where = " AND pos1gx >= " & Int(d__Get_Px1) & _
  1721. " AND pos1gx <= " & Int(d__Get_Px2) & _
  1722. " AND pos1gy >= " & Int(d__Get_Py1) & _
  1723. " AND pos1gy <= " & Int(d__Get_Py2)
  1724. End Property
  1725. Sub Elemente_Typ_Reload_neu(TYP As Long, Muss As Boolean, Ebene As Long)
  1726. ' "Ele_Typ_Rel"
  1727. '*Diese Prozedur ist für das Neuladen der richtigen Elemente für den
  1728. '*übergebenen Typen zuständig
  1729. On Error Resume Next
  1730. Dim i As Long
  1731. Dim k As Long
  1732. Dim SQL As String
  1733. Dim rs As ADODB.Recordset
  1734. 'Alle Elemente vom Typen aus Array st__Element entfernen
  1735. '"Ele_Typ_Rel - 1" *Das wäre super, wenn man eine Schleife pro Spalte machen könnte
  1736. 'Touren
  1737. If TYP = C__TOUR Then
  1738. ReDim st__Touren(0)
  1739. End If
  1740. 'Vergleichstouren
  1741. If TYP = C__TOUR_Vergleich Then
  1742. ReDim st__Touren_Vergleich(0)
  1743. End If
  1744. If UBound(st__Element) > 0 Then
  1745. For i = 0 To UBound(st__Element) - 1 'Array durcharbeiten
  1746. If i > UBound(st__Element) - 1 Then
  1747. GoTo OK
  1748. End If
  1749. 'Eingefügt am 03.07.2006 Gü
  1750. 'Wenn Tourpunkt dann einfach Touren neu - derzeit nur 1 Tour möglich
  1751. If st__Element(i).TYP = TYP Then
  1752. For k = i To UBound(st__Element) - 1
  1753. If k > UBound(st__Element) - 1 Then
  1754. Debug.Print "jo"
  1755. End If
  1756. st__Element(k).TYP = st__Element(k + 1).TYP
  1757. st__Element(k).Ebene = st__Element(k + 1).Ebene
  1758. st__Element(k).Kontext = st__Element(k + 1).Kontext
  1759. st__Element(k).Muss = st__Element(k + 1).Muss
  1760. st__Element(k).Pos1Gx = st__Element(k + 1).Pos1Gx
  1761. st__Element(k).Pos1Gy = st__Element(k + 1).Pos1Gy
  1762. st__Element(k).Pos2Gx = st__Element(k + 1).Pos2Gx
  1763. st__Element(k).Pos2Gy = st__Element(k + 1).Pos2Gy
  1764. st__Element(k).Pos1Px = st__Element(k + 1).Pos1Px
  1765. st__Element(k).Pos1Py = st__Element(k + 1).Pos1Py
  1766. st__Element(k).Pos2Px = st__Element(k + 1).Pos2Px
  1767. st__Element(k).Pos2Py = st__Element(k + 1).Pos2Py
  1768. st__Element(k).RollerPlätze = st__Element(k + 1).RollerPlätze
  1769. st__Element(k).Transportart = st__Element(k + 1).Transportart
  1770. st__Element(k).Pkw = st__Element(k + 1).Pkw
  1771. st__Element(k).Id = st__Element(k + 1).Id
  1772. 'l__Paint_Status = 1 'Status 1 Mittelpunkt muss neu berechnet werden
  1773. Next
  1774. i = i - 1 'Wieder um 1 zurück da 1 Element gelöscht wird
  1775. ReDim Preserve st__Element(UBound(st__Element) - 1)
  1776. End If
  1777. Next
  1778. End If
  1779. 'Informationsteil - Ausgabe von Infos in Datei
  1780. '"Ele_Typ_Rel - 2"
  1781. 'Hier sollte man vielleicht ein Tastenkürzel oder Bit einführen um dies zu aktivieren deaktivieren
  1782. txt_WriteAll "C:GisCtl_Elemente.txt", "Elemente für letzte Darstellung, Typ : Kontext"
  1783. For i = 0 To UBound(st__Element) - 1 'Array durcharbeiten
  1784. txt_AppendLine "C:GisCtl_Elemente.txt", TYP & ":" & st__Element(i).Kontext
  1785. Next
  1786. 'Hier wird die SQl - Abfrage für den gewünschten Elementyp zusammengebaut
  1787. '"Ele_Typ_Rel - 3"
  1788. OK:
  1789. '1 (Kunden) 3 Muss/Kann
  1790. '2 (Wagen) 4 Muss/Kann
  1791. '3 (Fahrten) 2 Muss/Kann
  1792. '4 (Rückholer F.) 6 Muss
  1793. '5 (Objekte) 1 Muss/Kann
  1794. '6 (Karten) 0 Kann
  1795. '7 (Adressen) 7 Muss/Kann
  1796. '8 (Tourpunkte) 8 Muss
  1797. Dim sql_Typ As String
  1798. Dim sql_Muss As String
  1799. If Muss Then
  1800. sql_Muss = "True as muss, "
  1801. Else
  1802. sql_Muss = "False as muss, "
  1803. End If
  1804. sql_Typ = "SELECT * " & _
  1805. "FROM "
  1806. Debug.Print s_Tour_muss
  1807. Select Case TYP
  1808. Case 1 'Kunde
  1809. If s_KID_muss <> vbNullString Then
  1810. SQL = sql_Typ & _
  1811. "v_gis_kunden WHERE " & s_KID_muss
  1812. Debug.Print SQL
  1813. End If
  1814. Case 2 'Wagen
  1815. If Me.s_WID_kann <> vbNullString Then
  1816. 'Hier sollte auch der Wert von b_Transportart gecheckt werden
  1817. txt_Wid_kann = txt_Wid_kann & s_Darstellungsbereich_Where
  1818. 'Transportart orientiert anzeigen - verarbeiten
  1819. If bol_Transportart Then 'nur wenn auch transportartorientiertes Anzeigen verlangt
  1820. txt_Wid_kann = txt_Wid_kann & fun_SQL_Where_Transportart()
  1821. End If
  1822. SQL = sql_Typ & "v_gis_wid WHERE " & txt_Wid_kann
  1823. Debug.Print SQL
  1824. End If
  1825. Case 3 'Fahrten
  1826. If Muss Then
  1827. If s_FID_muss <> vbNullString Then
  1828. SQL = sql_Typ & _
  1829. "v_gis_fahrten WHERE " & s_FID_muss
  1830. End If
  1831. Else
  1832. If s_FID_kann <> vbNullString Then
  1833. SQL = sql_Typ & _
  1834. "v_gis_fahrten WHERE " & s_FID_kann
  1835. End If
  1836. End If
  1837. Case 4 'Sofortfahrt
  1838. If fun_Get_Nummer(Me.l_Sofortfahrt_muss) > 0 Then
  1839. SQL = sql_Typ & _
  1840. "v_gis_sofortfahrt WHERE fid = " & fun_Get_Nummer(Me.l_Sofortfahrt_muss)
  1841. b_Hoechste_Ebene = True
  1842. Else
  1843. b_Hoechste_Ebene = False
  1844. End If
  1845. Debug.Print SQL
  1846. Case 5 'Objekte
  1847. 'If fun_Get_Nummer(Me.l_RR_Fid) > 0 Then sql = "SELECT * FROM v_gis_rueckrufer WHERE fid = " & fun_Get_Nummer(Me.l_RR_Fid)
  1848. Case 6 'Kartenmaterial
  1849. SQL = "SELECT '6' as typ, False as muss, 0 as ebene, " & _
  1850. " dateiname as kontext, x as pos1gx, y as pos1gy, x as pos2gx, y as pos2gy " & _
  1851. " FROM t_bilder " & _
  1852. " WHERE NOT del " & _
  1853. " AND aktiv " & _
  1854. " AND lyid = " & fun_Get_Nummer(Me.l_LYID) & _
  1855. " AND x >= " & Int(d__Get_Px1) & _
  1856. " AND x <= " & Int(d__Get_Px2) & _
  1857. " AND y >= " & Int(d__Get_Py1) & _
  1858. " AND y <= " & Int(d__Get_Py2)
  1859. SQL = SQL & _
  1860. " ORDER BY X, Y DESC"
  1861. Debug.Print SQL
  1862. Case 7 'Adressen
  1863. ' sql = "SELECT * FROM v_gis_fahrten " & s__FID_kann
  1864. Case 8 'Tourpunkte
  1865. Debug.Print txt_Tour_Muss_alt
  1866. SQL = txt_TOUR_muss
  1867. Case 9 'Tourpunkte
  1868. Debug.Print txt_Tour_Vergleich_Muss
  1869. SQL = txt_Tour_Vergleich_Muss
  1870. End Select
  1871. 'Hier wird die SQl - Abfrage durchgeführt und Element Array mit gefunden Elementen gefüllt
  1872. '"Ele_Typ_Rel - 4"
  1873. If SQL <> vbNullString Then 'Nur einlesen wenn auch Anweisung da ist
  1874. Set rs = fun_get_RS(SQL)
  1875. Debug.Print SQL
  1876. If Connection_Fehlerbehandlung("Gis Objekte holen") Then
  1877. Debug.Print rs.RecordCount
  1878. If rs.RecordCount >= 1 Then
  1879. rs.MoveFirst
  1880. Do While Not rs.EOF
  1881. Debug.Print "typ: " & TYP
  1882. If TYP = 8 Then 'Tourtyp
  1883. ReDim Preserve st__Touren(UBound(st__Touren) + 1)
  1884. st__Touren(UBound(st__Touren) - 1).TYP = C__TOUR
  1885. st__Touren(UBound(st__Touren) - 1).Kontext = "Gerät: " & rs.Fields("pdid") & " Zeit: " & rs.Fields("wann")
  1886. st__Touren(UBound(st__Touren) - 1).Pos1Gx = rs.Fields("x_meter")
  1887. st__Touren(UBound(st__Touren) - 1).Pos1Gy = rs.Fields("y_meter")
  1888. st__Touren(UBound(st__Touren) - 1).Pos2Gx = rs.Fields("x_meter")
  1889. st__Touren(UBound(st__Touren) - 1).Pos2Gy = rs.Fields("y_meter")
  1890. st__Touren(UBound(st__Touren) - 1).Muss = Muss
  1891. st__Touren(UBound(st__Touren) - 1).Ebene = 5
  1892. st__Touren(UBound(st__Touren) - 1).Id = UBound(st__Touren)
  1893. Else
  1894. If TYP = 9 Then 'Tourtyp Vergleich
  1895. ReDim Preserve st__Touren_Vergleich(UBound(st__Touren_Vergleich) + 1)
  1896. st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).TYP = C__TOUR
  1897. st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Kontext = "Gerät: " & rs.Fields("pdid") & " Zeit: " & rs.Fields("wann")
  1898. st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Pos1Gx = rs.Fields("x_meter")
  1899. st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Pos1Gy = rs.Fields("y_meter")
  1900. st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Pos2Gx = rs.Fields("x_meter")
  1901. st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Pos2Gy = rs.Fields("y_meter")
  1902. st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Muss = Muss
  1903. st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Ebene = 5
  1904. st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Id = UBound(st__Touren)
  1905. Else
  1906. 'Ebene fehlt noch und Region
  1907. ReDim Preserve st__Element(UBound(st__Element) + 1)
  1908. st__Element(UBound(st__Element) - 1).TYP = TYP
  1909. st__Element(UBound(st__Element) - 1).Kontext = rs.Fields("kontext")
  1910. st__Element(UBound(st__Element) - 1).Pos1Gx = rs.Fields("pos1gx")
  1911. st__Element(UBound(st__Element) - 1).Pos1Gy = rs.Fields("pos1gy")
  1912. st__Element(UBound(st__Element) - 1).Pos2Gx = rs.Fields("pos2gx")
  1913. st__Element(UBound(st__Element) - 1).Pos2Gy = rs.Fields("pos2gy")
  1914. st__Element(UBound(st__Element) - 1).Muss = Muss
  1915. st__Element(UBound(st__Element) - 1).Ebene = Ebene
  1916. st__Element(UBound(st__Element) - 1).Transportart = rs.Fields("transportart")
  1917. st__Element(UBound(st__Element) - 1).Pkw = rs.Fields("pkw")
  1918. st__Element(UBound(st__Element) - 1).Id = rs.Fields("id")
  1919. End If
  1920. End If
  1921. 'Typenspezifische Zuordnung
  1922. Select Case st__Element(UBound(st__Element) - 1).TYP
  1923. Case 2 'Wagen
  1924. st__Element(UBound(st__Element) - 1).RollerPlätze = rs.Fields("roller")
  1925. st__Element(UBound(st__Element) - 1).Id = rs.Fields("id") 'gehört später nach oben, da jeses Element
  1926. 'eine ID haben sollte
  1927. End Select
  1928. rs.MoveNext
  1929. Loop
  1930. End If
  1931. End If
  1932. End If
  1933. Debug.Print st__Element(UBound(st__Element) - 1).Id
  1934. Debug.Print UBound(st__Element)
  1935. For i = 0 To UBound(st__Touren) - 1
  1936. Debug.Print "i: " & i & " Kontext: " & st__Touren(0).Kontext
  1937. Next
  1938. Exit Sub
  1939. End Sub
  1940. Private Sub Zeichnen_von_Elementen()
  1941. '* "Zei_von_Ele" Zeichen der Elemente auf den Bildschirm
  1942. Dim i As Long
  1943. Dim J As Long
  1944. Dim s As String
  1945. Dim s1 As String
  1946. On Error Resume Next
  1947. '1.Grundlage wird geleert - "Zei_von_Ele - 01"
  1948. pic_Karte.Cls
  1949. '2. Infobild wenn keine Mussfelder vorhanden "Zei_von_Ele - 02"
  1950. If Not b_Muss_Felder_Gefunden And d__M_Gx_Fix_alt = 0 Then
  1951. s = cVerzBilder & "Keine_Elemente.gif"
  1952. pic_Karte.PaintPicture LoadPicture(s), pic_Karte.ScaleWidth / 2 - 376 / 2, pic_Karte.ScaleHeight / 2 - 89 / 2, 376, 89
  1953. Exit Sub
  1954. End If
  1955. 'Infoausgabe "Zei_von_Ele - 03"
  1956. 'Später vielleicht mit Ausführungsbit
  1957. txt_WriteAll "C:\Arrayreihenfolge.txt", " " 'Hilfsdatei initalisieren
  1958. For J = 0 To UBound(st__Element) - 1 'Schreib Arrayreihenfolge in eine Datei
  1959. txt_AppendLine "C:\Arrayreihenfolge.txt", _
  1960. " Nr: " & J & _
  1961. " Typ: " & st__Element(J).TYP & _
  1962. " Ebene: " & st__Element(J).Ebene & _
  1963. " Kontext: " & st__Element(J).Kontext
  1964. Next
  1965. 'Typengerechtes und ebenenbezogenes Zeichnen der Elemente "Zei_von_Ele - 04"
  1966. 'Ich würd sagen, da steckt auch noch einiges an Potiential drin
  1967. txt_WriteAll "C:Zeichenreihenfolge.txt", " " 'Hilfsdatei initalisieren
  1968. For i = 0 To Darstellungsebenen 'Darstellungsebenen
  1969. Debug.Print "Ebene: " & i
  1970. For J = 0 To UBound(st__Element) - 1
  1971. If st__Element(J).Ebene = i Then
  1972. Dim pos1x As Long
  1973. Dim Pos1y As Long
  1974. Dim Pos2x As Long
  1975. Dim Pos2y As Long
  1976. Select Case st__Element(J).TYP
  1977. Case 1 'Kunde anzeigen
  1978. s = cVerzBilder & "blau_15.gif"
  1979. pic_Karte.PaintPicture LoadPicture(s), st__Element(J).Pos1Px - 7, st__Element(J).Pos1Py - 7, 15, 15
  1980. Case 2 ' Wagen anzeigen
  1981. If st__Element(J).RollerPlätze > 0 Then
  1982. s = cVerzBilder & "Roller_15.gif"
  1983. Else
  1984. s = cVerzBilder & "Pkw_15.gif"
  1985. End If
  1986. 'da kann mann noch kürzen bis zum Umfallen
  1987. 'Position für Region und Positionierung ermitteln
  1988. pos1x = st__Element(J).Pos1Px - 7
  1989. Pos1y = st__Element(J).Pos1Py - 7
  1990. Pos2x = st__Element(J).Pos1Px - 7 + 15 ' -7 = Bild in der Mitte +15 = Breite Bild
  1991. Pos2y = st__Element(J).Pos1Py - 7 + 15
  1992. 'Zeichnen der Wagen
  1993. pic_Karte.PaintPicture LoadPicture(s), pos1x, Pos1y, 15, 15
  1994. 'Region für Wagen erstellen
  1995. st__Element(J).von_Region = Region_aus_Punkten(pos1x, Pos1y, Pos2x, Pos2y)
  1996. Case 3, 4 ' Fahrten anzeigen
  1997. Dim s_Temp As String
  1998. Select Case st__Element(J).TYP
  1999. Case 3 'normale Fahrt
  2000. s = cVerzBilder & "blau_15.gif"
  2001. s1 = cVerzBilder & "rot_15.gif"
  2002. Case Else
  2003. s = cVerzBilder & "orange_15.gif"
  2004. s1 = cVerzBilder & "rot_15.gif"
  2005. End Select
  2006. Dim M As Long
  2007. For M = 1 To 2
  2008. If M = 1 Then
  2009. 'Zeichenposition Einstieg festlegen
  2010. pos1x = st__Element(J).Pos1Px - 7
  2011. Pos1y = st__Element(J).Pos1Py - 7
  2012. Pos2x = st__Element(J).Pos1Px - 7 + 15 ' -7 = Bild in der Mitte +15 = Breite Bild
  2013. Pos2y = st__Element(J).Pos1Py - 7 + 15
  2014. s_Temp = s 'Bild Einstieg
  2015. st__Element(J).von_Region = Region_aus_Punkten(pos1x, Pos1y, Pos2x, Pos2y) 'Region Einstieg
  2016. Else
  2017. 'Zeichenposition Zielort festlegen
  2018. pos1x = st__Element(J).Pos2Px - 7
  2019. Pos1y = st__Element(J).Pos2Py - 7
  2020. Pos2x = st__Element(J).Pos2Px - 7 + 15 ' -7 = Bild in der Mitte +15 = Breite Bild
  2021. Pos2y = st__Element(J).Pos2Py - 7 + 15
  2022. s_Temp = s1 'Bild Ausstieg
  2023. st__Element(J).nach_Region = Region_aus_Punkten(pos1x, Pos1y, Pos2x, Pos2y) 'Region Ausstieg
  2024. End If
  2025. 'Zeichnen und Regionen für Startort
  2026. pic_Karte.PaintPicture LoadPicture(s_Temp), pos1x, Pos1y, 15, 15
  2027. Next
  2028. 'Zeichnen und Regionen für Fahrt
  2029. Dim P(5) As POINTAPI
  2030. st__Element(J).zw_Region = Region_für_Fahrt_erstellen(P(), _
  2031. st__Element(J).Pos1Px, _
  2032. st__Element(J).Pos1Py, _
  2033. st__Element(J).Pos2Px, _
  2034. st__Element(J).Pos2Py)
  2035. L = Region_für_Fahrt_zeichnen(P())
  2036. Case 5 'Objekte
  2037. '* noch nicht ausprogrammiert
  2038. Case 6 'Kartenteile anzeigen
  2039. s = cVerzBilder & st__Element(J).Kontext & ".gif"
  2040. pic_Karte.PaintPicture LoadPicture(s), st__Element(J).Pos1Px, st__Element(J).Pos1Py
  2041. Case 7 'Adressen
  2042. '* noch nicht ausprogrammiert
  2043. End Select
  2044. Debug.Print "C:\Zeichenreihenfolge.txt" & "Ebene: " & st__Element(J).TYP & "Typ: " & st__Element(J).TYP
  2045. txt_AppendLine "C:\Zeichenreihenfolge.txt", "Ebene: " & st__Element(J).TYP & "Typ: " & st__Element(J).TYP
  2046. End If
  2047. Next
  2048. Next
  2049. 'Hier wird die Tour erst nach allem anderen gezeichnet
  2050. For i = 0 To UBound(st__Touren)
  2051. s = cVerzBilder & "rot_15.gif"
  2052. pic_Karte.PaintPicture LoadPicture(s), st__Touren(i).Pos1Px - 7, st__Touren(i).Pos1Py - 7, 15, 15
  2053. txt_AppendLine "C:\Touren.txt", "Tour: " & st__Touren(i).Pos1Gx & ": " & st__Touren(i).Pos1Px & ": " & st__Touren(i).Pos1Gy & ": " & st__Touren(i).Pos2Py
  2054. Next
  2055. 'Hier wird die Tour erst nach allem anderen gezeichnet
  2056. For i = 0 To UBound(st__Touren_Vergleich)
  2057. s = cVerzBilder & "blau_15.gif"
  2058. pic_Karte.PaintPicture LoadPicture(s), st__Touren_Vergleich(i).Pos1Px - 7, st__Touren_Vergleich(i).Pos1Py - 7, 15, 15
  2059. txt_AppendLine "C:\Touren.txt", "Vergleich: " & st__Touren_Vergleich(i).Pos1Gx & ": " & st__Touren_Vergleich(i).Pos1Px & ": " & st__Touren_Vergleich(i).Pos1Gy & ": " & st__Touren_Vergleich(i).Pos2Py
  2060. Next
  2061. 'auch Mittelpunkt zeichnen
  2062. If b_Mittelpunkt_anzeigen Then
  2063. s = cVerzBilder & "blau_15.gif"
  2064. 'Position für Region und Positionierung ermitteln
  2065. pos1x = Round(ScaleWidth / 2 - 15, 0)
  2066. Pos1y = Round(ScaleHeight / 2 - 15, 0)
  2067. 'Zeichnen und Regionen für Abfahrtsort
  2068. pic_Karte.PaintPicture LoadPicture(s), pos1x, Pos1y, 15, 15
  2069. End If
  2070. End Sub
  2071. Private Function Region_für_Fahrt_zeichnen(P() As POINTAPI) As Long
  2072. 'Einstellung wie eine Fahrt gezeichnet wird
  2073. 'Zeichenvorgang selbst
  2074. Dim nCount As Long, PI As Single, LB As LOGBRUSH
  2075. 'Zuweisen und definieren des Polygone (Rahmen für Darstellung)
  2076. ReDim hPen(2)
  2077. ReDim hBrush(2)
  2078. ReDim hRegion(3) As Long
  2079. On Error Resume Next
  2080. hPenSave = GetCurrentObject(hdc, OBJ_PEN)
  2081. hBrushSave = GetCurrentObject(hdc, OBJ_BRUSH)
  2082. hPen(1) = CreatePen(PS_SOLID, 4, QBColor(1))
  2083. LB.lbColor = QBColor(4)
  2084. LB.lbStyle = BS_SOLID
  2085. LB.lbHatch = HS_SOLID
  2086. hBrush(1) = CreateBrushIndirect(LB)
  2087. pic_Karte.FillColor = vbRed
  2088. pic_Karte.FillStyle = 0
  2089. Polygon pic_Karte.hdc, P(0), 5
  2090. End Function
  2091. Private Function Region_für_Fahrt_erstellen(Rp() As POINTAPI, _
  2092. Pos1Px As Single, _
  2093. Pos1Py As Single, _
  2094. Pos2Px As Single, _
  2095. Pos2Py As Single) As Long
  2096. On Error Resume Next
  2097. Rp(0).x = Pos1Px
  2098. Rp(0).y = Pos1Py
  2099. Rp(1).x = Pos1Px
  2100. Rp(1).y = Pos1Py - 4
  2101. Rp(2).x = Pos2Px
  2102. Rp(2).y = Pos2Py - 4
  2103. Rp(3).x = Pos2Px
  2104. Rp(3).y = Pos2Py
  2105. Rp(4).x = Pos1Px
  2106. Rp(4).y = Pos1Py
  2107. Region_für_Fahrt_erstellen = fun_Region_aus_Pointapi_Neu(Rp(), 5)
  2108. End Function
  2109. Private Sub GeoMittelpunkt_aller_Muss_Elemente() '"Geo_Mpkt_Muss_Elemente"
  2110. '* Ermittelt GeoMittelpunkt_aller_Muss_Elemente
  2111. Dim i As Long
  2112. On Error Resume Next
  2113. d__Get_Px1 = 0
  2114. d__Get_Py1 = 0
  2115. d__Get_Px2 = 0
  2116. d__Get_Py2 = 0
  2117. d__M_Gx_Fix_alt = d_M_Gx_Fix
  2118. d__M_Gy_Fix_alt = d_M_Gy_Fix
  2119. 'Mittelpunkt aus Pflichtmittelpunkt
  2120. If d__M_Gx_Fix_alt <> 0 Then
  2121. 'Werte zuweisen
  2122. 'Mittelpunkt setzten
  2123. d__Get_Px1 = d__M_Gx_Fix_alt
  2124. d__Get_Py1 = d__M_Gy_Fix_alt
  2125. d__Get_Px2 = d__M_Gx_Fix_alt
  2126. d__Get_Py2 = d__M_Gy_Fix_alt
  2127. Else
  2128. 'Initialisieren da Wert hier neu gesetzt wird "Geo_Mpkt_Muss_Elemente - 1"
  2129. b_Muss_Felder_Gefunden = False
  2130. 'Aus allen Elementen Grenzwerte finden "Geo_Mpkt_Muss_Elemente - 2"
  2131. For i = 0 To UBound(st__Element) - 1
  2132. 'Von Adresse checken
  2133. If st__Element(i).Muss = True Then
  2134. If Not b_Muss_Felder_Gefunden Then 'Auf alle Fälle mal alte Werte überschreiben
  2135. b_Muss_Felder_Gefunden = True
  2136. d__Get_Px1 = st__Element(i).Pos1Gx
  2137. d__Get_Py1 = st__Element(i).Pos1Gy
  2138. d__Get_Px2 = st__Element(i).Pos1Gx
  2139. d__Get_Py2 = st__Element(i).Pos1Gy
  2140. Else
  2141. If d__Get_Px1 > st__Element(i).Pos1Gx Then
  2142. d__Get_Px1 = st__Element(i).Pos1Gx
  2143. End If
  2144. If d__Get_Px2 < st__Element(i).Pos1Gx Then
  2145. d__Get_Px2 = st__Element(i).Pos1Gx
  2146. End If
  2147. If d__Get_Py1 > st__Element(i).Pos1Gy Then
  2148. d__Get_Py1 = st__Element(i).Pos1Gy
  2149. End If
  2150. If d__Get_Py2 < st__Element(i).Pos1Gy Then
  2151. d__Get_Py2 = st__Element(i).Pos1Gy
  2152. End If
  2153. End If
  2154. 'Nach Adresse checken
  2155. If st__Element(i).TYP <> 4 Then 'Bei Sofortfahrt nur Abholort für Mittelpunktberechnung
  2156. If d__Get_Px1 > st__Element(i).Pos2Gx Then
  2157. d__Get_Px1 = st__Element(i).Pos2Gx
  2158. End If
  2159. If d__Get_Px2 < st__Element(i).Pos2Gx Then
  2160. d__Get_Px2 = st__Element(i).Pos2Gx
  2161. End If
  2162. If d__Get_Py1 > st__Element(i).Pos2Gy Then
  2163. d__Get_Py1 = st__Element(i).Pos2Gy
  2164. End If
  2165. If d__Get_Py2 < st__Element(i).Pos2Gy Then
  2166. d__Get_Py2 = st__Element(i).Pos2Gy
  2167. End If
  2168. End If
  2169. End If
  2170. Next
  2171. 'Aus allen Tourpunkte Grenzwerte finden "Geo_Mpkt_Muss_Elemente - 2"
  2172. For i = 0 To UBound(st__Touren) - 1
  2173. 'Von Adresse checken
  2174. If st__Touren(i).Muss = True Then
  2175. If Not b_Muss_Felder_Gefunden Then 'Auf alle Fälle mal alte Werte überschreiben
  2176. b_Muss_Felder_Gefunden = True
  2177. d__Get_Px1 = st__Touren(i).Pos1Gx
  2178. d__Get_Py1 = st__Touren(i).Pos1Gy
  2179. d__Get_Px2 = st__Touren(i).Pos1Gx
  2180. d__Get_Py2 = st__Touren(i).Pos1Gy
  2181. Else
  2182. If d__Get_Px1 > st__Touren(i).Pos1Gx Then
  2183. d__Get_Px1 = st__Touren(i).Pos1Gx
  2184. End If
  2185. If d__Get_Px2 < st__Touren(i).Pos1Gx Then
  2186. d__Get_Px2 = st__Touren(i).Pos1Gx
  2187. End If
  2188. If d__Get_Py1 > st__Touren(i).Pos1Gy Then
  2189. d__Get_Py1 = st__Touren(i).Pos1Gy
  2190. End If
  2191. If d__Get_Py2 < st__Touren(i).Pos1Gy Then
  2192. d__Get_Py2 = st__Touren(i).Pos1Gy
  2193. End If
  2194. End If
  2195. 'Nach Adresse checken
  2196. If st__Touren(i).TYP <> 4 Then 'Bei Sofortfahrt nur Abholort für Mittelpunktberechnung
  2197. If d__Get_Px1 > st__Touren(i).Pos2Gx Then
  2198. d__Get_Px1 = st__Touren(i).Pos2Gx
  2199. End If
  2200. If d__Get_Px2 < st__Touren(i).Pos2Gx Then
  2201. d__Get_Px2 = st__Touren(i).Pos2Gx
  2202. End If
  2203. If d__Get_Py1 > st__Touren(i).Pos2Gy Then
  2204. d__Get_Py1 = st__Touren(i).Pos2Gy
  2205. End If
  2206. If d__Get_Py2 < st__Touren(i).Pos2Gy Then
  2207. d__Get_Py2 = st__Touren(i).Pos2Gy
  2208. End If
  2209. End If
  2210. End If
  2211. Next
  2212. 'Aus allen Tourpunkte_Vergleich Grenzwerte finden "Geo_Mpkt_Muss_Elemente - 2"
  2213. For i = 0 To UBound(st__Touren_Vergleich) - 1
  2214. 'Von Adresse checken
  2215. If st__Touren_Vergleich(i).Muss = True Then
  2216. If Not b_Muss_Felder_Gefunden Then 'Auf alle Fälle mal alte Werte überschreiben
  2217. b_Muss_Felder_Gefunden = True
  2218. d__Get_Px1 = st__Touren_Vergleich(i).Pos1Gx
  2219. d__Get_Py1 = st__Touren_Vergleich(i).Pos1Gy
  2220. d__Get_Px2 = st__Touren_Vergleich(i).Pos1Gx
  2221. d__Get_Py2 = st__Touren_Vergleich(i).Pos1Gy
  2222. Else
  2223. If d__Get_Px1 > st__Touren_Vergleich(i).Pos1Gx Then
  2224. d__Get_Px1 = st__Touren_Vergleich(i).Pos1Gx
  2225. End If
  2226. If d__Get_Px2 < st__Touren_Vergleich(i).Pos1Gx Then
  2227. d__Get_Px2 = st__Touren_Vergleich(i).Pos1Gx
  2228. End If
  2229. If d__Get_Py1 > st__Touren_Vergleich(i).Pos1Gy Then
  2230. d__Get_Py1 = st__Touren_Vergleich(i).Pos1Gy
  2231. End If
  2232. If d__Get_Py2 < st__Touren_Vergleich(i).Pos1Gy Then
  2233. d__Get_Py2 = st__Touren_Vergleich(i).Pos1Gy
  2234. End If
  2235. End If
  2236. 'Nach Adresse checken
  2237. If st__Touren_Vergleich(i).TYP <> 4 Then 'Bei Sofortfahrt nur Abholort für Mittelpunktberechnung
  2238. If d__Get_Px1 > st__Touren_Vergleich(i).Pos2Gx Then
  2239. d__Get_Px1 = st__Touren_Vergleich(i).Pos2Gx
  2240. End If
  2241. If d__Get_Px2 < st__Touren_Vergleich(i).Pos2Gx Then
  2242. d__Get_Px2 = st__Touren_Vergleich(i).Pos2Gx
  2243. End If
  2244. If d__Get_Py1 > st__Touren_Vergleich(i).Pos2Gy Then
  2245. d__Get_Py1 = st__Touren_Vergleich(i).Pos2Gy
  2246. End If
  2247. If d__Get_Py2 < st__Touren_Vergleich(i).Pos2Gy Then
  2248. d__Get_Py2 = st__Touren_Vergleich(i).Pos2Gy
  2249. End If
  2250. End If
  2251. End If
  2252. Next
  2253. End If
  2254. 'GeoMittelpunkt des Darstellungsbereich errechnen "Geo_Mpkt_Muss_Elemente - 3"
  2255. Mp_Gx = (d__Get_Px1 + d__Get_Px2) / 2
  2256. Mp_Gy = (d__Get_Py1 + d__Get_Py2) / 2
  2257. Layerstufe_holen 'Layerstufe berechnen
  2258. GoTo OK
  2259. Abbr:
  2260. MsgBox "Fehler beim Ermitteln Layerstufe für Gis Control"
  2261. Exit Sub
  2262. OK:
  2263. 'l_LYID = st_GisStufen(0).id
  2264. 'd_Zoom = st_GisStufen(0).Faktor
  2265. End Sub
  2266. Public Sub Layerstufe_verändern(Plus As Boolean)
  2267. 'Setzt Layerstufe nach oben bzw. nach unten
  2268. On Error Resume Next
  2269. Dim i As Integer
  2270. Dim k As Long
  2271. 'Anzahl Layers ermitteln
  2272. If UBound(st_GisStufen) = 0 Then
  2273. k = 0
  2274. Else
  2275. k = UBound(st_GisStufen)
  2276. End If
  2277. 'Je nach Auf oder Abwärts nächste Layerstufe auswählen
  2278. If Plus Then
  2279. For i = 0 To k 'nächst höhere Stufe finden
  2280. If st_GisStufen(i).Id > Val(Me.l_LYID) Then 'Muss Layer
  2281. l_LYID = st_GisStufen(i).Id
  2282. d__Zoom = st_GisStufen(i).Faktor
  2283. Exit Sub
  2284. End If
  2285. Next
  2286. Else
  2287. For i = k To 0 Step -1 'nächste niedriegere Layerstufe finden
  2288. If st_GisStufen(i).Id < Val(Me.l_LYID) Then 'Muss Layer
  2289. l_LYID = st_GisStufen(i).Id
  2290. d__Zoom = st_GisStufen(i).Faktor
  2291. Exit Sub
  2292. End If
  2293. Next
  2294. End If
  2295. End Sub
  2296. Private Sub Layerstufe_holen()
  2297. On Error Resume Next
  2298. Dim i As Integer
  2299. 'Layerstufe errechnen "Geo_Mpkt_Muss_Elemente - 4"
  2300. 'Auch so ein Ding das man auslagern könnte
  2301. Dim k As Long
  2302. If UBound(st_GisStufen) = 0 Then
  2303. k = 0
  2304. Else
  2305. k = UBound(st_GisStufen)
  2306. End If
  2307. Dim b_Layer_gefunden As Boolean
  2308. 'l_LYID = 0 'LayerStufe wieder zurücksetzen - derzeit Pflichtlayer noch nicht möglich
  2309. For i = 0 To k
  2310. If st_GisStufen(i).Id = Val(Me.l_LYID) Then 'Muss Layer
  2311. l_LYID = st_GisStufen(i).Id
  2312. d__Zoom = st_GisStufen(i).Faktor
  2313. b_Layer_gefunden = True
  2314. Exit For
  2315. End If
  2316. Next
  2317. If Not b_Layer_gefunden Then
  2318. If Not b_Hoechste_Ebene Then 'Sofortfahrt auf Höchster Ebene anzeigen
  2319. For i = 0 To k
  2320. 'Layer Optimal
  2321. If (d__Get_Px2 - d__Get_Px1) / st_GisStufen(i).Faktor <= DarstB_Width Then
  2322. If (d__Get_Py2 - d__Get_Py1) / st_GisStufen(i).Faktor <= DarstB_Height Then
  2323. l_LYID = st_GisStufen(i).Id
  2324. d_Zoom = st_GisStufen(i).Faktor
  2325. GoTo OK
  2326. End If
  2327. End If
  2328. Next
  2329. End If
  2330. 'Kein Layer gefunden - höchste Stufe
  2331. If l_LYID = 0 Then
  2332. l_LYID = st_GisStufen(1).Id
  2333. d_Zoom = st_GisStufen(1).Faktor
  2334. End If
  2335. End If
  2336. OK:
  2337. End Sub
  2338. Private Function fun_SQL_Where_Transportart() As String '"Sql_Where_TA"
  2339. '*Liefert Sql_Where für SQL_Wagen_Kann damit Transportart der
  2340. '*Sofortfahrt berücksichtigt wird
  2341. '*Wäre auch gut eine Eigenschaft
  2342. Dim l_ArrayNr As Long
  2343. Dim SQL As String
  2344. On Error Resume Next
  2345. l_ArrayNr = -1 'initalisieren --> Array Nummer kann auch 0 (1.Element) sein
  2346. 'Vorraussetzungen prüfen "Sql_Where_TA - 1"
  2347. If bol_Transportart = False Or _
  2348. txt_Wid_kann = vbNullString Then
  2349. Exit Function
  2350. End If
  2351. 'Array Nr für Fahrt holen "Sql_Where_TA - 2"
  2352. If UBound(st__Element) > 0 Then
  2353. Dim i As Long
  2354. For i = 0 To UBound(st__Element) - 1 'Array durcharbeiten
  2355. If st__Element(i).TYP = 4 Then 'Rückholer fahrt - Konstanten erzeugen
  2356. l_ArrayNr = i
  2357. Exit For
  2358. End If
  2359. Next
  2360. End If
  2361. 'Wenn Fahrt gefunden - Transportart festlegen,
  2362. 'und SQL bilden :: eigentlich auch noch vermischt "Sql_Where_TA - 3"
  2363. '-- aber ich denke schon beim Einlesen der Rückholerfahrt sollte man alle notwendigen
  2364. '-- Informationen gleich in Felder schreiben, ist zwar dann nicht so allgemein aber effiz.
  2365. If l_ArrayNr >= 0 Then 'nur wenn auch gefundn
  2366. 'Derzeit nur Geher - Roller - Umsetzer berücksichtigt
  2367. 'nicht Anzahl Personen und auch nicht Transportart Begleitpersonen
  2368. Dim b_Pkw As Boolean
  2369. Dim s_Transportart As String
  2370. b_Pkw = st__Element(l_ArrayNr).Pkw
  2371. s_Transportart = st__Element(l_ArrayNr).Transportart
  2372. 'Zuordnung der Art:
  2373. If UCase(s_Transportart) = "G" Then 'Geher
  2374. If b_Pkw Then 'nur Pkw
  2375. SQL = SQL & " AND roller = 0 "
  2376. Else
  2377. 'sonstiger Geher muss nicht extra behandelt werden, jeder Wagen passt
  2378. 'nur der strukturhalber eingefügt
  2379. End If
  2380. Else 'Roller Fahrt
  2381. If Not b_Pkw Then 'nur Pkw - Umsetzer
  2382. SQL = SQL & " AND roller > 0 "
  2383. Else
  2384. 'Umsetzer muss nicht extra behandelt werden, jeder Wagen passt
  2385. 'ich geh mal davon aus, dass bei einem Umsetzer der PKW eher eine Möglichkeit darstellt
  2386. 'als eine Verpflichtung
  2387. End If
  2388. End If
  2389. fun_SQL_Where_Transportart = SQL
  2390. End If
  2391. End Function
  2392. Function Elemente_Checken(bMuss As Boolean) As Long '"Element_chk"
  2393. 'Hat sich ein Kann oder Muss (auf Wunsch) Abfragewert geändert
  2394. 'so wird der entsprechende Typ neu in die Elementenliste aufgenommen
  2395. Dim ctr As Control
  2396. On Error GoTo Weiter
  2397. Dim sMuss As String
  2398. If bMuss Then 'Zuweisen Muss Wert
  2399. sMuss = C__Muss
  2400. Else
  2401. sMuss = C__Kann
  2402. End If
  2403. For Each ctr In Controls
  2404. 'Alle Muss Objekte checken
  2405. Debug.Print txt_FID_kann
  2406. Debug.Print ctr.Name & "; " & Len(ctr.Tag); "; " & MID(ctr.Tag, 1, 1) & ";"
  2407. If Len(ctr.Tag) = 3 And MID(ctr.Tag, 1, 1) = sMuss Then
  2408. Debug.Print ctr.Name
  2409. Debug.Print Controls(ctr.Name & "_alt").Text
  2410. If ctr.Name <> Controls(ctr.Name).Text Then
  2411. Debug.Print ctr.Text
  2412. Controls(ctr.Name & "_alt").Text = ctr.Text
  2413. Elemente_Checken = 1
  2414. Debug.Print ctr.Name & "; " & Len(ctr.Tag); "; " & MID(ctr.Tag, 1, 1) & ";"
  2415. Elemente_Typ_Reload_neu MID(ctr.Tag, 2, 1), _
  2416. bMuss, _
  2417. MID(ctr.Tag, 3, 1)
  2418. Debug.Print ctr.Name & " " & MID(ctr.Tag, 3, 1)
  2419. End If
  2420. Debug.Print Len(ctr.Tag) & MID(ctr.Tag, 1, 1)
  2421. End If
  2422. Weiter:
  2423. Next
  2424. 'Hier noch extra checken ob ein Muss_Wid vorhanden,
  2425. 'dann immer aktualisieren
  2426. End Function
  2427. Private Sub Darstellung_aus_Geomittelpunkt() '"Darstbereich_Geo"
  2428. On Error Resume Next
  2429. 'Geo Darstellungsbereich des Sichtfensters
  2430. d__Get_Px1 = Mp_Gx - (DarstB_Width / 2 + l_Bild_x) * d__Zoom
  2431. d__Get_Py1 = Mp_Gy - (DarstB_Height / 2 + l_Bild_y) * d__Zoom
  2432. d__Get_Px2 = Mp_Gx + (DarstB_Width / 2) * d__Zoom
  2433. d__Get_Py2 = Mp_Gy + (DarstB_Height / 2) * d__Zoom
  2434. End Sub
  2435. Public Sub Paint()
  2436. 'Diese Prozedur kümmert sich um alle Aufgaben vom Checken der Veränderungen bis zum
  2437. 'Neuzeichnen "sub_Paint"
  2438. Dim i As Long
  2439. On Error GoTo Abbr
  2440. l__Paint_Status = 0
  2441. GISLOG "Prozedur Paint() beim Aufruf"
  2442. 'Solange Status <= 4 "sub_Paint - 01"
  2443. Do While l__Paint_Status <= 6
  2444. Select Case l__Paint_Status 'Status verarbeiten: "sub_Paint - 02"
  2445. Case 0
  2446. 'Checken ob sich Muss_Auswahl verändert haben "sub_Paint - Zustand: 0"
  2447. frm_GisView.txt_Info = frm_GisView.txt_Info & " Zustand 0! "
  2448. GISLOG "Funktion Elemente_check_Muss () beim Aufruf "
  2449. 'Select Case mit Fehlerbehandlung < 0
  2450. If Elemente_Checken(True) > 0 Then
  2451. 'Elemente haben sich verändert "sub_Paint - Zustand: 0 - 1"
  2452. l__Paint_Status = 1 'Darstellungsbereich hat sich geändert
  2453. Else
  2454. 'Elemente haben sich nicht verändert "sub_Paint - Zustand: 0 - 2"
  2455. l__Paint_Status = 4 'Darstellungsbereich hat sich NICHT geändert
  2456. End If
  2457. Debug.Print UBound(st__Element)
  2458. GISLOG "Funktion Elemente_check_Muss () beim Verlassen "
  2459. Case 1
  2460. 'Ermittelt GeoMittelpunkt aller Muss Elemente "sub_Paint - Zustand: 1"
  2461. GISLOG "GeoMittelpunkt aller Muss Elemente () beim Aufruf "
  2462. GeoMittelpunkt_aller_Muss_Elemente 'Holt Layer und GeoMittelpunkt
  2463. l__Paint_Status = 2 'Weiter
  2464. GISLOG "GeoMittelpunkt aller Muss Elemente () beim Verlassen "
  2465. Case 2
  2466. 'Geokoordinaten für Sichtfensterbereich berechnen "sub_Paint - Zustand: 2"
  2467. GISLOG "Darstellung_aus_GeoMittelPunkt () beim Aufruf "
  2468. Darstellung_aus_Geomittelpunkt
  2469. If b_Muss_Felder_Gefunden = True Or d__M_Gx_Fix_alt <> 0 Then
  2470. 'Mussfelder wurden gefunden "sub_Paint - Zustand: 2 - 1"
  2471. l__Paint_Status = 3 'alles normal weiter da Muss Felder vorhanden
  2472. Else
  2473. 'Keine Mussfelder vorhanden "sub_Paint - Zustand: 2 - 1"
  2474. l__Paint_Status = 5 'Zeichenroutine leert pic_Karte da keine Muss Felder
  2475. End If
  2476. GISLOG "Darstellung_aus_GeoMittelPunkt () beim Verlassen "
  2477. Case 3
  2478. 'Kartenteile neu einlesen "sub_Paint - Zustand: 3"
  2479. GISLOG "Kartenteile neu einlesen () beim Aufruf "
  2480. 'b_Muss muss hier fast true sein, sonst würde er bei 2 schon auf 5 springen
  2481. If b_Muss_Felder_Gefunden Or d__M_Gx_Fix_alt <> 0 Then
  2482. 'Kartenteile_neu_einlesen
  2483. 'Mussfelder wurden gefunden "sub_Paint - Zustand: 2 - 1"
  2484. Elemente_Typ_Reload_neu 6, False, 0
  2485. End If
  2486. l__Paint_Status = 4
  2487. GISLOG "Kartenteile neu einlesen () beim Verlassen "
  2488. Case 4
  2489. 'Kann Elemente checken und aufbauen "sub_Paint - Zustand: 4"
  2490. If b_Muss_Felder_Gefunden Or d__M_Gx_Fix_alt > 0 Then
  2491. i = Elemente_Checken(False)
  2492. End If
  2493. l__Paint_Status = 5
  2494. Case 5
  2495. 'Regionen für Elemente erstellen "sub_Paint - Zustand: 5"
  2496. Pixelkoordinaten_für_Elemente
  2497. l__Paint_Status = 6
  2498. Case 6
  2499. 'Zeichnen der Elemente "sub_Paint - Zustand: 6"
  2500. Zeichnen_von_Elementen
  2501. l__Paint_Status = 7
  2502. End Select
  2503. Loop
  2504. GISLOG "Prozedur Paint() beim Verlassen"
  2505. Exit Sub
  2506. Abbr:
  2507. MsgBox "Fehler in Gis Darstellung -> Paint() "
  2508. End Sub