ReadLookup

Ukázka přečtení existujícího číselníku

Popis

Skript přečte a zobrazí obsah existujícího číselníku (název, popis, sloupce a hodnoty v řádcích)
declare function LookupCreate dll "ScriptEx" (string): integer
declare procedure LookupFree dll "ScriptEx" (var integer)

declare function LookupGetIntegerProp dll "ScriptEx" (integer, string): integer
declare function LookupGetStringProp dll "ScriptEx" (integer, string): string

declare procedure LookupSetIntegerProp dll "ScriptEx" (integer, string, integer)

declare procedure LookupLoad dll "ScriptEx" (integer)
declare procedure LookupLoadSubItemDefsByLookupId dll "ScriptEx" (integer, integer)
declare procedure LookupLoadItemsByLookupId dll "ScriptEx" (integer, integer)
declare procedure LookupLoadSubItemsByItemId dll "ScriptEx" (integer, integer)

declare function LookupGetListItem dll "ScriptEx" (integer, integer): integer

declare procedure GetEnter dll "ActualDocument" (string)

script ReadLookup(): boolean
var
  CRLF: string
  SEPARATOR: string
  LookupId: integer
  Lookup: integer
  S: string
  DefList: integer
  DefId: integer
  Def: integer
  I, J, K: integer
  ItemList: integer
  ItemId: integer
  Item: integer
  SubItemList: integer
  SubItem: integer
begin
  GetEnter(CRLF)

  SEPARATOR := " | "

  // ---------------------------------------------------------------------------

  LookupId := 21
  Lookup := LookupCreate("TLookup")
  LookupSetIntegerProp(Lookup, "Id", LookupId)
  LookupLoad(Lookup)

  S := "Název: " + LookupGetStringProp(Lookup, "Name") + CRLF
  S += "Popis: " + LookupGetStringProp(Lookup, "Description") + CRLF
  S += CRLF

  LookupFree(Lookup)

  // ---------------------------------------------------------------------------

  DefList := LookupCreate("TLookupSubItemDefList")
  LookupLoadSubItemDefsByLookupId(DefList, LookupId)

  for I := 0 to LookupGetIntegerProp(DefList, "Count") - 1 do
    if I > 0 then
      S += SEPARATOR
    end

    Def := LookupGetListItem(DefList, I)

    S += LookupGetStringProp(Def, "Name")
  end

  S += CRLF
  S += CRLF

  // --

  ItemList := LookupCreate("TLookupItemList")
  LookupLoadItemsByLookupId(ItemList, LookupId)

  SubItemList := LookupCreate("TLookupSubItemList")

  for I := 0 to LookupGetIntegerProp(ItemList, "Count") - 1 do
    Item := LookupGetListItem(ItemList, I)
    ItemId := LookupGetIntegerProp(Item, "Id")

    LookupLoadSubItemsByItemId(SubItemList, ItemId)

    for J := 0 to LookupGetIntegerProp(DefList, "Count") - 1 do
      if J > 0 then
        S += SEPARATOR
      end

      Def := LookupGetListItem(DefList, J)
      DefId := LookupGetIntegerProp(Def, "Id")

      for K := 0 to LookupGetIntegerProp(SubItemList, "Count") - 1 do
        SubItem := LookupGetListItem(SubItemList, K)

        if DefId = LookupGetIntegerProp(SubItem, "DefId") then
          S += LookupGetStringProp(SubItem, "Value")
          break
        end
      end
    end

    S += CRLF
  end

  LookupFree(SubItemList)
  LookupFree(ItemList)
  LookupFree(DefList)

  // ---------------------------------------------------------------------------

  write(S)

  result := true
end