Attribute VB_Name = "Module1"
Public factory As CacheObject.factory
Public connstr, opbuanz, idhand, belart1, mindex, mcolumn, spfile
Public inst(50) As Object
Public seite, seitcnt, zoomtype, zoomfakt
Public twainerg, dirty
Public pcode, pname, anmeld_erg, abmeld_cnt
Public scroll_x, scroll_y
Public vorschau_fakt

Public Const BUTTVOR = 1
Public Const BUTTZUR = 2
Public Const BUTTTURN = 3
Public Const BUTTTXT = 4
Public Const BUTTZOOMIN = 5
Public Const BUTTZOOMOUT = 6
Public Const BUTTLOE = 7
Public Const BUTTZOOMB = 8
Public Const BUTTZOOMH = 9
Public Const BUTTDRU = 10
Public Const BUTTEND = 11
Public Const BUTTSCANPAR = 13


Declare Sub Sleep Lib "Kernel32" (ByVal time As Long)

Sub dokstart(ByVal nIndex As Long, ByVal nColumn As Long)
If nIndex = -1 Then Exit Sub
If archiv.list.ListColumnPicture(nIndex, 4) = 0 Then Exit Sub


Dim dok As Object
Dim txt As Variant



id = Piece(archiv.list.ListCargo(nIndex), "|", 1)
If id = "" Then Exit Sub
ext = Piece(archiv.list.ListCargo(nIndex), "|", 2)
If ext = 0 Then ext = ""
If ext = "1" Then ext = "pdf"
If ext = "2" Then ext = "tif"
If ext = "" Then
   MsgBox "Kein Bilddokument vorhanden", vbInformation, "Archiv"
   Exit Sub
End If

archiv.MousePointer = 11
Set dok = factory.OpenId("AR.Dokumente", id)
file = Environ("temp") + "\dokument." + ext
dok.dok.FileWrite (file)

If ext = "tif" Then
   cmd = "kodakprv.exe " + file
   Shell cmd, vbMaximizedFocus
ElseIf ext = "pdf" Then
    cmd = Environ("comspec") + " /C " + file
    Shell cmd, vbMinimizedNoFocus
End If


dok.sys_Close
Set dok = Nothing
Sleep (5000)
archiv.MousePointer = 1
DoEvents

End Sub


Sub dokbearb(ByVal nIndex As Long, ByVal nColumn As Long)
If nIndex = -1 Then Exit Sub
If archiv.list.ListColumnPicture(nIndex, 4) = 0 Then Exit Sub
id = Piece(archiv.list.ListCargo(nIndex), "|", 1)
If id = "" Then Exit Sub

Load bild
dokload id
bild.Show 1
Unload bild

End Sub

Sub suche()
Dim rs As CacheObject.ResultSet

pbelart = ""
For i = 0 To archiv.Belart.ListCount - 1
  If archiv.Belart.ListColumnCheck(i, 1) Then pbelart = pbelart + archiv.Belart.ListText(i) + ","
Next
If pbelart <> "" Then pbelart = Mid(pbelart, 1, Len(pbelart) - 1)

If IsNull(archiv.Datvon.DateValue) Then
     pdatvon = ""
   Else
     pdatvon = archiv.Datvon.DateValue
End If
If IsNull(archiv.Datbis.DateValue) Then
     pdatbis = ""
   Else
     pdatbis = archiv.Datbis.DateValue
End If
PFirma = archiv.Firma.ListCargo(archiv.Firma.ListIndex)

archiv.list.ClearList
DoEvents
Set rs = factory.ResultSet("AR.Dokumente", "Suche")
Call rs.Execute(PFirma, pbelart, archiv.Belnr.Text, pdatvon, pdatbis, archiv.Par1.Text, archiv.Par2.Text, archiv.Par3.Text)
N = 0
While rs.Next()
   archiv.list.AddItem rs.GetData(2) + " " + rs.GetData(3) + "  ;" + Format(rs.GetData(4)) + ";" + rs.GetData(5)
   archiv.list.ListCargo(N) = Format(rs.GetData(1)) + "|" + Format(rs.GetData(6))
   If rs.GetData(6) > 0 Then archiv.list.ListColumnPicture(N, 4) = rs.GetData(6)
   'DoEvents
   N = N + 1
Wend
rs.Close

End Sub

