[Kode program dalam tulisan ini dapat didownload disini ]

Pertama, tentu saja setelah menambahkan component mapobjects2, kita bentuk contoh tampilan nya seperti berikut:

Yang kotak putih besar tentu saja adalah object map. Berturut turut command button disebelah kiri dibuat dengan name default, command1, command2 ..dst. Ada 2 command button yang agak menjorok yaitu simpan perubahan dan batalkan perubahan. Dibuat begini karena kedua button tergantung atau berhubungan dengan command edit.

Selanjutnya masuk ke kode. Kita akan memerlukan beberapa variabel global brikut:
 

Private mode As String

Private dc As DataConnection

Private ge_polygon As GeoEvent

Private ge_points() As GeoEvent

Private sudah_edit As Boolean

Private nomor_vertex As Long

Private rs_edit As Recordset

Private pol_edit As Polygon

Variabel mode digunakan untuk menandai mode aktif yang sedang berlangsung, apakah sedang menambah data, mengubah, atau menghapus. Variabel dc untuk data connection, biasanya dipakai cukup sering, jadi ditaruh di private variabel. ge_polygon dan ge_point digunakan untuk bentuk interaksi saat proses editing peta. ge_polygon untuk membentuk polgonnya sedang ge_points yang berupa array untuk membentuk titik-titik vertex dari ge_polygon. Variabel sudah_edit untuk tanda bahwa proses edit sudah siap dimulai yaitu dengan sudah dipilihnya satu polygon yang siap diedit dengan nomor object yang dipilih ini dimasukkan dalam variabel nomor_vertex. Rs_edit dan pol_edit adalah recordset dari data peta yang akan diedit dan bentuk shape hasil perubahan.

Kemudian dilanjutkan dengan menambah kode saat command button ditekan. Dari yang paling sederhana dulu, yaitu command1, Command2, dan command5 yang hanya mengganti mode yang aktif. Mode ini diperlukan karena seluruh operasi ada pada event MouseDown dari object map, jadi harus ada pembedanya (seperti juga zoom in, zoom out, pan di tulisan terdahulu ).

Private Sub Command1_Click()

  mode = "tambah"

End Sub

Private Sub Command2_Click()

  mode = "edit"

End Sub

Private Sub Command5_Click()

    mode = "hapus"

End Sub

Kemudian pada Form_Load kita inisialisasi Map. Diconnectkan ke data peta contoh. Diberi warna default (mogreen), dan ditampilkan di  obeject Map. Selain itu di form_load juga diinisialisasi symbol-symbol  trackinglayer yang diperlukan. Yaitu untuk symbol polygon yang sedang diedit (warna cyan, border merah), dan vertex-vertex penyusunnya (hitam bulat), juga warna vertex ketika diedit (bentuk cross).

Disini Command3 dan Command4 karena aktif saat edit maka di enable false dulu. Berikut kode program untuk form_load.

Private Sub Form_Load()

    inisialisasi peta

    Set dc = New MapObjects2.DataConnection

    dc.Database = App.Path & "\peta"

    dc.Connect

    Dim l As New MapLayer

     l.GeoDataset = dc.FindGeoDataset("petaku")

    l.Symbol.Color = moGreen

    Map1.Layers.Add l

    Map1.TrackingLayer.SymbolCount = 4

    With Map1.TrackingLayer.Symbol(1)

        .SymbolType = moFillSymbol

        .Color = moCyan

        .OutlineColor = moRed

    End With

    With Map1.TrackingLayer.Symbol(2)

        .SymbolType = moPointSymbol

        .Color = moBlack

        .Style = moCircleMarker

        .Size = 10

    End With

    With Map1.TrackingLayer.Symbol(3)

        .SymbolType = moPointSymbol

        .Color = moBlack

        .Style = moCrossMarker

        .Size = 10

    End With

Command3.Enabled = False

Command4.Enabled = False

End Sub

