Modul Rastri - Zgodovina strani

AleÅ¡ Trtnik: /* Rutine za izvoz */

2007-10-02T15:20:31Z

‎Rutine za izvoz

AleÅ¡ Trtnik ob 15:18, 2. oktober 2007

2007-10-02T15:18:21Z

AleÅ¡ Trtnik: /* Uvoz rastrov Tif/Tfw - Jpg/Jgw */

2007-10-02T15:11:02Z

‎Uvoz rastrov Tif/Tfw - Jpg/Jgw

AleÅ¡ Trtnik ob 14:48, 2. oktober 2007

2007-10-02T14:48:34Z

AleÅ¡ Trtnik: /* UvozRastrovGurs */

2007-10-02T14:46:23Z

‎UvozRastrovGurs

AleÅ¡ Trtnik: New page: == Opis == Modul Rastri vsebuje vse potrebne rutine za uvoze, pretvorbe in izvoze rasterskih predlog. == Rutine == ==== SetGursRootPath ==== Nastavi izhodiščni direktorij za GURS sken...

2007-10-02T14:45:32Z

New page: == Opis == Modul Rastri vsebuje vse potrebne rutine za uvoze, pretvorbe in izvoze rasterskih predlog. == Rutine == ==== SetGursRootPath ==== Nastavi izhodiščni direktorij za GURS sken...

Nova stran

== Opis ==

Modul Rastri vsebuje vse potrebne rutine za uvoze, pretvorbe in izvoze rasterskih predlog.

== Rutine ==

==== SetGursRootPath ====
Nastavi izhodiščni direktorij za GURS skenograme

== Rutine za uvoz ==
==== UvozRastrovGurs ====
uvozi skenograme, ki so imenovani po GURS nomenklaturi

==== UvozRastrovTifTfw ====
Sub UvozRastrovTifTfw (Ekstenzija As String)
Uvozi TIF/TFW oyiroma JPG/JGW skenograme.

Primer klica za TIF/TFW uvoz.
UvozRastrovTifTfw ('tfw')

Primer klica za JPG/JGW uvoz.
UvozRastrovTifTfw ('jgw')

Rutina:
Sub UvozRastrovTifTfw (Ekstenzija As String)
Dim L As TLayer, D As TDataSet, Fld As TField, RL As TEditRecord
Dim B As Boolean, S As String
Dim SL, FL As TStringList
Dim I, IW, IH As Long
Dim PYDim, PXDim, PXOrg, PYOrg, X1, X2, Y1, Y2 As Float

L = Layers.SelectObject ( 'Izberi plast, v katero naj se uvozijo rastri' )
If L = Nil Then Exit EndIf
If L.DataSetCount = 0 Then Exit EndIf
D = L.DataSets ( 0 )
If D.FieldCount = 0 Then Exit EndIf
Fld = D.Fields ( 0 )

If InputYesNo ('Pozor', 'Ali želiš izbrisati že uvožene rastre?', B) Then
If B Then
L.DeleteAllData (False)
EndIf
Else
Exit
EndIf
S = GursRootPath
If InputFolder ('Izberi direktorij, od koder naj se začne iskanje rastrov', S) Then
SL = CreateStringList
SL.FindFiles (S, '*.' + Ekstenzija, True)
FL = CreateStringList
L.BeginMultipleUpdate
For I = 0 To SL.Count - 1
Hint ( 'Uvažam datoteko (' + IntToStr (I + 1) + '/' + IntToStr (SL.Count) + '): ' + SL.Strings (I))
FL.Load (SL.Strings (I))
S = ChangeFileExt (SL.Strings (I), '.tif')
If Not FileExists(S) Then S = ChangeFileExt (SL.Strings (I), '.jpg') EndIf
If ImageInfo ( S , IW , IH ) Then
PYDim = StrToFloat (FL.Strings (0))
PXDim = StrToFloat (FL.Strings (3))
PYOrg = StrToFloat (FL.Strings (4))
PXOrg = StrToFloat (FL.Strings (5))
Y1 = PYOrg - PYDim / 2 + PYDim * IW
Y2 = PYOrg - PYDim / 2
X1 = PXOrg - PXDim / 2 + PXDim * IH
X2 = PXOrg - PXDim / 2
RL = L.EditRecord
RL.Append
RL.SetMap (Y1, X1, Y2, X2)
RL.AutoCentroid
RL.FldAsString (Fld) = ExtractRelativePath (GursRootPath, S)
RL.Update
EndIf
Next
L.EndMultipleUpdate
L.Optimize
Hint ( '' )
FL.Destroy
SL.Destroy
Beep
Redraw
EndIf
EndSub

