'description: RTS: Filter setzen
'usedby: Always
'KRYPTED: TRUE

dim s, tabellenname, filterstring, chw, feldname as string
dim j, erg, neuetabelle as long
dim filterteil as string
dim rts_tabelle as long
dim dezsqlsep, dezsep, tausendsep as string
dim global1_sp as string

  tabellenname = rts( "ACTIVETABLE")
  rts_tabelle = instr( 1, tabellenname, "RTS\") > 0
  feldname = rts( "ACTIVEFIELD")

  opentable("\RTS\TBL\XWNDFILT", "XWNDFILT1", "TEMPORARY")
  readtable( "XWNDFILT1", "\RTS\TBL\Xwndfilt_" + userid + ".cds")
  gotofirst( "XWNDFILT1")
  if &XWNDFILT1.TABLENAME <> tabellenname then
    do while eof("XWNDFILT1") = 0
      deleterecord( "XWNDFILT1")
    loop
    neuetabelle = 1
  end if
  writetable( "XWNDFILT1", "\RTS\TBL\Xwndfilt_" + userid + ".cds")
  closetable( "XWNDFILT1")

  global1_sp = global1
  do_akt_tbd (tabellenname, 0, "\tbd", 0)
  global1 = global1_sp
end

@form.oncreate:
  if tabellenname = "" then
    valid = 0 
    global1 = ""
    return  
  end if

  if (feldname <> "") and (neuetabelle = 1) then
    &XWNDFILT.FIELDNAME = feldname
    gosub fieldname_onexit
  end if

'Umsetzen Dezimalzahlen auf SQL Syntax (Punkt als Dezimaltrenner)
  if len(global1) = 3 then
    tausendsep = mid$( global1, 1, 1)
    dezsep = mid$( global1, 2, 1)
    dezsqlsep = mid$( global1, 3, 1)
    global1 = ""
  end if

return

@fieldname.onselect:
  s = window( "\rts\wnd\dfielda1")
  if ltrim$(s) <> ""  then 
    &XWNDFILT.CAPTION = mid$( s, 1, instr( 1, s, "+")-1 )
    &XWNDFILT.FIELDNAME = mid$( s, instr( 1, s, "+")+1, 255)
    if ltrim$(&XWNDFILT.CAPTION) = "" then 
      &XWNDFILT.CAPTION = &XWNDFILT.FIELDNAME
    end if   
  end if
return

fieldname_onexit:
@fieldname.onexit:
  if &XWNDFILT.FIELDNAME = "" then
    enable( @ok, 4)
    return
  end if
  if (feldname <> "") and (&XWNDFILT.FIELDNAME = "*") then
    &XWNDFILT.FIELDNAME = feldname
  end if
  &XWNDFILT.FIELDNAME = upper$( &XWNDFILT.FIELDNAME)
  if rts_tabelle = 0 then
    if &XWNDFILT.FIELDNAME <> get_property(&XWNDFILT.FIELDNAME, "FIELD:", tabellenname) then
      erg = messagebox( "Feldname %1 unbekannt", 2, &XWNDFILT.FIELDNAME)
      valid = 0
      return  
    end if
    &XWNDFILT.CAPTION = get_property(&XWNDFILT.FIELDNAME, "CAPTION:", tabellenname)  
  end if
  enable( @lower, 4)
return

@lower.onexit:
  if (&XWNDFILT.UPPER = "") and (instr( 1, &XWNDFILT.LOWER, "%") = 0) and (instr( 1, &XWNDFILT.LOWER, "_") = 0) and (instr( 1, &XWNDFILT.LOWER, "*") = 0) and (instr( 1, &XWNDFILT.LOWER, "?") = 0) then 
    &XWNDFILT.UPPER = &XWNDFILT.LOWER
  end if
return

@upper.onexit:
  if (instr( 1, &XWNDFILT.LOWER, "%") <> 0) or (instr( 1, &XWNDFILT.LOWER, "_") <> 0) or (instr( 1, &XWNDFILT.LOWER, "*") <> 0) or (instr( 1, &XWNDFILT.LOWER, "?") <> 0) then
    erg = messagebox( "Bei Verwendung von Platzhaltern %_*? im Feld 'Von' muss das Feld 'Bis' leer bleiben.", 2)
    &XWNDFILT.UPPER = ""
  end if
return

@xwndfilt.onnewrecord:
  &XWNDFILT.TABLENAME = tabellenname
return

@ok.onpress:
  erstellefilter
  global1 = filterstring
return

@loeschen.onpress:
  global1 = ""
return

sub erstellefilter
dim likefilter as long
'für automatische typkonvertierung hier trenncharakter festlegen
  likefilter = 0
  filterstring = ""
  gotofirst( "XWNDFILT")
  do while eof("XWNDFILT") = 0
    if &XWNDFILT.FIELDNAME <> "" then 
      s = &XWNDFILT.UPPER
      findreplace( s, "'", "''", 0, 1)
      &XWNDFILT.UPPER = s
      s = &XWNDFILT.LOWER
      findreplace( s, "'", "''", 0, 1)
      &XWNDFILT.LOWER = s
      chw = ""
      if &XWNDFILT.UPPER = "" then
        likefilter = 1
'Excel Wildcards auf SQL Wildcards konvertieren
        s = &XWNDFILT.LOWER
        findreplace( s, "*", "%", 0, 1)
        findreplace( s, "?", "_", 0, 1)
        &XWNDFILT.LOWER = s
        chw = chr$(34)
      end if
      if get_property(&XWNDFILT.FIELDNAME, "TYPE:", tabellenname) = "STRING" then
        chw = chr$(34)
        if mid$( &XWNDFILT.UPPER, len(&XWNDFILT.UPPER), 1) = "*" then
          &XWNDFILT.UPPER = mid$( &XWNDFILT.UPPER, 1, len(&XWNDFILT.UPPER)-1) + chr$(255)
        end if 
      end if
'bei RTS Tabellen und LIKE Filter immer string vorbesetzen
      if (rts_tabelle = 1) or (likefilter = 1) then 
        chw = chr$(34)
      end if
'falls Zahlenfeld leer in 0 umwandeln
      if get_property(&XWNDFILT.FIELDNAME, "TYPE:", tabellenname) <> "STRING" then
        if ltrim$(&XWNDFILT.UPPER) = "" then &XWNDFILT.UPPER = "0"
        if ltrim$(&XWNDFILT.LOWER) = "" then &XWNDFILT.LOWER = "0"
      end if
      if (get_property(&XWNDFILT.FIELDNAME, "TYPE:", tabellenname) = "DOUBLE") and (tausendsep <> "") and (aliasname <> "") then
        s = &XWNDFILT.UPPER
        findreplace( s, tausendsep, "", 0, 1)
        findreplace( s, dezsep, dezsqlsep, 0, 0)
        &XWNDFILT.UPPER = s
        s = &XWNDFILT.LOWER
        findreplace( s, tausendsep, "", 0, 1)
        findreplace( s, dezsep, dezsqlsep, 0, 0)
        &XWNDFILT.LOWER = s
      end if
      if likefilter = 0 then 
        filterteil = "(" + &XWNDFILT.FIELDNAME + "<=" + chw + &XWNDFILT.UPPER + chw + " AND " + &XWNDFILT.FIELDNAME + ">=" + chw + &XWNDFILT.LOWER + chw + ")"
      else
        filterteil = "(" + &XWNDFILT.FIELDNAME + " LIKE " + chw + &XWNDFILT.LOWER + chw + ")"
      end if
      if filterstring = "" then
        filterstring = filterteil 
      else 
        filterstring = filterstring + " AND " + filterteil
      end if
    end if
    cancel( "XWNDFILT") 
    skip( "XWNDFILT", 1) 
  loop

  if len( filterstring) >= 64000 then
    erg = messagebox( "Filter zu lang. Es wird nicht gefiltert.", 2)  
    filterstring = ""
  end if
end sub

'$include \rts\bas\tblinc
'$include \rts\bas\execsql
'$include \rts\bas\tbd
'$include \rts\bas\tblscan