Selanjutnya bisa dibuat kode untuk tambah data peta.  dituliskan pada event Map mouseDown. Disini object maplayer yang ada di object map diambil. Kemudian user ’dipaksa’ untuk membuat polygon dengan method trackpolygon yang disimpan kedalam variabel sementara p bertipe polygon. Bentuk ini kemudian dimasukkan dalam fields ”shape” yaitu field yang menyimpan bentuk spasial dari data shapefile. Untuk field-field yang lain juga dimasukkan nilainya disini. Disini dicontohkan dimasukkan nilai field id dari suatu inputbox. Diakhiri dengan Map refresh agar tampilan peta menjadi tampilan dengan data terbaru. Berikut kodenya

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Dim l As New MapLayer

    Dim pt As MapObjects2.Point

    Set l = Map1.Layers(0)

    If mode = "tambah" Then

         Dim p As Polygon

         Set p = New Polygon

         Set p = Map1.TrackPolygon

         Dim r  As New MapObjects2.Recordset

         Set r = l.Records

         r.AddNew

         r.Fields("id").Value = InputBox("nilai field id=")

         r.Fields("shape").Value = p

         r.Update

         Map1.Refresh

Kode diatas memang belum selesai untuk MouseDown karena masih ada mode untuk edit dan hapus. Kita masuk ke hapus dulu karena lebih simple. Disini tinggal dilakukan perintah delete pada object recordset yang terpilih. Yang dipilih adalah polygon yang dimana mouse yang kita tekan berada didalamnya. Dilakukan dengan perintah searchshape dengan parameter operasinya adalah moPointInPolygon

    ElseIf mode = "hapus" Then

        Set pt = Map1.ToMapPoint(X, Y)

        Set rs_edit = l.SearchShape(pt, moPointInPolygon, "")

        rs_edit.Delete

        Map1.Refresh

Selanjutnya yang paling rumit adalah proses untuk mengedit posisi. Proses mengedit ini bisa dibagi dalam 4 bagian yaitu:

-         Proses untuk menentukan polygon mana yang akan di-edit dan persiapan-persiapan penyimpanan data yang diperlukan untuk proses edit selanjutnya

-         Setelah terpilih polygon yang akan diedit, maka selanjutnya akan memilih vertex (titik sudut) mana yang akan dipindah

-         Setelah terpilih vertex akan diedit maka bagaimana proses saat menggeser vertex ini

-         Setelah vertex-vertex dipindah ke tempat yg diinginkan, maka selanjutnya adalah proses menyimpan perubahan atau membatalkannya.

Untuk menentukan polygon mana yang akan diedit, juga dengan menggunakan perintah searchshape. Setelah polygon terpilih, polygonnya dimasukkan kedalam obejct geoevent ge_polygon, dan titik-titik vertexnya ke ge_points. Agar terlihat proses editingnya, maka dibuat bentuk polygon berwarna cyan  bergaris tepi merah(symbol nomor 1) dan vertextnya bulat hitam (symbol nomor 2). Juga perlu mengubah flag sudah_edit  yang menandakan sudah ada polygon terpilih yang siap diedit. Kemudian tombol simpan perubahan dan batal perubahan di enable-kan , dan tombol-tombol lain di disable.

ElseIf mode = "edit" Then

      If sudah_edit = False Then

           Dim rs As MapObjects2.Recordset

           ReDim ge_points(0)

           Map1.TrackingLayer.ClearEvents

           Set pt = Map1.ToMapPoint(X, Y)

           Dim py As New Polygon

           Set rs_edit = l.SearchShape(pt, moPointInPolygon, "")

           Set py = rs_edit.Fields("shape").Value

           Set ge_polygon = Map1.TrackingLayer.AddEvent(py, 1)

           Dim vertexs As MapObjects2.Points

           Set vertexs = py.Parts(0)

           For i = 0 To vertexs.Count - 1

             ReDim Preserve ge_points(UBound(ge_points) + 1)

             Set ge_points(UBound(ge_points)) = Map1.TrackingLayer.AddEvent(vertexs(i), 2)

           Next

           sudah_edit = True

            Command3.Enabled = True

            Command4.Enabled = True

            Command1.Enabled = False

            Command2.Enabled = False

            Command5.Enabled = False

Setelah polyogon yang mau diedit terpilih dan diwarnai beda, proses dengan mouse selanjutnya adalah melakukan drag vertex yang ingin di pindah. Prosesnya dengan klik kemudian dengan tetap ditekan, mouse dipindah , dan vertex yang diedit akan mengikuti cursor mouse. Untuk dapat seperti ini, saat mouse ditekan akan dipilih vertex yang paling dekat, di tandai nomor vertexnya, dan di tampilkan dalam bentuk yang berbeda (tanda cross). Cara untuk mencari vertex terdekat adalah dengan rumus pytagoras.

