PC Direkt 1998 #11/PCDIREKT_1198.bin/SHOWDATA/ECKESHOP.DXR/00152_print3.ls

Text File | 1998-03-20 | 5.4 KB | 170 lines

on totalfield R, txtcast, wt
  global printer
  printer(msetpensize, wt, wt)
  printer(mstrokedroundrect, the left of R, the top of R, the right of R, the bottom of R, (the bottom of R - the top of R) / 2)
  printer(msettextfont, the textFont of char 1 of member txtcast)
  printer(msettextsize, the textSize of char 1 of member txtcast)
  printer(msettextstyle, the textStyle of char 1 of member txtcast)
  printer(msettextjust, "right")
  printer(mdrawtext, the text of field txtcast, the left of R - 6, the bottom of R - 5)
  printer(msettextjust, "left")
end

on myTotalField R, txtcast, wt
  global printer
  printer(msetpensize, wt, wt)
  printer(mstrokedroundrect, the left of R, the top of R, the right of R, the bottom of R, (the bottom of R - the top of R) / 2)
  printer(msettextfont, the textFont of char 1 of member txtcast)
  printer(msettextsize, the textSize of char 1 of member txtcast)
  printer(msettextstyle, the textStyle of char 1 of member txtcast)
  printer(msettextjust, "left")
  printer(mdrawtext, the text of field txtcast, the left of R + 25, the bottom of R - 5)
  printer(msettextjust, "right")
end

on appendtitletext txt
  global printer, gpropfont
  printer(msettextfont, gpropfont)
  printer(msettextstyle, "normal,bold")
  printer(msettextsize, 14)
  printer(mappendtext, txt & RETURN)
  printer(msettextstyle, "normal")
  printer(msettextsize, 10)
  printer(mappendtext, the text of cast "macversion" & RETURN)
  printer(mappendtext, the text of cast "winversion" & RETURN)
end

on appendsectiontext txt
  global printer, gpropfont
  printer(msettextfont, gpropfont)
  printer(msettextstyle, "normal,bold")
  printer(msettextsize, 12)
  printer(mappendtext, RETURN & line 1 of txt & RETURN, 1)
  printer(msettextstyle, "normal")
  printer(msettextsize, 10)
  printer(mappendtext, line 2 to the number of lines in txt of txt, 1)
end

on appendmethodlisttext txt
  global printer, gmonofont
  printer(msettextfont, gmonofont)
  printer(msettextstyle, "normal")
  printer(msettextsize, 9)
  printer(mappendtext, txt, 1)
end

on appendmethodtext txt
  global printer, gpropfont
  printer(msettextfont, gpropfont)
  printer(msettextstyle, "normal,bold")
  printer(msettextsize, 10)
  printer(mappendtext, word 1 of txt & " ", 1)
  printer(msettextstyle, "normal")
  printer(mappendtext, word 2 to the number of words in txt of txt & RETURN & RETURN, 1)
end

on appendnotetext txt
  global printer, gpropfont
  printer(msettextfont, gpropfont)
  printer(msettextstyle, "normal,italic")
  printer(msettextsize, 10)
  printer(mappendtext, txt, 1)
end

on appendtext txt
  global printer, gpropfont
  printer(msetgray, 100)
  printer(msettextfont, gpropfont)
  printer(msettextstyle, "normal")
  printer(msettextsize, 10)
  printer(mappendtext, txt, 1)
end

on printstyledtext castlist
  if not listp(castlist) then
    exit
  end if
  if the machineType = 256 then
    set xobjfile to "pmatic.dll"
  else
    set xobjfile to "pmatic.xobj"
  end if
  openXLib(xobjfile)
  set printer to PrintOMatic(mnew)
  if not objectp(printer) then
    alert("There is no currently selected printer. Printing features are disabled.")
  else
    printer(msetmargins, 72, 72, 72, 72)
    set w to printer(mgetpagewidth)
    set h to printer(mgetpageheight)
    printer(mnewpage)
    printer(mtextbox, 0, 0, w, h, 0)
    repeat with cnt = 1 to count(castlist)
      appendstyledtext(printer, getAt(castlist, cnt), 1)
    end repeat
    if printer(mdojobsetup) = 1 then
      updateStage()
      printer(mprint)
    end if
    printer(mdispose)
  end if
  closeXLib(xobjfile)
end

on appendstyledtext obj, thecast, autoappend
  if not objectp(obj) then
    exit
  end if
  if not integerp(thecast) and not stringp(thecast) then
    exit
  end if
  if the type of member thecast <> #field then
    exit
  end if
  if not (the number of chars in field thecast) then
    exit
  end if
  if not integerp(autoappend) then
    set autoappend to 0
  end if
  set stylelist to buildstylelist(thecast)
  repeat with cnt = 1 to count(stylelist)
    set stylerun to getAt(stylelist, cnt)
    obj(msettextfont, getaProp(stylerun, #font))
    obj(msettextsize, getaProp(stylerun, #size))
    obj(msettextstyle, getaProp(stylerun, #style))
    set charsadded to obj(mappendtext, char getaProp(stylerun, #start) to getaProp(stylerun, #end) of field thecast, autoappend)
    if charsadded = 0 then
      exit
    end if
  end repeat
end

on buildstylelist thecast
  if the castType of cast thecast <> #text then
    return []
  end if
  if not (the number of chars in field thecast) then
    return []
  end if
  set stylelist to []
  set curfont to EMPTY
  set cursize to 0
  set curstyle to EMPTY
  repeat with cnt = 1 to the number of chars in field thecast
    if (the textFont of char cnt of member thecast <> curfont) or (the textSize of char cnt of member thecast <> cursize) or (the textStyle of char cnt of member thecast <> curstyle) then
      if count(stylelist) then
        setaProp(getAt(stylelist, count(stylelist)), #end, cnt - 1)
      end if
      set curfont to the textFont of char cnt of member thecast
      set cursize to the textSize of char cnt of member thecast
      set curstyle to the textStyle of char cnt of member thecast
      add(stylelist, [#font: curfont, #size: cursize, #style: curstyle, #start: cnt, #end: cnt])
    end if
  end repeat
  if count(stylelist) then
    setaProp(getAt(stylelist, count(stylelist)), #end, the number of chars in field thecast)
  end if
  return stylelist
end