==== UvozRastrovGeoTiff ====
Sub UvozRastrovGeoTiff
Uvozi Tif datoteke, ki imajo v TIFF tagu shranjeno informacijo o lokaciji.

Rutina:
Sub UvozRastrovGeoTiff
Dim L As TLayer, D As TDataSet, Fld As TField, RL As TEditRecord
Dim B As Boolean, S As String
Dim SL As TStringList, Bi AS TBitmap
Dim I As Long, Y1, X1, Y2, X2 As Float
L = Layers.SelectObject ( 'Izberi plast, v katero naj se uvozijo rastri' )
If L = Nil Then Exit EndIf
If L.DataSetCount = 0 Then Exit EndIf
D = L.DataSets ( 0 )
If D.FieldCount = 0 Then Exit EndIf
Fld = D.Fields ( 0 )
If InputYesNo ('Pozor', 'Ali želiš izbrisati že uvožene rastre?', B) Then
If B Then
L.DeleteAllData (False)
EndIf
Else
Exit
EndIf
S = GursRootPath
If InputFolder ('Izberi direktorij, od koder naj se začne iskanje rastrov', S) Then
SL = CreateStringList
SL.FindFiles (S, '*.tif', True)
L.BeginMultipleUpdate
For I = 0 To SL.Count - 1
Hint ( 'Uvažam datoteko (' + IntToStr (I + 1) + '/' + IntToStr (SL.Count) + '): ' + SL.Strings (I))
Bi = CreateBitmap
Bi.Load (SL.Strings (I))
If Bi.GetGeoInfo (Y1, X1, Y2, X2) Then
RL = L.EditRecord
RL.Append
RL.SetMap (Y1, X1, Y2, X2)
RL.AutoCentroid
RL.FldAsString (Fld) = ExtractRelativePath (GursRootPath, SL.Strings (I))
RL.Update
EndIf
Destroy (Bi)
Next
L.EndMultipleUpdate
L.Optimize
Hint ( '' )
Destroy (SL)
Beep
Redraw
EndIf
EndSub

== Rutine za izvoz ==
==== OknoVTifTfw ====
Sub OknoVTifTfw (DL As TDrawList, PixDim AS Float)
Naredi Tif in TFW datoteko za okno. Program najprej vpraša za okno, ki se izvozi, potem pa še za datoteko, v katero zapiše slike. Potem program nariše tematiko v to Tif datoteko in naredi še Tfw datoteko, ki vsebuje podatke o lokaciji okna za uvoze v druge programe.

''DL'' je tematika, ki se izriše v datoteko.

''PixDim'' je velikost točke na sliki v metrih.

Primer za izris trenutne tematike z velikostjo točke 0.5 metra:
OknoVTifTfw (Drawlist, 0.5)

Primer za izris poljubne tematike z velikostjo točke 10 metrov:
OknoVTifTfw ([Tematika], 10)

Rutina:
// Naredi Tif in TFW datoteko za okno
Sub OknoVTifTfw (DL As TDrawList, PixDim AS Float)
Dim Y1, X1, Y2, X2 As Float, S, S1 As String, SL As TStringList
If InputWindow ('Vnesi območje za izvoz okna', Y1, X1, Y2, X2) Then
If InputFile ('Določi datoteko za izvoz slike', S) Then
S1 = ChangeFileExt (ExtractFileName (S), '')
Grid = False
Coor = False
Border = False
DL.SaveImage (ChangeFileExt (S, '.tif'), Y1, X1, Y2, X2, PixDim)
SL = CreateStringList
SL.Add (FloatToStr (PixDim))
SL.Add ('0.0')
SL.Add ('0.0')
SL.Add (FloatToStr (-PixDim))
SL.Add (FloatToStr (MinValue (Y1, Y2) + pixdim/2))
SL.Add (FloatToStr (MaxValue (X1, X2) - pixdim/2))
SL.Save (ChangeFileExt (S, '.tfw'))
Destroy (SL)
EndIf
EndIf
EndSub