Else

            Set pt = Map1.ToMapPoint(X, Y)

            Dim titikpalingdekat As Long

            Dim jarak As Double

            Dim jarakterdekat As Double

            jarakterdekat = Sqr((pt.X - ge_points(1).X) ^ 2 + (pt.Y - ge_points(1).Y) ^ 2)

            titikpalingdekat = 1

            For i = 2 To UBound(ge_points)

                jarak = Sqr((pt.X - ge_points(i).X) ^ 2 + (pt.Y - ge_points(i).Y) ^ 2)

                If jarakterdekat > jarak Then

                    titikpalingdekat = i

                    jarakterdekat = jarak

                End If

            Next

            nomor_vertex = titikpalingdekat

            For i = 1 To UBound(ge_points)

                 ge_points(i).SymbolIndex = 2

            Next

            ge_points(nomor_vertex).SymbolIndex = 3

            Map1.TrackingLayer.Refresh True

       End If

    End If

End Sub

Proses pengeditan juga harus dilengkapi dengan proses yang ditaruh di MouseMove. Disini setelah vertex aktif terpilih, setiap gerakan mouse akan diikuti oleh vertex tersebut. Agar terlihat, maka perlu dilakukan pengulangan penggambaran polygon dan vertex2nya di object  trackinglayer.  Disini perlu dibuat kembali polygon ge_polygon dengan titik-titik vertex yang baru. Jika sudah selesai maka nomorVertex aktif dihilangkan dengan diisi 0 di event MouseUp.

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If nomor_vertex > 0 Then

    Set pt = Map1.ToMapPoint(X, Y)

        ge_points(nomor_vertex).MoveTo pt.X, pt.Y

        Map1.TrackingLayer.RemoveEvent ge_polygon.Index

        Set pol_edit = New MapObjects2.Polygon

        Dim newvertexs As New MapObjects2.Points

        For i = 1 To UBound(ge_points)

             pt.X = ge_points(i).X

             pt.Y = ge_points(i).Y

            newvertexs.Add pt

        Next

        pol_edit.Parts.Add newvertexs

       Set ge_polygon = Map1.TrackingLayer.AddEvent(pol_edit, 1)

        Map1.TrackingLayer.Refresh True

 End If

End Sub

Private Sub Map1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    nomor_vertex = 0

End Sub

Setelah perubahan selesai, perlu dilakukan penyimpanan karena yang berubah baru polygon yang ada di ge_polygon. Polygon ini sudah kita simpan di pol_edit, sehingga tinggal dimasukkan di  field shape. Setelah tersimpan, jejak editing dihilangkan dengan clearEvent pada tracking layer dan state enable tombol2 dikembalikan. Untuk pembatalan, mirip dengan penyimpanan perubahan, tapi tanpa simpan ke recordset.

Private Sub Command3_Click()

    rs_edit.Edit

    rs_edit.Fields("shape").Value = pol_edit

    rs_edit.Update

    sudah_edit = False

    nomor_vertex = 0

    Map1.TrackingLayer.ClearEvents

    Map1.Refresh

    Command3.Enabled = False

    Command4.Enabled = False

    Command1.Enabled = True

    Command2.Enabled = True

    Command5.Enabled = True

End Sub

Private Sub Command4_Click()

    sudah_edit = False

    nomor_vertex = 0

    Map1.TrackingLayer.ClearEvents

    Map1.Refresh

    Command3.Enabled = False

    Command4.Enabled = False

    Command1.Enabled = True

    Command2.Enabled = True

    Command5.Enabled = True

End Sub

Berikut tampilan saat tambah data.

 dan berikut tampilan saat edit data.

Comments

Search

Kok ngak di kirimi sample Adhi (125.160.50.xxx) 2009-03-13 05:48:17 Pa Danil saya kan ada minta sample mapObjek lewat email, kok ngak ada di lampiran, apa bapak lupa?

