1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668 |
- VERSION 5.00
- Begin VB.UserControl ctl_Gis
- BackColor = &H00CBE4F8&
- ClientHeight = 7305
- ClientLeft = 0
- ClientTop = 0
- ClientWidth = 7785
- DrawWidth = 1000
- ScaleHeight = 487
- ScaleMode = 3 'Pixel
- ScaleWidth = 519
- Begin VB.TextBox txt_Tour_Vergleich_Muss_alt
- BackColor = &H00C0C0C0&
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1680
- TabIndex = 53
- Top = 360
- Visible = 0 'False
- Width = 1095
- End
- Begin VB.TextBox txt_Tour_Vergleich_Muss
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 3900
- TabIndex = 52
- Tag = "M92"
- Top = 1425
- Visible = 0 'False
- Width = 1455
- End
- Begin VB.TextBox txt_MausOver_Typ
- BackColor = &H00C0FFC0&
- Height = 285
- Left = 0
- TabIndex = 46
- Top = 6600
- Visible = 0 'False
- Width = 1095
- End
- Begin VB.Frame fme_Eingabewerte
- BackColor = &H00C0C0C0&
- BorderStyle = 0 'Kein
- Caption = "Eingabewerte"
- Enabled = 0 'False
- Height = 7215
- Left = 0
- TabIndex = 1
- Top = 0
- Visible = 0 'False
- Width = 2895
- Begin VB.TextBox txt_TOUR_muss
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 120
- TabIndex = 50
- Tag = "M82"
- Top = 3600
- Width = 1455
- End
- Begin VB.TextBox txt_Tour_Muss_alt
- BackColor = &H00C0C0C0&
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1680
- TabIndex = 49
- Top = 3600
- Width = 1095
- End
- Begin VB.TextBox txt_Fid_kann_alt
- BackColor = &H00C0C0C0&
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1680
- TabIndex = 48
- Top = 2400
- Width = 1095
- End
- Begin VB.TextBox txt_MausOver_ID
- BackColor = &H00C0FFC0&
- Height = 285
- Left = 1080
- TabIndex = 47
- Top = 6840
- Visible = 0 'False
- Width = 1095
- End
- Begin VB.TextBox txt_Mo_Id
- Height = 285
- Left = 1920
- TabIndex = 44
- Top = 3120
- Width = 855
- End
- Begin VB.TextBox txt_Kontext
- Height = 285
- Left = 120
- TabIndex = 43
- Top = 2880
- Width = 2655
- End
- Begin VB.CheckBox bol_Transportart_alt
- Caption = "Check1"
- Enabled = 0 'False
- Height = 255
- Left = 2520
- TabIndex = 42
- Top = 2640
- Width = 255
- End
- Begin VB.CheckBox bol_Transportart
- Caption = "Check1"
- Enabled = 0 'False
- Height = 255
- Left = 2160
- TabIndex = 41
- Tag = "K21"
- Top = 2640
- Width = 255
- End
- Begin VB.TextBox txt_Sofortfahrt_muss_alt
- BackColor = &H00C0C0C0&
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1680
- TabIndex = 39
- Top = 1560
- Width = 1095
- End
- Begin VB.TextBox txt_WID_kann_alt
- BackColor = &H00C0C0C0&
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1680
- TabIndex = 38
- Top = 2040
- Width = 1095
- End
- Begin VB.TextBox txt_FID_muss_alt
- BackColor = &H00C0C0C0&
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1680
- TabIndex = 37
- Top = 1080
- Width = 1095
- End
- Begin VB.TextBox txt_Kid_muss_alt
- BackColor = &H00C0C0C0&
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1680
- TabIndex = 36
- Top = 600
- Width = 1095
- End
- Begin VB.TextBox l_GM_Y_muss
- BackColor = &H80000004&
- Enabled = 0 'False
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1440
- Locked = -1 'True
- TabIndex = 35
- Tag = "M"
- Top = 6480
- Width = 1215
- End
- Begin VB.TextBox l_GM_X_Muss
- BackColor = &H80000004&
- Enabled = 0 'False
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 120
- Locked = -1 'True
- TabIndex = 33
- Tag = "M"
- Top = 6480
- Width = 1215
- End
- Begin VB.CheckBox b_Zeige_Objekt
- Caption = "Check1"
- Enabled = 0 'False
- Height = 255
- Left = 2400
- TabIndex = 31
- Top = 6840
- Width = 255
- End
- Begin VB.TextBox l_RR_Anzahl
- BackColor = &H80000004&
- Enabled = 0 'False
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1440
- Locked = -1 'True
- TabIndex = 29
- Tag = "M"
- Top = 6000
- Width = 1215
- End
- Begin VB.TextBox l_RR_Zeitspanne
- BackColor = &H80000004&
- Enabled = 0 'False
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 120
- Locked = -1 'True
- TabIndex = 27
- Tag = "M"
- Top = 6000
- Width = 1215
- End
- Begin VB.TextBox txt_Sofortfahrt_muss
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 120
- TabIndex = 25
- Tag = "M42"
- Top = 1560
- Width = 1455
- End
- Begin VB.TextBox dat_Fid_bis
- BackColor = &H80000004&
- Enabled = 0 'False
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1440
- Locked = -1 'True
- TabIndex = 23
- Tag = "M"
- Top = 5040
- Width = 1215
- End
- Begin VB.TextBox txt_Adid_muss
- BackColor = &H80000004&
- Enabled = 0 'False
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 120
- Locked = -1 'True
- TabIndex = 21
- Tag = "M"
- Top = 5520
- Width = 1215
- End
- Begin VB.TextBox dat_Fid_von
- BackColor = &H80000004&
- Enabled = 0 'False
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 120
- Locked = -1 'True
- TabIndex = 19
- Tag = "M"
- Top = 5040
- Width = 1215
- End
- Begin VB.TextBox txt_Lyid_Muss
- BackColor = &H80000004&
- Enabled = 0 'False
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 1440
- Locked = -1 'True
- TabIndex = 17
- Tag = "M"
- Top = 4560
- Width = 1215
- End
- Begin VB.TextBox txt_Fid_kann
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 120
- Locked = -1 'True
- TabIndex = 15
- Tag = "K32"
- Top = 2520
- Width = 1095
- End
- Begin VB.TextBox txt_Wid_muss
- BackColor = &H80000004&
- Enabled = 0 'False
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 120
- Locked = -1 'True
- TabIndex = 13
- Tag = "M"
- Top = 4560
- Width = 1215
- End
- Begin VB.TextBox txt_Kid_kann
- BackColor = &H80000004&
- Enabled = 0 'False
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 120
- Locked = -1 'True
- TabIndex = 11
- Tag = "M"
- Top = 4080
- Width = 1215
- End
- Begin VB.TextBox txt_WID_kann
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 285
- Left = 120
- TabIndex = 6
- Tag = "K21"
- Top = 2040
- Width = 1455
- End
- Begin VB.TextBox txt_FID_muss
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 285
- Left = 120
- TabIndex = 4
- Tag = "M31"
- Top = 1080
- Width = 1455
- End
- Begin VB.TextBox txt_Kid_muss
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 120
- TabIndex = 2
- Tag = "M12"
- Top = 600
- Width = 1455
- End
- Begin VB.Label Label5
- BackStyle = 0 'Transparent
- Caption = "s_Tourpunkte_Muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 0
- TabIndex = 51
- Top = 3360
- Width = 2535
- End
- Begin VB.Label Label11
- BackStyle = 0 'Transparent
- Caption = "Maus über Element"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 45
- Top = 3120
- Width = 1815
- End
- Begin VB.Label Label10
- BackStyle = 0 'Transparent
- Caption = "b_transportartgerecht"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 40
- Top = 2640
- Width = 1935
- End
- Begin VB.Label Label8
- BackStyle = 0 'Transparent
- Caption = "l_GM_Y_muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Index = 7
- Left = 1440
- TabIndex = 34
- Top = 6240
- Width = 1215
- End
- Begin VB.Label deref
- BackStyle = 0 'Transparent
- Caption = "l_GM_X_muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Index = 6
- Left = 120
- TabIndex = 32
- Top = 6240
- Width = 1215
- End
- Begin VB.Label dfere
- BackStyle = 0 'Transparent
- Caption = "b_Zeige_Obekt"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 30
- Top = 6840
- Width = 1575
- End
- Begin VB.Label Label8
- BackStyle = 0 'Transparent
- Caption = "l_RR_Anzahl"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Index = 5
- Left = 1440
- TabIndex = 28
- Top = 5760
- Width = 1215
- End
- Begin VB.Label Label8
- BackStyle = 0 'Transparent
- Caption = "l_RR_Zeitsp."
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Index = 4
- Left = 120
- TabIndex = 26
- Top = 5760
- Width = 1215
- End
- Begin VB.Label cddfdfdf
- BackStyle = 0 'Transparent
- Caption = "l_Sofortfahrt_muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 120
- TabIndex = 24
- Top = 1320
- Width = 1935
- End
- Begin VB.Label ldbld
- BackStyle = 0 'Transparent
- Caption = "dat_Fid_bis"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 1440
- TabIndex = 22
- Top = 4800
- Width = 1095
- End
- Begin VB.Label Label8
- BackStyle = 0 'Transparent
- Caption = "s_Aid_muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Index = 3
- Left = 120
- TabIndex = 20
- Top = 5280
- Width = 1215
- End
- Begin VB.Label Label9
- BackStyle = 0 'Transparent
- Caption = "dat_Fid_von"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 18
- Top = 4800
- Width = 1095
- End
- Begin VB.Label Label8
- BackStyle = 0 'Transparent
- Caption = "l_Lyid_muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Index = 2
- Left = 1440
- TabIndex = 16
- Top = 4320
- Width = 1215
- End
- Begin VB.Label Label8
- BackStyle = 0 'Transparent
- Caption = "s_Tourpunkte_muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Index = 1
- Left = 120
- TabIndex = 14
- Top = 2280
- Width = 1095
- End
- Begin VB.Label Label8
- BackStyle = 0 'Transparent
- Caption = "s_Wid_muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Index = 0
- Left = 120
- TabIndex = 12
- Top = 4320
- Width = 1215
- End
- Begin VB.Label Label7
- BackStyle = 0 'Transparent
- Caption = "s_Kid_kann"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 1560
- TabIndex = 10
- Top = 4080
- Width = 1095
- End
- Begin VB.Label Label6
- BackStyle = 0 'Transparent
- Caption = "noch nicht umgesetzt:"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 9
- Top = 3840
- Width = 2535
- End
- Begin VB.Label Label4
- Caption = "Label4"
- Height = 255
- Left = 0
- TabIndex = 8
- Top = 0
- Width = 15
- End
- Begin VB.Label Label3
- BackStyle = 0 'Transparent
- Caption = "s_Wid_kann"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 7
- Top = 1800
- Width = 2535
- End
- Begin VB.Label Label2
- BackStyle = 0 'Transparent
- Caption = "s_Fid_muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 5
- Top = 840
- Width = 2535
- End
- Begin VB.Label Label1
- BackStyle = 0 'Transparent
- Caption = "s_Kid_muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 3
- Top = 360
- Width = 2535
- End
- End
- Begin VB.PictureBox pic_Karte
- AutoRedraw = -1 'True
- BackColor = &H00FFFFFF&
- Height = 855
- Left = 3000
- ScaleHeight = 53
- ScaleMode = 3 'Pixel
- ScaleWidth = 45
- TabIndex = 0
- ToolTipText = "Jö schau es funktioniert"
- Top = 120
- Width = 735
- End
- Begin VB.Label Label12
- BackStyle = 0 'Transparent
- Caption = "s_Tourpunkte_Muss"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 54
- Top = 120
- Width = 2535
- End
- Begin VB.Menu mnuAuswahl
- Caption = "Auswahl"
- Begin VB.Menu mnuNeuerMittelpunkt
- Caption = "neuer Mittelpunkt"
- End
- End
- End
- Attribute VB_Name = "ctl_Gis"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = True
- Attribute VB_PredeclaredId = False
- Attribute VB_Exposed = False
- Option Explicit
- '1 (Kunden) 3 Muss/Kann
- '2 (Wagen) 4 Muss/Kann
- '3 (Fahrten) 2 Muss/Kann
- '4 (Rückholer F.) 6 Muss
- '5 (Objekte) 1 Muss/Kann
- '6 (Karten) 0 Kann
- '7 (Adressen) 7 Muss/Kann
- '8 (Tourpunkte) 8 Muss '*Konstante im Code mit Typen enthalten !!!
- '9 (Tp_Vergleich) 9 Muss '*Konstante im Code mit Typen enthalten !!!
- 'Präfix:
- 'Als Elemente werden alle darzustellenden Informationspunkte (Kartenteile, Fahrten, Kunden ...) bezeichnet
- 'Objekte sind wichtige oder bekannte Punkte im Darsellungsbereich (Krankenhäuser, Theater etc...)
- '*** Einstellungen für Zeichnen von Regionen
- Private Type LOGBRUSH
- lbStyle As Long
- lbColor As Long
- lbHatch As Long
- End Type
- 'Regionsfunktionen: - weitere Typen unten
- Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
- Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
- Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
- Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
- Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
- Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, _
- lpPoint As POINTAPI, ByVal nCount As Long) As Long
- 'Brush Styles: - weitere Themen unten
- Private Const BS_SOLID = 0
- 'Hatch Styles
- Private Const HS_SOLID = 8
- 'Pen Styles
- Private Const PS_SOLID = 0
- 'PolyFill() Modes
- Private Const WINDING = 2
- 'Object Definitions for EnumObjects()
- Private Const OBJ_PEN = 1
- Private Const OBJ_BRUSH = 2
- Dim hPenSave As Long, hBrushSave As Long
- Dim hRegion() As Long
- '**************** Const für derzeitige Doku in Ordnung *******************************
- Const C__Teilbild_Grösse_X = 525
- Const C__Teilbild_Grösse_Y = 376
- Const cVerzBilder = "GisBilder\"
- Const C__Muss = "M" 'für automatisiertes Auslesen: ob Kann/Muss Feld
- Const C__Kann = "K"
- Const cMax_Ebenen = 2 'Anzahl der Darstellungsebenen
- Const C__TOUR = 8 'TYP Definition für Tour
- Const C__TOUR_Vergleich = 9 'TYP Definition für Tour
- 'Interne Variablen
- Dim b_Hoechste_Ebene As Boolean 'für Sofortfahrt - ganz zuletzt zeichnen, damit immer sichtbar
- 'Eckpunkte für das SQL-Select erweiterter Darstellungsbereiches
- Dim d__Get_Px1 As Double
- Dim d__Get_Py1 As Double
- Dim d__Get_Px2 As Double
- Dim d__Get_Py2 As Double
- Dim l__Paint_Status As Long 'Status für Funktion Paint()
- '**************** Variablen bereits in Ordnung ****************************
- 'Interne Hilfsvariabeln für Eigenschaften "
- 'Mittelpunkt Geokoordinaten + -alt
- Dim d__M_Gx As Double
- Dim d__M_Gy As Double
- Dim d__M_Gx_alt As Double
- Dim d__M_Gy_alt As Double
- 'Layerstufe
- Dim l__LYID As Long 'dargestellte LayerID: 10: 64dpi, 20: 128dpi, 30: 338 dpi 0: Automatic
- Dim l__LYID_alt As Long 'dargestellte LayerID: 10: 64dpi, 20: 128dpi, 30: 338 dpi
- Dim d__Zoom As Double 'Umrechnungsfaktor: Pixel in Geokoordinaten
- 'Fixmittelpunkt definieren
- Dim d__M_Gx_Fix As Double
- Dim d__M_Gx_Fix_alt As Double
- Dim d__M_Gy_Fix As Double
- Dim d__M_Gy_Fix_alt As Double
- 'Letzte Mauskoordinaten im Darstellungsbereich für Popupmenü
- Dim si_Maus_X_Popup As Single
- Dim si_Maus_Y_Popup As Single
- 'Mittelpunkt auch anzeigen
- Dim b__Mittelpunkt_anzeigen As Boolean
- 'Variablen grafische Disponierungn
- Dim l_gra_Fid As Long 'Fahrt ID
- Dim l_gra_Wid As Long 'Wagen ID
- Dim l_gra_Lid As Long 'Lenker ID
- '**********************************************************************************************
- '********************* Code alt und undokumentiert ***************************************************
- Dim b_Muss_Felder_Gefunden As Boolean 'Anzahl der Mussfelder fürs Zeichnen
- 'Diese Deklarationen werden teilweise noch nicht verwendet bzw noch nicht richtig dokumentiert
- 'Deklaration für Darstellungsoptionen
- Dim l__RR_Zeitspanne As Long 'Plus-Minus Zeit in Minuten, für die für die
- 'Rückholung in Frage kommende Fahrzeuge
- Dim l__RR_Zeitspanne_alt As Long
- Dim s__KID_muss_alt As String
- Dim s__FID_muss_alt As String
- Dim s__WID_kann_alt As String
- 'Beschreibt Umrandung von Darstellungsfläche
- Private Type typDarstellungsrahmen
- Region As Long
- End Type
- Dim Darstellungsrahmen As typDarstellungsrahmen
- 'Internes Elementarray - Verwaltet alle darzustellende Elemenete
- Private Type st__Elemente
- TYP As Long 'Art des Objektes
- Kontext As String 'Info über beutzerdefinierte Anzeige bei Auswahl Kontext für Element
- Pos1Gx As Long 'GeoX Startposition dieses Elementes
- Pos1Gy As Long 'GeoY Startposition dieses Elementes
- Pos2Gx As Long 'GeoX Endposition dieses Elementes
- Pos2Gy As Long 'GeoY Endposition dieses Elementes
- Pos1Px As Single 'PixX Startposition dieses Elementes
- Pos1Py As Single 'PixY Startposition dieses Elementes
- 'Wenn Element ohne Endposition wird sie durch Startposition ergänzt
- Pos2Px As Single 'PixX Endposition dieses Elementes
- Pos2Py As Single 'PixY Endposition dieses Elementes
- Ebene As Long 'Beschreibt in welchen Ebenendurchlauf das Element gezeichnet wird
- Muss As Boolean 'Definiert Element Ergebnis einer Mussabfrage ist
- RollerPlätze As Long 'Für Wagen Anzahl Rollerplätze
- Transportart As String 'Für Sofortfahrt - Transportart
- Pkw As Boolean 'Für Sofortfahrt
- Id As Long 'ID für Typ
- von_Region As Long
- zw_Region As Long 'Region der Fahrt
- nach_Region As Long 'Region Zielpunkt
- End Type
- Private Type st__Touren_Typ
- st__Touren() As st__Elemente
- Color As Long
- End Type
- Const LOG_Dateiname = "GisCtl.log"
- Dim st__Element() As st__Elemente
- Dim st__Touren() As st__Elemente
- Dim st__Touren_Vergleich() As st__Elemente
- '************ ENDE Code alt und undokumentiert ***************************************************
- 'Events:
- Event MausÜberRegion()
- Event MausÜberRegionKontext(Kontext As String)
- Event Mittelpunktverschiebung(GeoX As Long, GeoY As Long)
- Event FahrtDisponieren(lfid As Long, lshift As Long)
- Event WagenFahrtenZuweisen(lWid As Long, lshift As Long)
- Event RegionfürDisposition(TYP As Long, Id As Long)
- Event ListenAktualisieren(Id As Long)
- Public Sub Mittelpunkt_Fix_Initalisieren()
- d_M_Gx_Fix = 0
- d_M_Gy_Fix = 0
- End Sub
- Private Sub UserControl_Resize() 'Bild für Kartendarstellung an Controlgröße anpassen
- '"UsCoRS"
- ' Anpassen der Figurgröße, damit der sichtbare
- ' Bereich vom Figurbeschriftung-Steuerelement
- ' ausgefüllt wird.
- On Error Resume Next
- Dim s As String
- Debug.Print "Breite Gesamt: " & ScaleWidth
- Debug.Print "Breite Frame: " & fme_Eingabewerte.Width
- Debug.Print "Breite Differenz: " & ScaleWidth - fme_Eingabewerte.Width
- 'Hier wird gecheckt ob Frame links ein- bzw ausgeblendet ist
- 'Wichtig für Größenformatierung
- If fme_Eingabewerte.Visible Then 'eingeblendet
- 'Frame für Eingabewerte an Darstellungsgröße anpassen "UsCoRS-1"
- fme_Eingabewerte.Top = fme_Eingabewerte.Top + 10
- fme_Eingabewerte.Height = ScaleHeight - 20
- 'Darstellungsbereich an Darstellungsgröße anpassen "UsCoRS-2"
- pic_Karte.Move fme_Eingabewerte.Width + 10, _
- 0 + 10, _
- ScaleWidth - fme_Eingabewerte.Width - 20, _
- ScaleHeight - 20
- Else 'nicht eingeblendet
- 'Darstellungsbereich an Darstellungsgröße anpassen "UsCoRS-2"
- pic_Karte.Move 10, _
- 0 + 10, _
- ScaleWidth - 20, _
- ScaleHeight - 20
-
- End If
- Debug.Print pic_Karte.Left & ", " & pic_Karte.ScaleWidth & ", " & pic_Karte.Top & ", " & pic_Karte.ScaleHeight
- ReDim Preserve st__Element(0) '"UsCoRS-3"
- ReDim Preserve st__Touren(0) '"UsCoRS-3"
- ''Frame für Eingabewerte an Darstellungsgröße anpassen "UsCoRS-1"
- 'fme_Eingabewerte.Top = fme_Eingabewerte.Top + 10
- 'fme_Eingabewerte.Height = ScaleHeight - 20
- '
- ''Darstellungsbereich an Darstellungsgröße anpassen "UsCoRS-2"
- 'pic_Karte.Move fme_Eingabewerte.Width + 10, _
- ' 0 + 10, _
- ' ScaleWidth - fme_Eingabewerte.Width - 20, _
- ' ScaleHeight - 20
- 'Debug.Print pic_Karte.Left & ", " & pic_Karte.ScaleWidth & ", " & pic_Karte.Top & ", " & pic_Karte.ScaleHeight
- 'ReDim Preserve st__Element(0) '"UsCoRS-3"
- 'Darstellungsrahmen definieren
- 'Darstellungsrahmen_definieren Später für Mouseover und Karte verschieben
- End Sub
- Private Sub Darstellungsrahmen_definieren()
- 'MsgBox "Links oben: " & pic_Karte.Left & ", " & pic_Karte.Top & vbCr & _
- ' "Rechts oben: " & pic_Karte.Left + pic_Karte.ScaleWidth & ", " & pic_Karte.Top & vbCr & _
- ' "Rechts unten: " & pic_Karte.Left + pic_Karte.ScaleWidth & ", " & pic_Karte.Top - pic_Karte.ScaleHeight & vbCr & _
- ' "Links unten: " & pic_Karte.Left & ", " & pic_Karte.Top - pic_Karte.ScaleHeight & vbCr
- End Sub
- 'Neuer Mittelpunkt
- Private Sub mnuNeuerMittelpunkt_Click()
- On Error Resume Next
- Dim GDiffX As Long
- Dim GDiffY As Long
- On Error Resume Next
- 'X Berchnung - (1/2 Pixellänge - Mauskkordinaten) / Vergr. Faktor = Diff in GeoKo
- GDiffX = ((pic_Karte.ScaleWidth / 2) - si_Maus_X_Popup) * Me.d_Zoom
- GDiffX = Me.Mp_Gx - GDiffX 'GeoWert von Mittelpunktwert abziehen
- 'Y Berchnung
- GDiffY = ((pic_Karte.ScaleHeight / 2) - si_Maus_Y_Popup) * Me.d_Zoom '(1/2 Pixellänge - Mauskkordinaten) / Vergr. Faktor = Diff in GeoKo
- GDiffY = Me.Mp_Gy + GDiffY 'GeoWert von Mittelpunktwert abziehen
- RaiseEvent Mittelpunktverschiebung(GDiffX, GDiffY) 'Ereignis Mittelpunkt verändern - Wunsch
- End Sub
- Private Sub pic_Karte_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
- On Error GoTo ende
- Dim rs As ADODB.Recordset
- Dim SQL As String
- 'Eingefügt Gü. am 15.06.2006
- 'Fahrt grafisch(Maus taste - Drag and Drop) disponieren
- '1.Maus über Region Wagen?
- If txt_MausOver_Typ = 2 Then
- If l_gra_Fid > 0 Then
- 'Wageninfos auslesen
- l_gra_Wid = MausOver_ID 'WagenID = ausgew.Region ID
- Get_Dispo_Wagen_Lenker 'Schreibt 'LenkerID für Wagen
- If l_gra_Lid = 0 Then
- MsgBox "Bitte diesem Wagen erst einen Lenker zuordnen"
- GoTo ende
- End If
- 'Frage ob Disposition?
- Dim k As Long
- k = MsgBox("Ausgewählte Fahrt " & vbCr & _
- "auf Wagen Nr: " & l_gra_Wid & vbCr & _
- "Lenker Nr: " & l_gra_Lid & vbCr & _
- "disponieren?", vbYesNo, "Fahrt disponieren")
- 'Durchführen
- If k = 6 Then 'Yes - disponieren
- If Fahrt_disponieren = 1 Then 'Aufruf Fahrt disponieren
- sub_Info_Anzeigen "Speichern der Fahrt erfolgreich"
- RaiseEvent ListenAktualisieren(fun_Get_Nummer(l_gra_Fid))
- Else
- MsgBox "Beim Disponieren der Fahrt ist ein Fehler aufgetreten"
- End If
- End If
- End If
- End If
- ende:
- 'Status herstellen 'vielleicht nur wenn auch notwendig
- l_gra_Fid = 0
- l_gra_Wid = 0
- l_gra_Lid = 0
- MousePointer = vbNormal
- End Sub
- Private Function Fahrt_disponieren() As Long
- 'Fahrt disponieren hab ich ausgelager, da man hier jetzt auch
- 'bequem Rechte etc einbauen kann - der Hauptcode bleibt übersichtlich
- Dim rs As ADODB.Recordset
- Dim SQL As String
- On Error GoTo fehler
- 'Nochmals checken ob alle Daten vorhanden
- If l_gra_Fid > 0 And _
- l_gra_Wid > 0 Then
- If l_gra_Fid > 0 Then
- SQL = "Update t_fahrten " & _
- " Set Wid = " & fun_Get_Nummer(l_gra_Wid) & ", " & _
- " Lid = " & fun_Get_Nummer(l_gra_Lid) & _
- " WHERE Fid = " & fun_Get_Nummer(l_gra_Fid)
- Set rs = fun_get_RS(SQL)
- If Connection_Fehlerbehandlung("Fehler beim Einlesen " & vbCr & "Standardlenker für Wagen") Then
- sub_Info_Anzeigen "Fahrt erfolgreich disponiert"
- Fahrt_disponieren = 1 'kein Fehler gefunden
- End If
- Else
- MsgBox "Keine Fahrt zum disponieren gefunden"
- End If
- Else
- MsgBox "Wagen oder Lenker nicht vorhanden"
- End If
- Exit Function
- fehler:
- End Function
- Private Sub Get_Dispo_Wagen_Lenker()
- 'Für die Disponierung einer Fahrt wird für
- 'den Wagen auch der Lenker festgelegt
- Dim rs As ADODB.Recordset
- Dim SQL As String
- On Error Resume Next
- SQL = "SELECT lid " & _
- " FROM t_wagen " & _
- " WHERE NOT del " & _
- " AND aktiv " & _
- " AND wid = " & fun_Get_Nummer(l_gra_Wid)
- Set rs = fun_get_RS(SQL)
- If Connection_Fehlerbehandlung("Fehler beim Einlesen " & vbCr & "Standardlenker für Wagen") Then
- l_gra_Lid = fun_Get_Nummer(rs.Fields(0))
- End If
- End Sub
- Private Sub pic_Karte_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
- si_Maus_X_Popup = x
- si_Maus_Y_Popup = y
- On Error Resume Next
- 'Direktverschiebung über linke Taste
- If Button = 1 Then
- 'Eingefügt Gü. am 15.06.2006
- 'Fahrt grafisch(Maus taste - Drag and Drop) disponieren
- '1.Maus über Region Fahrt?
- Debug.Print "X:" & txt_MausOver_Typ & ":"
- If fun_Get_Nummer(txt_MausOver_Typ) >= 2 And fun_Get_Nummer(txt_MausOver_Typ) <= 4 Then
- RaiseEvent RegionfürDisposition(txt_MausOver_Typ, txt_MausOver_ID)
- MousePointer = ccSize
- If (fun_Get_Nummer(txt_MausOver_Typ) = 3 Or fun_Get_Nummer(txt_MausOver_Typ) = 4) Then
- '1a:ja: 'Fahrt ID merken 'kann man aus txt_MausOver_ID auslesen
- l_gra_Fid = MausOver_ID
- 'kein neuer Mittelpunkt
- Else
- mnuNeuerMittelpunkt_Click
- End If
- Else
- mnuNeuerMittelpunkt_Click
- End If
- Else
- PopupMenu mnuAuswahl 'Popupmenü neuer Mittelpunkt
- End If
- End Sub
- '**************** Eigenschaften sauber ++++++++++
- 'Eigenschaften dieses Ctls
- 'Darstellungsbereich
- Public Property Get DarstB_Left() As String
- On Error Resume Next
- DarstB_Left = pic_Karte.Left
- End Property
- Public Property Get DarstB_Top() As String
- On Error Resume Next
- DarstB_Top = pic_Karte.Top
- End Property
- Public Property Get DarstB_Width() As String
- On Error Resume Next
- DarstB_Width = pic_Karte.ScaleWidth
- End Property
- Public Property Get DarstB_Height() As String
- On Error Resume Next
- DarstB_Height = pic_Karte.Height
- End Property
- 'Mittelpunktbereich
- Public Property Get Mp_Gx() As Double
- On Error Resume Next
- Mp_Gx = d__M_Gx
- End Property
- Private Property Let Mp_Gx(ByVal vNewValue As Double)
- On Error Resume Next
- d__M_Gx = vNewValue
- End Property
- Public Property Get Mp_Gy() As Double
- On Error Resume Next
- Mp_Gy = d__M_Gy
- End Property
- Private Property Let Mp_Gy(ByVal vNewValue As Double)
- On Error Resume Next
- d__M_Gy = vNewValue
- End Property
- Public Property Get Mp_Gx_alt() As Double
- On Error Resume Next
- Mp_Gx_alt = d__M_Gx_alt
- End Property
- Private Property Let Mp_Gx_alt(ByVal vNewValue As Double)
- On Error Resume Next
- d__M_Gx_alt = vNewValue
- End Property
- Public Property Get Mp_Gy_alt() As Double
- On Error Resume Next
- Mp_Gy_alt = d__M_Gy_alt
- End Property
- Private Property Let Mp_Gy_alt(ByVal vNewValue As Double)
- On Error Resume Next
- d__M_Gy_alt = vNewValue
- End Property
- 'SQL - Abfrage Where Parameter
- Public Property Get s_KID_muss() As String
- On Error Resume Next
- s_KID_muss = txt_KID_muss
- End Property
- Public Property Let s_KID_muss(ByVal vNewValue As String)
- On Error Resume Next
- txt_KID_muss = vNewValue
- End Property
- Public Property Get s_FID_muss() As String
- On Error Resume Next
- s_FID_muss = txt_FID_muss
- End Property
- Public Property Let s_FID_muss(ByVal vNewValue As String)
- On Error Resume Next
- txt_FID_muss = vNewValue
- End Property
- Public Property Get s_FID_kann() As String
- On Error Resume Next
- s_FID_kann = txt_FID_kann
- End Property
- Public Property Let s_FID_kann(ByVal vNewValue As String)
- On Error Resume Next
- txt_FID_kann = vNewValue
- End Property
- Public Property Get s_WID_kann() As String
- On Error Resume Next
- s_WID_kann = txt_Wid_kann
- End Property
- Public Property Let s_WID_kann(ByVal vNewValue As String)
- On Error Resume Next
- txt_Wid_kann = vNewValue
- End Property
- Public Property Get s_Tour_muss() As String
- On Error Resume Next
- s_Tour_muss = txt_TOUR_muss
- End Property
- Public Property Let s_Tour_muss(ByVal vNewValue As String)
- On Error Resume Next
- txt_TOUR_muss = vNewValue
- End Property
- Public Property Get s_Tour_Vergleich_muss() As String
- On Error Resume Next
- s_Tour_muss = txt_Tour_Vergleich_Muss
- End Property
- Public Property Let s_Tour_Vergleich_muss(ByVal vNewValue As String)
- On Error Resume Next
- txt_Tour_Vergleich_Muss = vNewValue
- End Property
- 'Sofortfahrt
- Public Property Get l_Sofortfahrt_muss() As String
- On Error Resume Next
- l_Sofortfahrt_muss = txt_Sofortfahrt_muss
- End Property
- Public Property Let s_Sofortfahrt_muss(ByVal vNewValue As String)
- On Error Resume Next
- txt_Sofortfahrt_muss = vNewValue
- End Property
- 'Layerstufe
- Public Property Get l_LYID() As Long
- On Error Resume Next
- l_LYID = l__LYID
- End Property
- Public Property Let l_LYID(ByVal vNewValue As Long)
- On Error Resume Next
- l__LYID = vNewValue
- End Property
- Private Property Get l_LYID_alt() As Long
- On Error Resume Next
- l_LYID_alt = l__LYID_alt
- End Property
- Private Property Let l_LYID_alt(ByVal vNewValue As Long)
- On Error Resume Next
- l__LYID_alt = vNewValue
- End Property
- Public Property Get d_Zoom() As Double
- On Error Resume Next
- d_Zoom = d__Zoom
- End Property
- Public Property Let d_Zoom(ByVal vNewValue As Double)
- On Error Resume Next
- d__Zoom = vNewValue
- End Property
- 'Größe der Karte (als Bild)
- Public Property Get l_Bild_x() As Double
- On Error Resume Next
- l_Bild_x = C__Teilbild_Grösse_X
- End Property
- Public Property Get l_Bild_y() As Double
- On Error Resume Next
- l_Bild_y = C__Teilbild_Grösse_Y
- End Property
- 'Darstellungsebenen
- Public Property Get Darstellungsebenen() As Double
- On Error Resume Next
- Darstellungsebenen = cMax_Ebenen
- End Property
- 'Maus über Region
- Public Property Get MausOver_Typ() As Long
- On Error Resume Next
- MausOver_Typ = fun_Get_Nummer(txt_MausOver_Typ)
- End Property
- Public Property Get MausOver_ID() As Long
- On Error Resume Next
- MausOver_ID = fun_Get_Nummer(txt_MausOver_ID)
- End Property
- 'FixMittelpunkt zuweisen
- Public Property Get d_M_Gx_Fix() As Double
- On Error Resume Next
- d_M_Gx_Fix = d__M_Gx_Fix
- End Property
- Public Property Let d_M_Gx_Fix(ByVal vNewValue As Double)
- On Error Resume Next
- d__M_Gx_Fix = vNewValue
- End Property
- Public Property Get d_M_Gy_Fix() As Double
- On Error Resume Next
- d_M_Gy_Fix = d__M_Gy_Fix
- End Property
- Public Property Let d_M_Gy_Fix(ByVal vNewValue As Double)
- On Error Resume Next
- d__M_Gy_Fix = vNewValue
- End Property
- Public Property Get b_Mittelpunkt_anzeigen() As Boolean
- On Error Resume Next
- b_Mittelpunkt_anzeigen = b__Mittelpunkt_anzeigen
- End Property
- Public Property Let b_Mittelpunkt_anzeigen(ByVal vNewValue As Boolean)
- On Error Resume Next
- b__Mittelpunkt_anzeigen = vNewValue
- End Property
- '**************** Ende *******************+++
- Sub GISLOG(s_Aufruf_Stelle As String) '"GISLOG"
- 'Informationen über Parameter werden in eine Datei geschrieben eher unbedeutend derzeit
- Dim s As String
- On Error Resume Next
- s = LOG_Dateiname
- txt_AppendLine s, " "
- txt_AppendLine s, "*****" & s_Aufruf_Stelle & " " & Now & " ********"
- txt_AppendLine LOG_Dateiname, "l__Paint_Status: " & l__Paint_Status
- txt_AppendLine LOG_Dateiname, "d__Zoom: " & d__Zoom
- txt_AppendLine LOG_Dateiname, "Layerstufe alt: " & l_LYID_alt & " neu: " & l_LYID
- txt_AppendLine LOG_Dateiname, "d__Get_Px1: " & d__Get_Px1
- txt_AppendLine LOG_Dateiname, "d__Get_Py1: " & d__Get_Py1
- txt_AppendLine LOG_Dateiname, "d__Get_Px2: " & d__Get_Px2
- txt_AppendLine LOG_Dateiname, "d__Get_Py2: " & d__Get_Py2
- txt_AppendLine LOG_Dateiname, "d__M_Gx: " & Mp_Gx
- txt_AppendLine LOG_Dateiname, "d__M_Gy: " & Mp_Gy
- End Sub
- Public Sub Initalize(i As Long) '"Initalize"
- 'Initalisiert Paint_Status mit übergegebenen Wert
- 'Diese Routine ist mehr als fraglich ??
- On Error Resume Next
- l__Paint_Status = i
- End Sub
- Private Sub Pixelkoordinaten_für_Elemente() '"PiKoo_Elemente"
- 'Bestimmt für jedes Element die Pixelposition aufgrund Koordinaten, Typen und Layerinformation
- Dim M As GeoPunkt
- Dim B As GeoPunkt
- Dim Diff As GeoPunkt
- Dim R As GeoPunkt
- Dim R1 As GeoPunkt
- Dim l_Faktor_X As Long
- Dim l_Faktor_Y As Long
- On Error Resume Next
- 'Interner GeoMittelpunkt (diese Werte sind schon wo festgelegt
- '"PiKoo_Elemente - 1"
- M.Gx = Mp_Gx
- M.Gy = Mp_Gy
- M.Px = DarstB_Width / 2
- M.Py = DarstB_Height / 2
- Dim J As Long
- Dim x As Long
- Dim i As Long
- 'Erstmals Ecke Rechts oben von Bilder holen "PiKoo_Elemente - 2"
- For J = 0 To UBound(st__Element) - 1 '1.Element von diesem Typ ist richtiger Darstellungsbereich
- If st__Element(J).TYP = 6 Then 'Das Bild rechts oben wird von allen Bildern immer das 1.sein,
- 'da nach x, y sortiert eingelesen wird
-
- R1.Gx = st__Element(J).Pos1Gx
- R1.Gy = st__Element(J).Pos1Gy
- R1.Px = M.Px - (M.Gx - R1.Gx) / d__Zoom
- R1.Py = M.Py + (M.Gy - R1.Gy) / d__Zoom
- Exit For
- End If
- Next
-
- ''Für jedes Element Positionen errechnen "PiKoo_Elemente - 3"
- For J = 0 To UBound(st__Element) - 1
- For x = 1 To 2 'Von und Zieladresse
- If x = 1 Then
- Debug.Print st__Element(J).TYP
- B.Gx = st__Element(J).Pos1Gx 'Geokoordinaten zuweisen
- B.Gy = st__Element(J).Pos1Gy
- Else
- B.Gx = st__Element(J).Pos2Gx
- B.Gy = st__Element(J).Pos2Gy
- End If
-
- Dim dDiff_in_Meter_Abzug_X As Double
- Dim dDiff_in_Meter_Abzug_Y As Double
-
- Select Case st__Element(J).TYP
- Case 6
- 'Geodifferenz Rechteck - Bild
- dDiff_in_Meter_Abzug_X = R1.Gx
- dDiff_in_Meter_Abzug_Y = R1.Gy
- Case Else
- 'Differenz in Meter ausrechnen
- dDiff_in_Meter_Abzug_X = Mp_Gx
- dDiff_in_Meter_Abzug_Y = Mp_Gy
- End Select
-
- Diff.Gx = B.Gx - dDiff_in_Meter_Abzug_X 'Geodifferenz
- Diff.Gy = B.Gy - dDiff_in_Meter_Abzug_Y
-
- Diff.Px = Diff.Gx / d__Zoom 'Pixeldifferenz Rechteck - Bild
- Diff.Py = Diff.Gy / d__Zoom
-
- Select Case st__Element(J).TYP
- Case 6
- 'Warum weiß ich noch nicht genau ??
- l_Faktor_X = Diff.Px / l_Bild_x
- l_Faktor_Y = Diff.Py / l_Bild_y
- 'Pixelfaktor für Bild zuweisen
- st__Element(J).Pos1Px = R1.Px + l_Faktor_X * l_Bild_x
- st__Element(J).Pos1Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
- 'Gibt's nur einen Punkt, das ist eigentlich unnötig
- st__Element(J).Pos2Px = R1.Px + l_Faktor_X * l_Bild_x
- st__Element(J).Pos2Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
- Case Else
- If x = 1 Then
- ' Punkt auf der Karte ausrechnen
- st__Element(J).Pos1Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
- st__Element(J).Pos1Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
- Else
- st__Element(J).Pos2Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
- st__Element(J).Pos2Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
- End If
- End Select
- Next
- Next
- 'Für jede Tour Pixelkoordinaten errechnen
- For J = 0 To UBound(st__Touren) - 1
- For x = 1 To 2 'Von und Zieladresse
- If x = 1 Then
- Debug.Print st__Touren(J).TYP
- B.Gx = st__Touren(J).Pos1Gx 'Geokoordinaten zuweisen
- B.Gy = st__Touren(J).Pos1Gy
- Else
- B.Gx = st__Touren(J).Pos2Gx
- B.Gy = st__Touren(J).Pos2Gy
- End If
- Select Case st__Touren(J).TYP
- Case 6
- 'Geodifferenz Rechteck - Bild
- dDiff_in_Meter_Abzug_X = R1.Gx
- dDiff_in_Meter_Abzug_Y = R1.Gy
- Case Else
- 'Differenz in Meter ausrechnen
- dDiff_in_Meter_Abzug_X = Mp_Gx
- dDiff_in_Meter_Abzug_Y = Mp_Gy
- End Select
-
- Diff.Gx = B.Gx - dDiff_in_Meter_Abzug_X 'Geodifferenz
- Diff.Gy = B.Gy - dDiff_in_Meter_Abzug_Y
-
- Diff.Px = Diff.Gx / d__Zoom 'Pixeldifferenz Rechteck - Bild
- Diff.Py = Diff.Gy / d__Zoom
-
- Select Case st__Touren(J).TYP
- Case 6
- 'Warum weiß ich noch nicht genau ??
- l_Faktor_X = Diff.Px / l_Bild_x
- l_Faktor_Y = Diff.Py / l_Bild_y
- 'Pixelfaktor für Bild zuweisen
- st__Touren(J).Pos1Px = R1.Px + l_Faktor_X * l_Bild_x
- st__Touren(J).Pos1Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
- 'Gibt's nur einen Punkt, das ist eigentlich unnötig
- st__Touren(J).Pos2Px = R1.Px + l_Faktor_X * l_Bild_x
- st__Touren(J).Pos2Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
- Case Else
- If x = 1 Then
- ' Punkt auf der Karte ausrechnen
- st__Touren(J).Pos1Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
- st__Touren(J).Pos1Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
- Else
- st__Touren(J).Pos2Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
- st__Touren(J).Pos2Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
- End If
- End Select
- Next
- Next
- 'Für jede Tour Pixelkoordinaten errechnen
- For J = 0 To UBound(st__Touren_Vergleich) - 1
- For x = 1 To 2 'Von und Zieladresse
- If x = 1 Then
- Debug.Print st__Touren_Vergleich(J).TYP
- B.Gx = st__Touren_Vergleich(J).Pos1Gx 'Geokoordinaten zuweisen
- B.Gy = st__Touren_Vergleich(J).Pos1Gy
- Else
- B.Gx = st__Touren_Vergleich(J).Pos2Gx
- B.Gy = st__Touren_Vergleich(J).Pos2Gy
- End If
-
-
- Select Case st__Touren_Vergleich(J).TYP
- Case 6
- 'Geodifferenz Rechteck - Bild
- dDiff_in_Meter_Abzug_X = R1.Gx
- dDiff_in_Meter_Abzug_Y = R1.Gy
- Case Else
- 'Differenz in Meter ausrechnen
- dDiff_in_Meter_Abzug_X = Mp_Gx
- dDiff_in_Meter_Abzug_Y = Mp_Gy
- End Select
-
- Diff.Gx = B.Gx - dDiff_in_Meter_Abzug_X 'Geodifferenz
- Diff.Gy = B.Gy - dDiff_in_Meter_Abzug_Y
-
- Diff.Px = Diff.Gx / d__Zoom 'Pixeldifferenz Rechteck - Bild
- Diff.Py = Diff.Gy / d__Zoom
-
- Select Case st__Touren_Vergleich(J).TYP
- Case 6
- 'Warum weiß ich noch nicht genau ??
- l_Faktor_X = Diff.Px / l_Bild_x
- l_Faktor_Y = Diff.Py / l_Bild_y
- 'Pixelfaktor für Bild zuweisen
- st__Touren_Vergleich(J).Pos1Px = R1.Px + l_Faktor_X * l_Bild_x
- st__Touren_Vergleich(J).Pos1Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
- 'Gibt's nur einen Punkt, das ist eigentlich unnötig
- st__Touren_Vergleich(J).Pos2Px = R1.Px + l_Faktor_X * l_Bild_x
- st__Touren_Vergleich(J).Pos2Py = R1.Py - l_Faktor_Y * l_Bild_y - l_Bild_y
- Case Else
- If x = 1 Then
- ' Punkt auf der Karte ausrechnen
- st__Touren_Vergleich(J).Pos1Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
- st__Touren_Vergleich(J).Pos1Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
- Else
- st__Touren_Vergleich(J).Pos2Px = DarstB_Width / 2 + Diff.Px ' x geo und x auf der Karte in die selbe Richgung
- st__Touren_Vergleich(J).Pos2Py = DarstB_Height / 2 - Diff.Py ' y geo: nach Norden, auf der Karte nach Süden --> -
- End If
- End Select
- Next
- Next
- End Sub
- Public Sub sub_Finden_Region(Button As Integer, Shift As Integer, x As Single, y As Single)
- '* "FinReg"
- '* Diese Routine checkt ob sich die aktuelle Mausposition auf einer Elementenregion befindet
- Dim i As Long
- On Error Resume Next
- pic_Karte.ToolTipText = "" 'Zurücksetzen
- txt_MausOver_ID = vbNullString 'Auch zurücksezten
- txt_MausOver_Typ = vbNullString 'Auch zurücksetzen
- For i = 0 To UBound(st__Element) - 1
- Debug.Print st__Element(i).Kontext & ": " & st__Element(i).von_Region
- If PtInRegion(st__Element(i).von_Region, x, y) Or _
- PtInRegion(st__Element(i).nach_Region, x, y) Or _
- PtInRegion(st__Element(i).zw_Region, x, y) Then
- pic_Karte.ToolTipText = st__Element(i).Kontext 'Zurücksetzen
- 'Dieses Event kann eingesetzt werden um den GisViewer maßgeblich am erstellen
- 'des Kontextmenü mitwirken zu lassen
- 'RaiseEvent MausÜberRegionKontext(st__Element(i).Kontext) 'An GisViewer übergeben
- txt_Mo_Id = st__Element(i).Id ' ??schreibt ID für Typ auf das sich das Mouseover bezieht
-
- 'Checkt ob sich Region verändert hat
- 'Gehört wahrscheinlich noch weiter rauf
- Dim Id As String
- Dim TYP As String
- Id = st__Element(i).Id
- TYP = st__Element(i).TYP
- If (txt_MausOver_ID <> Id) Or _
- (txt_MausOver_Typ <> TYP) Then
-
- 'Schreibt Typ und ID von gefundener Region für externe Verarbeitung
- txt_MausOver_ID = Id
- txt_MausOver_Typ = TYP
-
- Select Case TYP
- 'Für Typenspezifische Behandlung
- End Select
-
- 'Wenn sich Region verändert hat, Ereignis auslösen
- RaiseEvent MausÜberRegion 'löst ein Ereignis aus
- End If
- Exit Sub 'Abbruch, da sonst drunterliegende Regionen noch gefunden werden
- End If
- Next
- End Sub
- Private Sub pic_Karte_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
- '* "MouMov" -- Maus wurde bewegt, ist sie über Elementregion?
- On Error Resume Next
- sub_Finden_Region Button, Shift, x, y 'Sucht Region zu ausgewählten Mausbereich
- 'Schreibt gewollte Informationen
- End Sub
- Sub Elemente_Reload_muss()
- '"Ele-Rel"
- 'Alle lemente für die Paint Funktion werden neu augebaut
- '* Auch diese Funktion ist mehr als fraglich
- On Error GoTo Abbr
- ReDim st__Element(0)
- ReDim st__Touren(0)
- ReDim st__Touren_Vergleich(0)
- Exit Sub
- Abbr:
- MsgBox "Fehler in Gis Darstellung -> Elemente_muss_Reload()"
- End Sub
- Public Sub Wertzuweisen(ctrName As String, ctrWert As Variant, Optional ctrBackColor As String)
- '"Wert_zuw"
- '* Diese Funktion weist einem bestimmten Feld Farbe und Wert zu.
- On Error Resume Next
- If LCase(MID(ctrName, 1, 3)) = "bol" Then
- Controls(ctrName).Value = ctrWert
- Else
- Controls(ctrName).Text = ctrWert
- End If
- If ctrBackColor <> vbNullString Then
- Controls(ctrName).BackColor = ctrBackColor
- End If
- End Sub
- Public Property Get s_Darstellungsbereich_Where() As String
- '"Dar_Where"
- '*Liefert für SQl Abfrage die GeoKoordinaten für den Darstellungsbereich
- On Error Resume Next
- s_Darstellungsbereich_Where = " AND pos1gx >= " & Int(d__Get_Px1) & _
- " AND pos1gx <= " & Int(d__Get_Px2) & _
- " AND pos1gy >= " & Int(d__Get_Py1) & _
- " AND pos1gy <= " & Int(d__Get_Py2)
- End Property
- Sub Elemente_Typ_Reload_neu(TYP As Long, Muss As Boolean, Ebene As Long)
- ' "Ele_Typ_Rel"
- '*Diese Prozedur ist für das Neuladen der richtigen Elemente für den
- '*übergebenen Typen zuständig
- On Error Resume Next
- Dim i As Long
- Dim k As Long
- Dim SQL As String
- Dim rs As ADODB.Recordset
- 'Alle Elemente vom Typen aus Array st__Element entfernen
- '"Ele_Typ_Rel - 1" *Das wäre super, wenn man eine Schleife pro Spalte machen könnte
- 'Touren
- If TYP = C__TOUR Then
- ReDim st__Touren(0)
- End If
- 'Vergleichstouren
- If TYP = C__TOUR_Vergleich Then
- ReDim st__Touren_Vergleich(0)
- End If
- If UBound(st__Element) > 0 Then
- For i = 0 To UBound(st__Element) - 1 'Array durcharbeiten
- If i > UBound(st__Element) - 1 Then
- GoTo OK
- End If
- 'Eingefügt am 03.07.2006 Gü
- 'Wenn Tourpunkt dann einfach Touren neu - derzeit nur 1 Tour möglich
- If st__Element(i).TYP = TYP Then
- For k = i To UBound(st__Element) - 1
- If k > UBound(st__Element) - 1 Then
- Debug.Print "jo"
- End If
- st__Element(k).TYP = st__Element(k + 1).TYP
- st__Element(k).Ebene = st__Element(k + 1).Ebene
- st__Element(k).Kontext = st__Element(k + 1).Kontext
- st__Element(k).Muss = st__Element(k + 1).Muss
- st__Element(k).Pos1Gx = st__Element(k + 1).Pos1Gx
- st__Element(k).Pos1Gy = st__Element(k + 1).Pos1Gy
- st__Element(k).Pos2Gx = st__Element(k + 1).Pos2Gx
- st__Element(k).Pos2Gy = st__Element(k + 1).Pos2Gy
- st__Element(k).Pos1Px = st__Element(k + 1).Pos1Px
- st__Element(k).Pos1Py = st__Element(k + 1).Pos1Py
- st__Element(k).Pos2Px = st__Element(k + 1).Pos2Px
- st__Element(k).Pos2Py = st__Element(k + 1).Pos2Py
- st__Element(k).RollerPlätze = st__Element(k + 1).RollerPlätze
- st__Element(k).Transportart = st__Element(k + 1).Transportart
- st__Element(k).Pkw = st__Element(k + 1).Pkw
- st__Element(k).Id = st__Element(k + 1).Id
- 'l__Paint_Status = 1 'Status 1 Mittelpunkt muss neu berechnet werden
- Next
- i = i - 1 'Wieder um 1 zurück da 1 Element gelöscht wird
- ReDim Preserve st__Element(UBound(st__Element) - 1)
- End If
- Next
- End If
- 'Informationsteil - Ausgabe von Infos in Datei
- '"Ele_Typ_Rel - 2"
- 'Hier sollte man vielleicht ein Tastenkürzel oder Bit einführen um dies zu aktivieren deaktivieren
- txt_WriteAll "C:GisCtl_Elemente.txt", "Elemente für letzte Darstellung, Typ : Kontext"
- For i = 0 To UBound(st__Element) - 1 'Array durcharbeiten
- txt_AppendLine "C:GisCtl_Elemente.txt", TYP & ":" & st__Element(i).Kontext
- Next
- 'Hier wird die SQl - Abfrage für den gewünschten Elementyp zusammengebaut
- '"Ele_Typ_Rel - 3"
- OK:
- '1 (Kunden) 3 Muss/Kann
- '2 (Wagen) 4 Muss/Kann
- '3 (Fahrten) 2 Muss/Kann
- '4 (Rückholer F.) 6 Muss
- '5 (Objekte) 1 Muss/Kann
- '6 (Karten) 0 Kann
- '7 (Adressen) 7 Muss/Kann
- '8 (Tourpunkte) 8 Muss
- Dim sql_Typ As String
- Dim sql_Muss As String
- If Muss Then
- sql_Muss = "True as muss, "
- Else
- sql_Muss = "False as muss, "
- End If
- sql_Typ = "SELECT * " & _
- "FROM "
-
- Debug.Print s_Tour_muss
-
- Select Case TYP
- Case 1 'Kunde
- If s_KID_muss <> vbNullString Then
- SQL = sql_Typ & _
- "v_gis_kunden WHERE " & s_KID_muss
- Debug.Print SQL
- End If
-
- Case 2 'Wagen
- If Me.s_WID_kann <> vbNullString Then
- 'Hier sollte auch der Wert von b_Transportart gecheckt werden
- txt_Wid_kann = txt_Wid_kann & s_Darstellungsbereich_Where
- 'Transportart orientiert anzeigen - verarbeiten
- If bol_Transportart Then 'nur wenn auch transportartorientiertes Anzeigen verlangt
- txt_Wid_kann = txt_Wid_kann & fun_SQL_Where_Transportart()
- End If
- SQL = sql_Typ & "v_gis_wid WHERE " & txt_Wid_kann
- Debug.Print SQL
- End If
- Case 3 'Fahrten
- If Muss Then
- If s_FID_muss <> vbNullString Then
- SQL = sql_Typ & _
- "v_gis_fahrten WHERE " & s_FID_muss
- End If
- Else
- If s_FID_kann <> vbNullString Then
- SQL = sql_Typ & _
- "v_gis_fahrten WHERE " & s_FID_kann
- End If
- End If
-
- Case 4 'Sofortfahrt
- If fun_Get_Nummer(Me.l_Sofortfahrt_muss) > 0 Then
- SQL = sql_Typ & _
- "v_gis_sofortfahrt WHERE fid = " & fun_Get_Nummer(Me.l_Sofortfahrt_muss)
- b_Hoechste_Ebene = True
- Else
- b_Hoechste_Ebene = False
- End If
- Debug.Print SQL
- Case 5 'Objekte
- '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)
- Case 6 'Kartenmaterial
- SQL = "SELECT '6' as typ, False as muss, 0 as ebene, " & _
- " dateiname as kontext, x as pos1gx, y as pos1gy, x as pos2gx, y as pos2gy " & _
- " FROM t_bilder " & _
- " WHERE NOT del " & _
- " AND aktiv " & _
- " AND lyid = " & fun_Get_Nummer(Me.l_LYID) & _
- " AND x >= " & Int(d__Get_Px1) & _
- " AND x <= " & Int(d__Get_Px2) & _
- " AND y >= " & Int(d__Get_Py1) & _
- " AND y <= " & Int(d__Get_Py2)
- SQL = SQL & _
- " ORDER BY X, Y DESC"
- Debug.Print SQL
- Case 7 'Adressen
- ' sql = "SELECT * FROM v_gis_fahrten " & s__FID_kann
- Case 8 'Tourpunkte
- Debug.Print txt_Tour_Muss_alt
- SQL = txt_TOUR_muss
- Case 9 'Tourpunkte
- Debug.Print txt_Tour_Vergleich_Muss
- SQL = txt_Tour_Vergleich_Muss
- End Select
- 'Hier wird die SQl - Abfrage durchgeführt und Element Array mit gefunden Elementen gefüllt
- '"Ele_Typ_Rel - 4"
- If SQL <> vbNullString Then 'Nur einlesen wenn auch Anweisung da ist
- Set rs = fun_get_RS(SQL)
- Debug.Print SQL
- If Connection_Fehlerbehandlung("Gis Objekte holen") Then
- Debug.Print rs.RecordCount
- If rs.RecordCount >= 1 Then
- rs.MoveFirst
- Do While Not rs.EOF
- Debug.Print "typ: " & TYP
- If TYP = 8 Then 'Tourtyp
- ReDim Preserve st__Touren(UBound(st__Touren) + 1)
- st__Touren(UBound(st__Touren) - 1).TYP = C__TOUR
- st__Touren(UBound(st__Touren) - 1).Kontext = "Gerät: " & rs.Fields("pdid") & " Zeit: " & rs.Fields("wann")
- st__Touren(UBound(st__Touren) - 1).Pos1Gx = rs.Fields("x_meter")
- st__Touren(UBound(st__Touren) - 1).Pos1Gy = rs.Fields("y_meter")
- st__Touren(UBound(st__Touren) - 1).Pos2Gx = rs.Fields("x_meter")
- st__Touren(UBound(st__Touren) - 1).Pos2Gy = rs.Fields("y_meter")
- st__Touren(UBound(st__Touren) - 1).Muss = Muss
- st__Touren(UBound(st__Touren) - 1).Ebene = 5
- st__Touren(UBound(st__Touren) - 1).Id = UBound(st__Touren)
- Else
- If TYP = 9 Then 'Tourtyp Vergleich
- ReDim Preserve st__Touren_Vergleich(UBound(st__Touren_Vergleich) + 1)
- st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).TYP = C__TOUR
- st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Kontext = "Gerät: " & rs.Fields("pdid") & " Zeit: " & rs.Fields("wann")
- st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Pos1Gx = rs.Fields("x_meter")
- st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Pos1Gy = rs.Fields("y_meter")
- st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Pos2Gx = rs.Fields("x_meter")
- st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Pos2Gy = rs.Fields("y_meter")
- st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Muss = Muss
- st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Ebene = 5
- st__Touren_Vergleich(UBound(st__Touren_Vergleich) - 1).Id = UBound(st__Touren)
- Else
- 'Ebene fehlt noch und Region
- ReDim Preserve st__Element(UBound(st__Element) + 1)
- st__Element(UBound(st__Element) - 1).TYP = TYP
- st__Element(UBound(st__Element) - 1).Kontext = rs.Fields("kontext")
- st__Element(UBound(st__Element) - 1).Pos1Gx = rs.Fields("pos1gx")
- st__Element(UBound(st__Element) - 1).Pos1Gy = rs.Fields("pos1gy")
- st__Element(UBound(st__Element) - 1).Pos2Gx = rs.Fields("pos2gx")
- st__Element(UBound(st__Element) - 1).Pos2Gy = rs.Fields("pos2gy")
- st__Element(UBound(st__Element) - 1).Muss = Muss
- st__Element(UBound(st__Element) - 1).Ebene = Ebene
- st__Element(UBound(st__Element) - 1).Transportart = rs.Fields("transportart")
- st__Element(UBound(st__Element) - 1).Pkw = rs.Fields("pkw")
- st__Element(UBound(st__Element) - 1).Id = rs.Fields("id")
- End If
- End If
- 'Typenspezifische Zuordnung
- Select Case st__Element(UBound(st__Element) - 1).TYP
- Case 2 'Wagen
- st__Element(UBound(st__Element) - 1).RollerPlätze = rs.Fields("roller")
- st__Element(UBound(st__Element) - 1).Id = rs.Fields("id") 'gehört später nach oben, da jeses Element
- 'eine ID haben sollte
- End Select
-
- rs.MoveNext
- Loop
- End If
- End If
- End If
- Debug.Print st__Element(UBound(st__Element) - 1).Id
- Debug.Print UBound(st__Element)
- For i = 0 To UBound(st__Touren) - 1
- Debug.Print "i: " & i & " Kontext: " & st__Touren(0).Kontext
- Next
- Exit Sub
- End Sub
- Private Sub Zeichnen_von_Elementen()
- '* "Zei_von_Ele" Zeichen der Elemente auf den Bildschirm
- Dim i As Long
- Dim J As Long
- Dim s As String
- Dim s1 As String
- On Error Resume Next
- '1.Grundlage wird geleert - "Zei_von_Ele - 01"
- pic_Karte.Cls
- '2. Infobild wenn keine Mussfelder vorhanden "Zei_von_Ele - 02"
- If Not b_Muss_Felder_Gefunden And d__M_Gx_Fix_alt = 0 Then
- s = cVerzBilder & "Keine_Elemente.gif"
- pic_Karte.PaintPicture LoadPicture(s), pic_Karte.ScaleWidth / 2 - 376 / 2, pic_Karte.ScaleHeight / 2 - 89 / 2, 376, 89
- Exit Sub
- End If
- 'Infoausgabe "Zei_von_Ele - 03"
- 'Später vielleicht mit Ausführungsbit
- txt_WriteAll "C:\Arrayreihenfolge.txt", " " 'Hilfsdatei initalisieren
- For J = 0 To UBound(st__Element) - 1 'Schreib Arrayreihenfolge in eine Datei
- txt_AppendLine "C:\Arrayreihenfolge.txt", _
- " Nr: " & J & _
- " Typ: " & st__Element(J).TYP & _
- " Ebene: " & st__Element(J).Ebene & _
- " Kontext: " & st__Element(J).Kontext
- Next
- 'Typengerechtes und ebenenbezogenes Zeichnen der Elemente "Zei_von_Ele - 04"
- 'Ich würd sagen, da steckt auch noch einiges an Potiential drin
- txt_WriteAll "C:Zeichenreihenfolge.txt", " " 'Hilfsdatei initalisieren
- For i = 0 To Darstellungsebenen 'Darstellungsebenen
- Debug.Print "Ebene: " & i
- For J = 0 To UBound(st__Element) - 1
- If st__Element(J).Ebene = i Then
- Dim pos1x As Long
- Dim Pos1y As Long
- Dim Pos2x As Long
- Dim Pos2y As Long
- Select Case st__Element(J).TYP
- Case 1 'Kunde anzeigen
- s = cVerzBilder & "blau_15.gif"
- pic_Karte.PaintPicture LoadPicture(s), st__Element(J).Pos1Px - 7, st__Element(J).Pos1Py - 7, 15, 15
- Case 2 ' Wagen anzeigen
- If st__Element(J).RollerPlätze > 0 Then
- s = cVerzBilder & "Roller_15.gif"
- Else
- s = cVerzBilder & "Pkw_15.gif"
- End If
-
- 'da kann mann noch kürzen bis zum Umfallen
- 'Position für Region und Positionierung ermitteln
- pos1x = st__Element(J).Pos1Px - 7
- Pos1y = st__Element(J).Pos1Py - 7
- Pos2x = st__Element(J).Pos1Px - 7 + 15 ' -7 = Bild in der Mitte +15 = Breite Bild
- Pos2y = st__Element(J).Pos1Py - 7 + 15
-
- 'Zeichnen der Wagen
- pic_Karte.PaintPicture LoadPicture(s), pos1x, Pos1y, 15, 15
- 'Region für Wagen erstellen
- st__Element(J).von_Region = Region_aus_Punkten(pos1x, Pos1y, Pos2x, Pos2y)
-
- Case 3, 4 ' Fahrten anzeigen
- Dim s_Temp As String
- Select Case st__Element(J).TYP
- Case 3 'normale Fahrt
- s = cVerzBilder & "blau_15.gif"
- s1 = cVerzBilder & "rot_15.gif"
- Case Else
- s = cVerzBilder & "orange_15.gif"
- s1 = cVerzBilder & "rot_15.gif"
- End Select
- Dim M As Long
- For M = 1 To 2
- If M = 1 Then
- 'Zeichenposition Einstieg festlegen
- pos1x = st__Element(J).Pos1Px - 7
- Pos1y = st__Element(J).Pos1Py - 7
- Pos2x = st__Element(J).Pos1Px - 7 + 15 ' -7 = Bild in der Mitte +15 = Breite Bild
- Pos2y = st__Element(J).Pos1Py - 7 + 15
- s_Temp = s 'Bild Einstieg
- st__Element(J).von_Region = Region_aus_Punkten(pos1x, Pos1y, Pos2x, Pos2y) 'Region Einstieg
- Else
- 'Zeichenposition Zielort festlegen
- pos1x = st__Element(J).Pos2Px - 7
- Pos1y = st__Element(J).Pos2Py - 7
- Pos2x = st__Element(J).Pos2Px - 7 + 15 ' -7 = Bild in der Mitte +15 = Breite Bild
- Pos2y = st__Element(J).Pos2Py - 7 + 15
- s_Temp = s1 'Bild Ausstieg
- st__Element(J).nach_Region = Region_aus_Punkten(pos1x, Pos1y, Pos2x, Pos2y) 'Region Ausstieg
- End If
- 'Zeichnen und Regionen für Startort
- pic_Karte.PaintPicture LoadPicture(s_Temp), pos1x, Pos1y, 15, 15
- Next
-
- 'Zeichnen und Regionen für Fahrt
- Dim P(5) As POINTAPI
- st__Element(J).zw_Region = Region_für_Fahrt_erstellen(P(), _
- st__Element(J).Pos1Px, _
- st__Element(J).Pos1Py, _
- st__Element(J).Pos2Px, _
- st__Element(J).Pos2Py)
- L = Region_für_Fahrt_zeichnen(P())
-
- Case 5 'Objekte
- '* noch nicht ausprogrammiert
- Case 6 'Kartenteile anzeigen
- s = cVerzBilder & st__Element(J).Kontext & ".gif"
- pic_Karte.PaintPicture LoadPicture(s), st__Element(J).Pos1Px, st__Element(J).Pos1Py
- Case 7 'Adressen
- '* noch nicht ausprogrammiert
- End Select
- Debug.Print "C:\Zeichenreihenfolge.txt" & "Ebene: " & st__Element(J).TYP & "Typ: " & st__Element(J).TYP
- txt_AppendLine "C:\Zeichenreihenfolge.txt", "Ebene: " & st__Element(J).TYP & "Typ: " & st__Element(J).TYP
- End If
- Next
- Next
- 'Hier wird die Tour erst nach allem anderen gezeichnet
- For i = 0 To UBound(st__Touren)
- s = cVerzBilder & "rot_15.gif"
- pic_Karte.PaintPicture LoadPicture(s), st__Touren(i).Pos1Px - 7, st__Touren(i).Pos1Py - 7, 15, 15
- txt_AppendLine "C:\Touren.txt", "Tour: " & st__Touren(i).Pos1Gx & ": " & st__Touren(i).Pos1Px & ": " & st__Touren(i).Pos1Gy & ": " & st__Touren(i).Pos2Py
- Next
- 'Hier wird die Tour erst nach allem anderen gezeichnet
- For i = 0 To UBound(st__Touren_Vergleich)
- s = cVerzBilder & "blau_15.gif"
- pic_Karte.PaintPicture LoadPicture(s), st__Touren_Vergleich(i).Pos1Px - 7, st__Touren_Vergleich(i).Pos1Py - 7, 15, 15
- 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
- Next
- 'auch Mittelpunkt zeichnen
- If b_Mittelpunkt_anzeigen Then
- s = cVerzBilder & "blau_15.gif"
- 'Position für Region und Positionierung ermitteln
- pos1x = Round(ScaleWidth / 2 - 15, 0)
- Pos1y = Round(ScaleHeight / 2 - 15, 0)
-
- 'Zeichnen und Regionen für Abfahrtsort
- pic_Karte.PaintPicture LoadPicture(s), pos1x, Pos1y, 15, 15
- End If
- End Sub
- Private Function Region_für_Fahrt_zeichnen(P() As POINTAPI) As Long
- 'Einstellung wie eine Fahrt gezeichnet wird
- 'Zeichenvorgang selbst
- Dim nCount As Long, PI As Single, LB As LOGBRUSH
- 'Zuweisen und definieren des Polygone (Rahmen für Darstellung)
- ReDim hPen(2)
- ReDim hBrush(2)
- ReDim hRegion(3) As Long
- On Error Resume Next
- hPenSave = GetCurrentObject(hdc, OBJ_PEN)
- hBrushSave = GetCurrentObject(hdc, OBJ_BRUSH)
- hPen(1) = CreatePen(PS_SOLID, 4, QBColor(1))
- LB.lbColor = QBColor(4)
- LB.lbStyle = BS_SOLID
- LB.lbHatch = HS_SOLID
- hBrush(1) = CreateBrushIndirect(LB)
- pic_Karte.FillColor = vbRed
- pic_Karte.FillStyle = 0
- Polygon pic_Karte.hdc, P(0), 5
- End Function
- Private Function Region_für_Fahrt_erstellen(Rp() As POINTAPI, _
- Pos1Px As Single, _
- Pos1Py As Single, _
- Pos2Px As Single, _
- Pos2Py As Single) As Long
-
- On Error Resume Next
- Rp(0).x = Pos1Px
- Rp(0).y = Pos1Py
- Rp(1).x = Pos1Px
- Rp(1).y = Pos1Py - 4
- Rp(2).x = Pos2Px
- Rp(2).y = Pos2Py - 4
- Rp(3).x = Pos2Px
- Rp(3).y = Pos2Py
- Rp(4).x = Pos1Px
- Rp(4).y = Pos1Py
- Region_für_Fahrt_erstellen = fun_Region_aus_Pointapi_Neu(Rp(), 5)
- End Function
- Private Sub GeoMittelpunkt_aller_Muss_Elemente() '"Geo_Mpkt_Muss_Elemente"
- '* Ermittelt GeoMittelpunkt_aller_Muss_Elemente
- Dim i As Long
- On Error Resume Next
- d__Get_Px1 = 0
- d__Get_Py1 = 0
- d__Get_Px2 = 0
- d__Get_Py2 = 0
- d__M_Gx_Fix_alt = d_M_Gx_Fix
- d__M_Gy_Fix_alt = d_M_Gy_Fix
- 'Mittelpunkt aus Pflichtmittelpunkt
- If d__M_Gx_Fix_alt <> 0 Then
- 'Werte zuweisen
- 'Mittelpunkt setzten
- d__Get_Px1 = d__M_Gx_Fix_alt
- d__Get_Py1 = d__M_Gy_Fix_alt
- d__Get_Px2 = d__M_Gx_Fix_alt
- d__Get_Py2 = d__M_Gy_Fix_alt
- Else
- 'Initialisieren da Wert hier neu gesetzt wird "Geo_Mpkt_Muss_Elemente - 1"
- b_Muss_Felder_Gefunden = False
- 'Aus allen Elementen Grenzwerte finden "Geo_Mpkt_Muss_Elemente - 2"
- For i = 0 To UBound(st__Element) - 1
- 'Von Adresse checken
- If st__Element(i).Muss = True Then
- If Not b_Muss_Felder_Gefunden Then 'Auf alle Fälle mal alte Werte überschreiben
- b_Muss_Felder_Gefunden = True
- d__Get_Px1 = st__Element(i).Pos1Gx
- d__Get_Py1 = st__Element(i).Pos1Gy
- d__Get_Px2 = st__Element(i).Pos1Gx
- d__Get_Py2 = st__Element(i).Pos1Gy
- Else
- If d__Get_Px1 > st__Element(i).Pos1Gx Then
- d__Get_Px1 = st__Element(i).Pos1Gx
- End If
- If d__Get_Px2 < st__Element(i).Pos1Gx Then
- d__Get_Px2 = st__Element(i).Pos1Gx
- End If
- If d__Get_Py1 > st__Element(i).Pos1Gy Then
- d__Get_Py1 = st__Element(i).Pos1Gy
- End If
- If d__Get_Py2 < st__Element(i).Pos1Gy Then
- d__Get_Py2 = st__Element(i).Pos1Gy
- End If
- End If
-
- 'Nach Adresse checken
- If st__Element(i).TYP <> 4 Then 'Bei Sofortfahrt nur Abholort für Mittelpunktberechnung
- If d__Get_Px1 > st__Element(i).Pos2Gx Then
- d__Get_Px1 = st__Element(i).Pos2Gx
- End If
- If d__Get_Px2 < st__Element(i).Pos2Gx Then
- d__Get_Px2 = st__Element(i).Pos2Gx
- End If
- If d__Get_Py1 > st__Element(i).Pos2Gy Then
- d__Get_Py1 = st__Element(i).Pos2Gy
- End If
- If d__Get_Py2 < st__Element(i).Pos2Gy Then
- d__Get_Py2 = st__Element(i).Pos2Gy
- End If
- End If
- End If
- Next
-
- 'Aus allen Tourpunkte Grenzwerte finden "Geo_Mpkt_Muss_Elemente - 2"
- For i = 0 To UBound(st__Touren) - 1
- 'Von Adresse checken
- If st__Touren(i).Muss = True Then
- If Not b_Muss_Felder_Gefunden Then 'Auf alle Fälle mal alte Werte überschreiben
- b_Muss_Felder_Gefunden = True
- d__Get_Px1 = st__Touren(i).Pos1Gx
- d__Get_Py1 = st__Touren(i).Pos1Gy
- d__Get_Px2 = st__Touren(i).Pos1Gx
- d__Get_Py2 = st__Touren(i).Pos1Gy
- Else
- If d__Get_Px1 > st__Touren(i).Pos1Gx Then
- d__Get_Px1 = st__Touren(i).Pos1Gx
- End If
- If d__Get_Px2 < st__Touren(i).Pos1Gx Then
- d__Get_Px2 = st__Touren(i).Pos1Gx
- End If
- If d__Get_Py1 > st__Touren(i).Pos1Gy Then
- d__Get_Py1 = st__Touren(i).Pos1Gy
- End If
- If d__Get_Py2 < st__Touren(i).Pos1Gy Then
- d__Get_Py2 = st__Touren(i).Pos1Gy
- End If
- End If
-
- 'Nach Adresse checken
- If st__Touren(i).TYP <> 4 Then 'Bei Sofortfahrt nur Abholort für Mittelpunktberechnung
- If d__Get_Px1 > st__Touren(i).Pos2Gx Then
- d__Get_Px1 = st__Touren(i).Pos2Gx
- End If
- If d__Get_Px2 < st__Touren(i).Pos2Gx Then
- d__Get_Px2 = st__Touren(i).Pos2Gx
- End If
- If d__Get_Py1 > st__Touren(i).Pos2Gy Then
- d__Get_Py1 = st__Touren(i).Pos2Gy
- End If
- If d__Get_Py2 < st__Touren(i).Pos2Gy Then
- d__Get_Py2 = st__Touren(i).Pos2Gy
- End If
- End If
- End If
- Next
-
- 'Aus allen Tourpunkte_Vergleich Grenzwerte finden "Geo_Mpkt_Muss_Elemente - 2"
- For i = 0 To UBound(st__Touren_Vergleich) - 1
- 'Von Adresse checken
- If st__Touren_Vergleich(i).Muss = True Then
- If Not b_Muss_Felder_Gefunden Then 'Auf alle Fälle mal alte Werte überschreiben
- b_Muss_Felder_Gefunden = True
- d__Get_Px1 = st__Touren_Vergleich(i).Pos1Gx
- d__Get_Py1 = st__Touren_Vergleich(i).Pos1Gy
- d__Get_Px2 = st__Touren_Vergleich(i).Pos1Gx
- d__Get_Py2 = st__Touren_Vergleich(i).Pos1Gy
- Else
- If d__Get_Px1 > st__Touren_Vergleich(i).Pos1Gx Then
- d__Get_Px1 = st__Touren_Vergleich(i).Pos1Gx
- End If
- If d__Get_Px2 < st__Touren_Vergleich(i).Pos1Gx Then
- d__Get_Px2 = st__Touren_Vergleich(i).Pos1Gx
- End If
- If d__Get_Py1 > st__Touren_Vergleich(i).Pos1Gy Then
- d__Get_Py1 = st__Touren_Vergleich(i).Pos1Gy
- End If
- If d__Get_Py2 < st__Touren_Vergleich(i).Pos1Gy Then
- d__Get_Py2 = st__Touren_Vergleich(i).Pos1Gy
- End If
- End If
-
- 'Nach Adresse checken
- If st__Touren_Vergleich(i).TYP <> 4 Then 'Bei Sofortfahrt nur Abholort für Mittelpunktberechnung
- If d__Get_Px1 > st__Touren_Vergleich(i).Pos2Gx Then
- d__Get_Px1 = st__Touren_Vergleich(i).Pos2Gx
- End If
- If d__Get_Px2 < st__Touren_Vergleich(i).Pos2Gx Then
- d__Get_Px2 = st__Touren_Vergleich(i).Pos2Gx
- End If
- If d__Get_Py1 > st__Touren_Vergleich(i).Pos2Gy Then
- d__Get_Py1 = st__Touren_Vergleich(i).Pos2Gy
- End If
- If d__Get_Py2 < st__Touren_Vergleich(i).Pos2Gy Then
- d__Get_Py2 = st__Touren_Vergleich(i).Pos2Gy
- End If
- End If
- End If
- Next
-
-
- End If
- 'GeoMittelpunkt des Darstellungsbereich errechnen "Geo_Mpkt_Muss_Elemente - 3"
- Mp_Gx = (d__Get_Px1 + d__Get_Px2) / 2
- Mp_Gy = (d__Get_Py1 + d__Get_Py2) / 2
- Layerstufe_holen 'Layerstufe berechnen
- GoTo OK
- Abbr:
- MsgBox "Fehler beim Ermitteln Layerstufe für Gis Control"
- Exit Sub
- OK:
- 'l_LYID = st_GisStufen(0).id
- 'd_Zoom = st_GisStufen(0).Faktor
- End Sub
- Public Sub Layerstufe_verändern(Plus As Boolean)
- 'Setzt Layerstufe nach oben bzw. nach unten
- On Error Resume Next
- Dim i As Integer
- Dim k As Long
- 'Anzahl Layers ermitteln
- If UBound(st_GisStufen) = 0 Then
- k = 0
- Else
- k = UBound(st_GisStufen)
- End If
- 'Je nach Auf oder Abwärts nächste Layerstufe auswählen
- If Plus Then
- For i = 0 To k 'nächst höhere Stufe finden
- If st_GisStufen(i).Id > Val(Me.l_LYID) Then 'Muss Layer
- l_LYID = st_GisStufen(i).Id
- d__Zoom = st_GisStufen(i).Faktor
- Exit Sub
- End If
- Next
- Else
- For i = k To 0 Step -1 'nächste niedriegere Layerstufe finden
- If st_GisStufen(i).Id < Val(Me.l_LYID) Then 'Muss Layer
- l_LYID = st_GisStufen(i).Id
- d__Zoom = st_GisStufen(i).Faktor
- Exit Sub
- End If
- Next
- End If
- End Sub
- Private Sub Layerstufe_holen()
- On Error Resume Next
- Dim i As Integer
- 'Layerstufe errechnen "Geo_Mpkt_Muss_Elemente - 4"
- 'Auch so ein Ding das man auslagern könnte
- Dim k As Long
- If UBound(st_GisStufen) = 0 Then
- k = 0
- Else
- k = UBound(st_GisStufen)
- End If
- Dim b_Layer_gefunden As Boolean
-
- 'l_LYID = 0 'LayerStufe wieder zurücksetzen - derzeit Pflichtlayer noch nicht möglich
- For i = 0 To k
- If st_GisStufen(i).Id = Val(Me.l_LYID) Then 'Muss Layer
- l_LYID = st_GisStufen(i).Id
- d__Zoom = st_GisStufen(i).Faktor
- b_Layer_gefunden = True
- Exit For
- End If
- Next
- If Not b_Layer_gefunden Then
- If Not b_Hoechste_Ebene Then 'Sofortfahrt auf Höchster Ebene anzeigen
- For i = 0 To k
- 'Layer Optimal
- If (d__Get_Px2 - d__Get_Px1) / st_GisStufen(i).Faktor <= DarstB_Width Then
- If (d__Get_Py2 - d__Get_Py1) / st_GisStufen(i).Faktor <= DarstB_Height Then
- l_LYID = st_GisStufen(i).Id
- d_Zoom = st_GisStufen(i).Faktor
- GoTo OK
- End If
- End If
- Next
- End If
- 'Kein Layer gefunden - höchste Stufe
- If l_LYID = 0 Then
- l_LYID = st_GisStufen(1).Id
- d_Zoom = st_GisStufen(1).Faktor
- End If
- End If
- OK:
- End Sub
- Private Function fun_SQL_Where_Transportart() As String '"Sql_Where_TA"
- '*Liefert Sql_Where für SQL_Wagen_Kann damit Transportart der
- '*Sofortfahrt berücksichtigt wird
- '*Wäre auch gut eine Eigenschaft
- Dim l_ArrayNr As Long
- Dim SQL As String
- On Error Resume Next
- l_ArrayNr = -1 'initalisieren --> Array Nummer kann auch 0 (1.Element) sein
- 'Vorraussetzungen prüfen "Sql_Where_TA - 1"
- If bol_Transportart = False Or _
- txt_Wid_kann = vbNullString Then
- Exit Function
- End If
- 'Array Nr für Fahrt holen "Sql_Where_TA - 2"
- If UBound(st__Element) > 0 Then
- Dim i As Long
- For i = 0 To UBound(st__Element) - 1 'Array durcharbeiten
- If st__Element(i).TYP = 4 Then 'Rückholer fahrt - Konstanten erzeugen
- l_ArrayNr = i
- Exit For
- End If
- Next
- End If
- 'Wenn Fahrt gefunden - Transportart festlegen,
- 'und SQL bilden :: eigentlich auch noch vermischt "Sql_Where_TA - 3"
- '-- aber ich denke schon beim Einlesen der Rückholerfahrt sollte man alle notwendigen
- '-- Informationen gleich in Felder schreiben, ist zwar dann nicht so allgemein aber effiz.
- If l_ArrayNr >= 0 Then 'nur wenn auch gefundn
- 'Derzeit nur Geher - Roller - Umsetzer berücksichtigt
- 'nicht Anzahl Personen und auch nicht Transportart Begleitpersonen
- Dim b_Pkw As Boolean
- Dim s_Transportart As String
- b_Pkw = st__Element(l_ArrayNr).Pkw
- s_Transportart = st__Element(l_ArrayNr).Transportart
- 'Zuordnung der Art:
- If UCase(s_Transportart) = "G" Then 'Geher
- If b_Pkw Then 'nur Pkw
- SQL = SQL & " AND roller = 0 "
- Else
- 'sonstiger Geher muss nicht extra behandelt werden, jeder Wagen passt
- 'nur der strukturhalber eingefügt
- End If
- Else 'Roller Fahrt
- If Not b_Pkw Then 'nur Pkw - Umsetzer
- SQL = SQL & " AND roller > 0 "
- Else
- 'Umsetzer muss nicht extra behandelt werden, jeder Wagen passt
- 'ich geh mal davon aus, dass bei einem Umsetzer der PKW eher eine Möglichkeit darstellt
- 'als eine Verpflichtung
- End If
- End If
- fun_SQL_Where_Transportart = SQL
- End If
- End Function
- Function Elemente_Checken(bMuss As Boolean) As Long '"Element_chk"
- 'Hat sich ein Kann oder Muss (auf Wunsch) Abfragewert geändert
- 'so wird der entsprechende Typ neu in die Elementenliste aufgenommen
- Dim ctr As Control
- On Error GoTo Weiter
- Dim sMuss As String
- If bMuss Then 'Zuweisen Muss Wert
- sMuss = C__Muss
- Else
- sMuss = C__Kann
- End If
- For Each ctr In Controls
- 'Alle Muss Objekte checken
- Debug.Print txt_FID_kann
- Debug.Print ctr.Name & "; " & Len(ctr.Tag); "; " & MID(ctr.Tag, 1, 1) & ";"
- If Len(ctr.Tag) = 3 And MID(ctr.Tag, 1, 1) = sMuss Then
- Debug.Print ctr.Name
- Debug.Print Controls(ctr.Name & "_alt").Text
- If ctr.Name <> Controls(ctr.Name).Text Then
- Debug.Print ctr.Text
- Controls(ctr.Name & "_alt").Text = ctr.Text
- Elemente_Checken = 1
- Debug.Print ctr.Name & "; " & Len(ctr.Tag); "; " & MID(ctr.Tag, 1, 1) & ";"
- Elemente_Typ_Reload_neu MID(ctr.Tag, 2, 1), _
- bMuss, _
- MID(ctr.Tag, 3, 1)
- Debug.Print ctr.Name & " " & MID(ctr.Tag, 3, 1)
- End If
- Debug.Print Len(ctr.Tag) & MID(ctr.Tag, 1, 1)
- End If
- Weiter:
- Next
- 'Hier noch extra checken ob ein Muss_Wid vorhanden,
- 'dann immer aktualisieren
- End Function
- Private Sub Darstellung_aus_Geomittelpunkt() '"Darstbereich_Geo"
- On Error Resume Next
- 'Geo Darstellungsbereich des Sichtfensters
- d__Get_Px1 = Mp_Gx - (DarstB_Width / 2 + l_Bild_x) * d__Zoom
- d__Get_Py1 = Mp_Gy - (DarstB_Height / 2 + l_Bild_y) * d__Zoom
- d__Get_Px2 = Mp_Gx + (DarstB_Width / 2) * d__Zoom
- d__Get_Py2 = Mp_Gy + (DarstB_Height / 2) * d__Zoom
- End Sub
- Public Sub Paint()
- 'Diese Prozedur kümmert sich um alle Aufgaben vom Checken der Veränderungen bis zum
- 'Neuzeichnen "sub_Paint"
- Dim i As Long
- On Error GoTo Abbr
- l__Paint_Status = 0
- GISLOG "Prozedur Paint() beim Aufruf"
- 'Solange Status <= 4 "sub_Paint - 01"
- Do While l__Paint_Status <= 6
- Select Case l__Paint_Status 'Status verarbeiten: "sub_Paint - 02"
- Case 0
- 'Checken ob sich Muss_Auswahl verändert haben "sub_Paint - Zustand: 0"
- frm_GisView.txt_Info = frm_GisView.txt_Info & " Zustand 0! "
- GISLOG "Funktion Elemente_check_Muss () beim Aufruf "
- 'Select Case mit Fehlerbehandlung < 0
- If Elemente_Checken(True) > 0 Then
- 'Elemente haben sich verändert "sub_Paint - Zustand: 0 - 1"
- l__Paint_Status = 1 'Darstellungsbereich hat sich geändert
- Else
- 'Elemente haben sich nicht verändert "sub_Paint - Zustand: 0 - 2"
- l__Paint_Status = 4 'Darstellungsbereich hat sich NICHT geändert
- End If
- Debug.Print UBound(st__Element)
- GISLOG "Funktion Elemente_check_Muss () beim Verlassen "
- Case 1
- 'Ermittelt GeoMittelpunkt aller Muss Elemente "sub_Paint - Zustand: 1"
- GISLOG "GeoMittelpunkt aller Muss Elemente () beim Aufruf "
- GeoMittelpunkt_aller_Muss_Elemente 'Holt Layer und GeoMittelpunkt
- l__Paint_Status = 2 'Weiter
- GISLOG "GeoMittelpunkt aller Muss Elemente () beim Verlassen "
- Case 2
- 'Geokoordinaten für Sichtfensterbereich berechnen "sub_Paint - Zustand: 2"
- GISLOG "Darstellung_aus_GeoMittelPunkt () beim Aufruf "
- Darstellung_aus_Geomittelpunkt
- If b_Muss_Felder_Gefunden = True Or d__M_Gx_Fix_alt <> 0 Then
- 'Mussfelder wurden gefunden "sub_Paint - Zustand: 2 - 1"
- l__Paint_Status = 3 'alles normal weiter da Muss Felder vorhanden
- Else
- 'Keine Mussfelder vorhanden "sub_Paint - Zustand: 2 - 1"
- l__Paint_Status = 5 'Zeichenroutine leert pic_Karte da keine Muss Felder
- End If
- GISLOG "Darstellung_aus_GeoMittelPunkt () beim Verlassen "
- Case 3
- 'Kartenteile neu einlesen "sub_Paint - Zustand: 3"
- GISLOG "Kartenteile neu einlesen () beim Aufruf "
- 'b_Muss muss hier fast true sein, sonst würde er bei 2 schon auf 5 springen
- If b_Muss_Felder_Gefunden Or d__M_Gx_Fix_alt <> 0 Then
- 'Kartenteile_neu_einlesen
- 'Mussfelder wurden gefunden "sub_Paint - Zustand: 2 - 1"
- Elemente_Typ_Reload_neu 6, False, 0
- End If
- l__Paint_Status = 4
- GISLOG "Kartenteile neu einlesen () beim Verlassen "
- Case 4
- 'Kann Elemente checken und aufbauen "sub_Paint - Zustand: 4"
- If b_Muss_Felder_Gefunden Or d__M_Gx_Fix_alt > 0 Then
- i = Elemente_Checken(False)
- End If
- l__Paint_Status = 5
- Case 5
- 'Regionen für Elemente erstellen "sub_Paint - Zustand: 5"
- Pixelkoordinaten_für_Elemente
- l__Paint_Status = 6
- Case 6
- 'Zeichnen der Elemente "sub_Paint - Zustand: 6"
- Zeichnen_von_Elementen
- l__Paint_Status = 7
- End Select
- Loop
- GISLOG "Prozedur Paint() beim Verlassen"
- Exit Sub
- Abbr:
- MsgBox "Fehler in Gis Darstellung -> Paint() "
- End Sub
|