Modul Rastri

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

Uvoz rastrov GURS

uvozi skenograme, ki so imenovani po GURS nomenklaturi

Uvoz rastrov Tif/Tfw - Jpg/Jgw

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

Uvoz rastrov GeoTiff

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