Anonymous (122.139.62.xxx) 2009-05-27 01:43:49 cheap wow power leveling cheapest wow power leveling my wow gold buy wow gold replica replica rolex CHEAP wow power level BUY power leveling replica rolex replica CHEAPEST power leveling MY wow power level cheap rs gold good BUY wow gold replica rolex CHEAPEST wow gold cheap lotro gold buy wow gold my wow gold cheapest wow gold CHEAP wow gold zmc

Anonymous (122.139.62.xxx) 2009-05-27 01:44:16 cheap wow power leveling cheapest wow power leveling my wow gold buy wow gold replica replica rolex CHEAP wow power level BUY power leveling replica rolex replica CHEAPEST power leveling MY wow power level cheap rs gold good BUY wow gold replica rolex CHEAPEST wow gold cheap lotro gold buy wow gold my wow gold cheapest wow gold CHEAP wow gold zmc

ddd zhang (222.212.45.xxx) 2009-09-01 11:48:00 The oldestnokia 8800 maternal auntNokia 8800 Sirocco calm face,Watches curled the Cheap Watchescigarette according Cartier Watchesto mother's Replica watchesappearance to cheap watcheslight, has notReplica Omega Watches spoken again,IWC Watches under the Replica Breitlingpillar the franck muller watchesbody helped Chanel Watchesthe mother replica watchesto rub Gucci Replicathe corn, Cartier Watchthe younger replica watchessister has ceramic replica watchesbeen huggedswiss replica watches by elder replica burberry watchesbrother to data processing serviceoutside goes. data processingactually, thesedata process words oldest Ceramic tilematernal auntMicro sd cards was not Wholesale jewelryunnecessary to Wholesale clothingsay to ugg bootsus that wholesale ugg bootsshe wasugg boots adopts anotheruggs way to High pressure blowercomfort theCommercial blower mother. thesewholesale iron, inchina wholesale we remembered wholesale electronicsthat the mp4 watchesfragment does Wholesale Mp4not need

ddd zhang (222.212.45.xxx) 2009-09-01 11:50:20 not needwholesale beads to use wholesale digital camerathe language wholesale camcordersperformance, lifemp3 watch beset by mp5 playerdisasters already wholesale pda mobile phonesmother's heartpda mobile phones smoothing by Michelle Obama's Shoesgrinding, her luxurious cell phonesdestiny has wholesale brand cell phonesbeen connected wholesale furniturewith theFurniture Wholesale misery. the pink chioldest maternal pink chi flat ironaunt has Peach Red CHI Hair Straightenernot said Black CHI Hair Straightenerdaddy's matter Blue CHI Hair Straighteneragain, also did not dare saying that because mother's frail heart was also again unable to withstand

fff zhang (222.212.45.xxx) 2009-09-01 11:51:14 The yearsTiffany Bracelet have smudged Tiffany Earringsbitterly and Tiffany ringsastringently for Tiffany jewellersthe good Tiffany jewelrypeople, also Tiffany jewellerygave the Tiffany silverpeople whoghd loved really GHD Darkto increase ghd straightenersthe move, ghd hair straightenersthe true, ghd hair stylerthe good Cheap GHDand the GHD purebeautiful are GHD kissthe life GHD MK4 Blacksincere song GHD MK4 Pinkof praise,GHD MK4 Gold but this GHD Purplesong of don ed hardypraise's source, ed hardy shoeswas my mother. ed hardy apparelShe who ed hardy menstruggles ined hardy women's the miseryed hardy bag sings the ed hardy tshirtsong attentively, ugg bootsis song uggsof thewholesale ugg boots life, is ugg sheepskin bootsthe agreement,china wholesale but not wholesale digital camerasshed optimistic mp4 watchesspirit. very Wholesale Mp4long period wholesale t shirtsof time,Wholesale handbags we rely wholesale clothingon theWholesale jewelry mother towholesale live, looks Wholesale Jew...

FFF zhang (222.212.45.xxx) 2009-09-01 11:51:50 looks Wholesale Jewelrylike in Wholesale fashion jewelrythe riverWholesale costume jewelry the fish chileaves the chi flat ironboiling water chi hair productsnot to chi ironsbe dissimilar.buy a chi iron In thecheap chi iron morning, the chi ceramic ironsday has not put brightly