Sub dokload(ByVal id As Integer)
   Dim dok As CacheObject.ObjInstance
   
   idhand = id
   bild.Par1.Visible = True
   bild.Par2.Visible = True
   bild.Par3.Visible = True
   bild.Beldat.Visible = True
   Set dok = factory.OpenId("AR.Dokumente", id)
   bild.Belnr = dok.Belnr
   belart1 = dok.Belart
   For i = 1 To 30
     If Piece(bild.Belart.Caption, ";", i) = belart1 Then
        bild.Belart = i
     End If
   Next
     
   bild.Par1.Text = dok.Par1
   bild.Par2.Text = dok.Par2
   bild.Par3.Text = dok.Par3
   bild.Beldat.Text = dok.Datum
   typ = "tif"
   file = Environ("temp") + "\dok." + typ
   On Error Resume Next
   Kill file
   On Error GoTo 0

   bild.Image1.BitmapList = 0
   erg = dok.dok.Read(1)
   seitcnt = 0
   If erg <> "" Then
      Call dok.dok.Rewind
      Call dok.dok.FileWrite(file)
      bild.Image1.Load file, 1, 1, -1
      seitcnt = bild.Image1.BitmapListCount
      bild.Image1.BitonalScaling = BITONALSCALING_SCALETOGRAY
   End If
   Call dok.sys_Close
   seite = 0
   If seitcnt > 0 Then
        bild.FRBeleg.Visible = False
        bild.FRDokument.Visible = True
        seite = 1
        bild.labseit.Caption = "Seite " + Format(seite) + " von " + Format(seitcnt)
        setvis
        zoomimg zoomtype
   End If
End Sub

Sub setvis()

With bild

    If .Belnr.Text <> "" And .Beldat.DateValue > 0 And belart1 <> "" Then
        .BUSpeich.Enabled = True
       Else
        .BUSpeich.Enabled = False
    End If


    .Image1.Visible = (.Image1.BitmapListCount > 0)
    .labseit.Visible = (.Image1.BitmapListCount > 1)

    .Tool1.BtEnabled(BUTVOR) = (.Image1.BitmapListCount > 1)
    .Tool1.BtEnabled(BUTZUR) = (.Image1.BitmapListCount > 1)
    .Tool1.BtEnabled(BUTTTURN) = (.Image1.BitmapListCount > 0)
    .Tool1.BtEnabled(BUTTZOOMIN) = (.Image1.BitmapListCount > 0)
    .Tool1.BtEnabled(BUTTZOOMOUT) = (.Image1.BitmapListCount > 0)
    .Tool1.BtEnabled(BUTTZOOMB) = (.Image1.BitmapListCount > 0)
    .Tool1.BtEnabled(BUTTZOOMH) = (.Image1.BitmapListCount > 0)
    .Tool1.BtEnabled(BUTTLOE) = (.Image1.BitmapListCount > 0)
    .Tool1.BtEnabled(BUTTDRU) = (.Image1.BitmapListCount > 0)
    .Tool1.BtEnabled(BUTTEND) = True
    .Tool1.BtEnabled(BUTTSCANPAR) = True
End With

End Sub

Sub zoomimg(ByVal zoomtype As String)
If seitcnt = 0 Then Exit Sub

bild.Image1.AutoRepaint = False
If zoomtype = "B" Then
    bild.Image1.AutoScroll = True
    bild.Image1.DstWidth = bild.Image1.ScaleWidth * zoomfakt  'Use the full control width.
    bild.Image1.DstClipWidth = bild.Image1.ScaleWidth * zoomfakt
    CalcHeight = bild.Image1.BitmapHeight * bild.Image1.ScaleWidth * zoomfakt / bild.Image1.BitmapWidth
    bild.Image1.DstHeight = CalcHeight 'Use the proportional height.
    bild.Image1.DstClipHeight = CalcHeight
ElseIf zoomtype = "H" Then
    bild.Image1.AutoScroll = True
    bild.Image1.DstHeight = bild.Image1.ScaleHeight * zoomfakt  'Use the full control width.
    bild.Image1.DstClipHeight = bild.Image1.ScaleHeight * zoomfakt
    CalcWidth = bild.Image1.BitmapWidth * bild.Image1.ScaleHeight / bild.Image1.BitmapHeight * zoomfakt
    bild.Image1.DstWidth = CalcWidth 'Use the proportional width
    bild.Image1.DstClipWidth = CalcWidth
End If
bild.Image1.AutoRepaint = True
bild.Image1.ForceRepaint
End Sub
Function Piece(ByVal S As String, ByVal tr As String, ByVal N As Integer) As String
    n1 = 1
    R = ""
    For i = 1 To Len(S)
        C = Mid$(S, i, 1)
        If C = tr Then
           n1 = n1 + 1
           If n1 = N + 1 Then Exit For
          Else
           If N = n1 Then R = R & C
        End If
    Next
    Piece = R
End Function

Function fileexists(ByVal file As String) As Boolean

On Error GoTo err1:
Open file For Input As #1
Close #1
fileexists = True
Exit Function
err1:

fileexists = False

End Function

Function anmelden() As Boolean
anmeld_erg = ""
anmeld.Show 1
anmelden = False
If anmeld_erg <> "" Then
    pcode = Piece(anmeld_erg, "|", 1)
    pname = Piece(anmeld_erg, "|", 2)
    abmeld_cnt = 300
    anmelden = True
End If
Unload anmeld
End Function