==== OknoVJpgJgw ====
Sub OknoVJpgJgw (DL As TDrawList, PixDim AS Float)
Naredi JPG in JGW datoteko za okno. Program najprej vpraša za okno, ki se izvozi, potem pa še za datoteko, v katero zapiše slike. Potem program nariše tematiko v to Jpg datoteko in naredi še Jgw datoteko, ki vsebuje podatke o lokaciji okna za uvoze v druge programe.

''DL'' je tematika, ki se izriše v datoteko.

''PixDim'' je velikost točke na sliki v metrih.

Primer za izris trenutne tematike z velikostjo točke 0.5 metra:
OknoVJpgJgw (Drawlist, 0.5)

Primer za izris poljubne tematike z velikostjo točke 10 metrov:
OknoVJpgJgw ([Tematika], 10)

Rutina:
// Naredi JPG in JGW datoteko za okno
Sub OknoVJpgJgw (DL As TDrawList, PixDim AS Float)
Dim Y1, X1, Y2, X2 As Float, S, S1 As String, SL As TStringList
If InputWindow ('Vnesi območje za izvoz okna', Y1, X1, Y2, X2) Then
If InputFile ('Določi datoteko za izvoz slike', S) Then
S1 = ChangeFileExt (ExtractFileName (S), '')
Grid = False
Coor = False
Border = False
DL.SaveImage (ChangeFileExt (S, '.jpg'), Y1, X1, Y2, X2, PixDim)
SL = CreateStringList
SL.Add (FloatToStr (PixDim))
SL.Add ('0.0')
SL.Add ('0.0')
SL.Add (FloatToStr (-PixDim))
SL.Add (FloatToStr (MinValue (Y1, Y2) + pixdim/2))
SL.Add (FloatToStr (MaxValue (X1, X2) - pixdim/2))
SL.Save (ChangeFileExt (S, '.jgw'))
Destroy (SL)
EndIf
EndIf
EndSub

@@ Vrstica 299: / Vrstica 299: @@
       EndIf
     EndIf
   EndSub

@@ Vrstica 3: / Vrstica 3: @@
 Modul Rastri vsebuje vse potrebne rutine za uvoze, pretvorbe in izvoze rasterskih predlog.
-== Rutine ==
+== Rutine za skenograme GURS ==
 ==== SetGursRootPath ====
 Nastavi izhodiščni direktorij za GURS skenograme
 ==== Uvoz rastrov GURS ====
 uvozi skenograme, ki so imenovani po GURS nomenklaturi
 ==== Uvoz rastrov Tif/Tfw - Jpg/Jgw ====
   Sub UvozRastrovTifTfw (Ekstenzija As String)
@@ Vrstica 131: / Vrstica 224: @@
   EndSub
 == Rutine za izvoz ==
 ==== OknoVTifTfw ====

@@ Vrstica 29: / Vrstica 29: @@
     Dim I, IW, IH As Long
     Dim PYDim, PXDim, PXOrg, PYOrg, X1, X2, Y1, Y2 As Float
     L = Layers.SelectObject ( 'Izberi plast, v katero naj se uvozijo rastri' )
     If L = Nil Then Exit EndIf
@@ Vrstica 36: / Vrstica 35: @@
     If D.FieldCount = 0 Then Exit EndIf
     Fld = D.Fields ( 0 )
     If InputYesNo ('Pozor', 'Ali želiš izbrisati že uvožene rastre?', B) Then
       If B Then

@@ Vrstica 12: / Vrstica 12: @@
 uvozi skenograme, ki so imenovani po GURS nomenklaturi
-==== UvozRastrovTifTfw ====
+==== Uvoz rastrov Tif/Tfw - Jpg/Jgw ====
   Sub UvozRastrovTifTfw (Ekstenzija As String)
 Uvozi TIF/TFW oyiroma JPG/JGW skenograme.
@@ Vrstica 82: / Vrstica 82: @@
   EndSub
-==== UvozRastrovGeoTiff ====
+==== Uvoz rastrov GeoTiff ====
   Sub UvozRastrovGeoTiff
 Uvozi Tif datoteke, ki imajo v TIFF tagu shranjeno informacijo o lokaciji.

@@ Vrstica 9: / Vrstica 9: @@
 == Rutine za uvoz ==
-==== UvozRastrovGurs ====
+==== Uvoz rastrov GURS ====
 uvozi skenograme, ki so imenovani po GURS nomenklaturi