ggg zhang (222.212.45.xxx) 2009-09-01 11:52:16 Should sayghd that mother's hair straightenerschildhood does ghd uknot have ghd straightenersthe story, ghd hair styleris grows ghd hair straightenersup in ed hardygrandmother's bosom. ed hardy clothingShe justed hardy caps was born ed hardy discountsfor several ed hardy onlinemonths, in theed hardy tshirts resist-Japan ed hardy womenfederation works Cheap GHDas battalion GHD purecommander's grandfatherGHD kiss night assault GHD MK4 Blackdevil foothold, GHD MK4 Pinkthe chest has GHD MK4 Goldhit devil's GHD Purplegun, poured Tiffany Necklacesin the Tiffany Ringautumn rain,Tiffany Bangle Lian Ju the Discount Tiffanywords have Tiffany 1837not stayed Tiffany Atlasbehind. GrandmotherTiffany Watch leads twoTiffany Paloma Picasso children toTiffany Brooch hide hereTiffany Cuff Links and there Tiffany Key Ringlives, sates ray banthe appetite ray ban sunglassesdoes notray ban sunglasses online eat, hasray ban aviatorstepped tired ray ban wayfarerearly thechristian louboutin body, when christ...

GGG zhang (222.212.45.xxx) 2009-09-01 11:52:52 when christian louboutin shoesmarries the christian louboutin heelsoldest maternal christian louboutin blackaunt, for christian louboutinsbecame engaged cheap christian louboutin shoesless than 16 year-old mother, let go to ask the grandfather to go.

Women Buy Ugg Boots (220.161.165.xxx) 2010-02-27 02:44:41 With all the boots [url=http://www.zhjugg.com/new-product-ugg-bailey-  button-58 03-grey-boots-p-]UGG Bailey Button Grey[/url] included in Ugg Australia’s Classic Collection range the Bailey chenwei Button is lined ugg cardy oatmeal with twin faced Grade A sheepskin. Also there is the UGG Bailey Button traditional suede heel guard to ensure that not only is this area protected but offers this part of the boot support. Ugg Cardy Boots Plus within the boots you find each pair has sock liners that are made from sheepskin PU foam so increasing the level of Ugg Cardy comfort a person feels when wearing them.

MBT Shoes mbt uk (220.161.165.xxx) 2010-02-27 05:20:47 When you purchase Mbt shoes you achieve shoes that appeal mbt shoes to your sense of style while insuring a shoe that does not cause pain and discomfort after a day mbt trainers shoes of being on your feet. And after your purchase you know you have shoes that are going to outlast shoes found in most stores. Created for comfort and long lasting, MBT shoes utilize the highest quality leather and materials. If you  experience mbt uk discomfort from your foot perspiring during the day MBT Shoes applies a sock lining in the lining of the shoe where you foot rests. mbt shoe This allows your feet to stay dry during the most challenging active days.hlm

激安 ユニフォ& 激安 ユ| (220.161.165.xxx) 2010-02-27 06:44:59 LCZ  読売巨人軍は 、ビ ;ジターゲ&# 12540;ムで着用& #12377; 427;夏季限定のӎ 0;| 69;マービジタ ーユニホ ;ーム&# 12301;を 採用しま 2377;。ユニフォーム...このユニ ホӦ 0; ムの 発表会見&# 12364;１２日（&# 26376;A 289;、東京・大৔ 3;ஹ 0;の球団事務 所で開か れ、&# 12481;ームを代表  375;て 坂本勇人選手&# ...

Paul Smith (220.161.165.xxx) 2010-02-27 06:55:12 Our store offer the cheap paul smith for you,sale new Paul Smith Shoes,and we will give my best server to you.Come on, more order will get more discount.You can not miss them!rlh

nike-shox (125.78.242.xxx) 2010-02-27 12:43:05 rr Today, the nike shox basketball shoes are popular around the world. wholesale nike shox shoes started out as an American company, but have since expanded around the globe. They're now available in 120 countries. shox r4 with an emphasis on walking shoes, the engineers at New Balance know the importance of a proper fit and offer a wide range of widths and sizes. Often recommended by podiatrists, nike running shoes take an "endorsed by no one" stance, preferring to let their technology and comfort sell their shoes instead of paying a celebrity athlete to do it for them. Additionally, nike shox monster are available in a variety of styles, each designed for different needs-motion control, extra support, off road, use etc. New Balance makes running, walking, tennis, cross-training and basketball shoes for men and women, and also offers a line of kids' ...

timberland timberland (220.161.165.xxx) 2010-02-27 13:02:51 mm Apparently, 21,000 boots imported by Timberland from Thailand have lead paint on the insole, violating federal lead paint rules. I'm guessing this paint was used for printing of the logo inside the boot. Please note Dear Readers, these are Timberland waterproof and children are particularly sensitive to the effects of lead and lead poisoning. Avoid a lead paint accident that could injure or hurt your child. When I first saw this I thought, "How do you make Timberland work boots? Where's the risk of accident or injury?" Then I read further and saw, "lead paint." The headline reads:"Timberland Recalls Timberland for kids Due to Violation of Lead Paint Standard"The U.S. Consumer Product Safety Commission announced a voluntary recall of these boots. Consumers should stop using recalled products immediately.

nike (220.161.165.xxx) 2010-02-27 13:04:48 mm Apparently, 21,000 boots imported by Timberland from Thailand have lead paint on the insole, violating federal lead paint rules. I'm guessing this paint was used for printing of the logo inside the boot. Please note Dear Readers, these are Timberland waterproof and children are particularly sensitive to the effects of lead and lead poisoning. Avoid a lead paint accident that could injure or hurt your child. When I first saw this I thought, "How do you make Timberland work boots? Where's the risk of accident or injury?" Then I read further and saw, "lead paint." The headline reads:"Timberland Recalls Timberland for kids Due to Violation of Lead Paint Standard"The U.S. Consumer Product Safety Commission announced a voluntary recall of these boots. Consumers should stop using recalled products immediately.

mbt walking shoes (59.58.157.xxx) 2010-02-27 15:59:58 ZSM MBT: The idea of mbt shoe Physiological Footwear MBT, Masai Barefoot mbt walking shoes Technology, was invented by Swiss engineer Karl Müller mbt shoes sale . During a visit to Korea he made the startling mbt sale discovery that walking barefoot mbt masai shoes over paddy fields alleviated his back pain mtb shoes . Back in Switzerland, Müller began to develop a footwear technology that would make the natural instability mbt footwear of soft ground such as Korean paddy fields discount mbt shoes or the East African savannah accessible also to those, mbts shoes who have to walk on hard surfaces. In 1996, after years spent mbt lami shoes on research and development, Masai Barefoot Technology was mature enough to be

coach-handbag-c (59.58.157.xxx) 2010-02-27 16:04:02 ZSM handbags snap closure, and silver-tone buckle embellishments. coach handbag outlet Double rolled straps and silver-tone hardware coach bag feet on the bottom of the bag coach leather handbag provide added durability. This chic tote is perfect for coach signature handbag everyday use and adds subtle

cheap jerseys (59.58.157.xxx) 2010-02-27 16:16:23 ZSM With the survival cheap jerseys of people longer in the community, you will find  that memories authentic jerseys are the most valuable when to turn around. If  there are no cheap jerseys memories with a companion, then how we will to spend our old age, lonely nfl jersey life? I have all of the most unforgettable memories are treasures on this NFL nfl  football jerseys jersey, which is made from 100% nylon diamond back mesh body and Nylon dazzle sleeves and yoke. These football jerseys factors played a very important role in keeping the time.

paul smith london (59.58.157.xxx) 2010-02-27 16:26:31 ZSM I've been looking forward to Silent Hunter 5 paul smith london for a while now as regular readers will know I am a bit of a submarine paul smith london  fan. Playing number 2 and 3 to death, for those wondering Silent Hunter 4 was set in paul smith sale the Pacific and in my opinion nothing could be more boring :-) Silent Number 5 when it paul smith sale was first announced was looking fantastic. However a few months ago paul smith shop it was announced there would only be one submarine, a Type VII. Now I don't paul smith shop know about you, but I started my career as a U-Boat captain in a Type II paul smith

Only registered users can write comments!

Powered by !JoomlaComment 3.26

3.26 Copyright (C) 2008 Compojoom.com / Copyright (C) 2007 Alain Georgette / Copyright (C) 2006 Frantisek Hliva. All rights reserved."