'briefkopf.bas                Stand: 21.11.2006   ufb!!!
'letter-head                             Falzkante eingefügt: ok!! alle x,y-Angaben in mm!
' bitte für den eigenen Test Ihre Bilder entsprechend umbenennen im BMP-Format,
' dann werden auch Bilder ausgedruckt
#COMPILE EXE
 $DIM ALL
$INCLUDE "win32api.inc"                                                   'pb=Paperbreite in pkt.
GLOBAL nfile&, Datumheute$, Datum$, xp AS LONG, winxp AS LONG, winver$, cm AS LONG, pb AS LONG

FUNCTION CM2PPI(cXY AS STRING ,nCM AS SINGLE) AS SINGLE
LOCAL x&, y&
XPRINT GET PPI TO x&, y&
SELECT CASE cXY
   CASE "x","X"
        CM2PPI = nCM * x& / 2.54
   CASE "y","Y"
        CM2PPI = nCM * y& / 2.54
   CASE ELSE
        CM2PPI = 0
END SELECT
END FUNCTION


FUNCTION PPI2CM(cXY AS STRING ,nPoints AS SINGLE) AS SINGLE
LOCAL x&, y&
XPRINT GET PPI TO x&, y&
SELECT CASE cXY
   CASE "x","X"
      PPi2CM = nPoints / x& * 2.54
   CASE "y","Y"
      PPi2CM = nPoints / y& * 2.54
   CASE ELSE
      PPi2CM = 0
END SELECT
END FUNCTION

FUNCTION PPI2MM(cXY AS STRING ,nPoints AS SINGLE) AS SINGLE
     PPi2MM = PPI2CM(cXY,nPoints) * 10
END FUNCTION


 FUNCTION OSVersion AS STRING
    LOCAL OS AS OSVERSIONINFO
    LOCAL OSStr AS STRING
    OSStr = "Unknown"
    OS.dwOSVersionInfoSize = SIZEOF(OS)
    IF GetVersionEx(OS) THEN
        SELECT CASE OS.dwPlatformId
            CASE %VER_PLATFORM_WIN32s
                OSStr = "3.1x"
            CASE %VER_PLATFORM_WIN32_WINDOWS
                IF OS.dwMajorVersion = 4 AND OS.dwMinorVersion =  0 THEN OSStr = "Windows 95"
                IF OS.dwMajorVersion = 4 AND OS.dwMinorVersion = 10 THEN OSStr = "WIN98SE"
                IF OS.dwMajorVersion = 4 AND OS.dwMinorVersion = 90 THEN OSStr = "Windows ME"
            CASE %VER_PLATFORM_WIN32_NT
                IF OS.dwMajorVersion = 3 AND OS.dwMinorVersion = 51 THEN OSStr = "Windows NT 3.51"
                IF OS.dwMajorVersion = 4 AND OS.dwMinorVersion =  0 THEN OSStr = "Windows NT 4.0"
                IF OS.dwMajorVersion = 5 AND OS.dwMinorVersion =  0 THEN OSStr = "Windows 2000"
                IF OS.dwMajorVersion = 5 AND OS.dwMinorVersion =  1 THEN OSStr = "WINXP"
                IF OS.dwMajorVersion = 5 AND OS.dwMinorVersion =  2 THEN OSStr = "Windows 2003" '.NET
        END SELECT
IF LEN(os.dwbuildnumber) THEN osstr=osstr + "  Build" & STR$(os.dwbuildnumber AND &HFFFF)
IF LEN( os.szCSDVersion) THEN osstr=osstr + "  " & os.szCSDVersion
    END IF
    FUNCTION = OSStr
END FUNCTION


SUB HeuteDatum
LOCAL tag AS STRING
LOCAL month AS STRING
tag=MID$(DATE$,4,2)
month=LEFT$(DATE$,2)
IF LEFT$(month,1)="0" THEN
   month=RIGHT$(month,1)
END IF
Datumheute$=tag+". "+month+". "+RIGHT$(DATE$,4)
Datum$=Datumheute$
END SUB

FUNCTION XPrintText( sText AS STRING, sHeader AS STRING, sFont AS STRING, fSize AS LONG, fStyle AS LONG ) AS LONG

    LOCAL sPrint, sLine, sTemp AS STRING
    LOCAL i, j, Count, PageLines, Page, POS, hFile, LastPos AS LONG
    LOCAL nLeft, nTop, nRight, nBottom, PageWidth, PageHeight, TxtWidth, TxtHeight AS SINGLE
    LOCAL x, y, PrntMargin AS SINGLE
    LOCAL nwidth&, nheight& , a AS LONG , b AS LONG , c AS LONG, ncWidth!, ncHeight!

      'einen Drucker zuweisen, wählen:
      XPRINT ATTACH CHOOSE
      IF LEN(XPRINT$) = 0 THEN
        FUNCTION = 0
        EXIT FUNCTION ' Druckerfehler
      ELSE
        i = MSGBOX( XPRINT$+$CRLF+$CRLF+$CRLF+"Diesen Drucker verwenden?",%MB_YESNO    ,"eingestellter Drucker")
        IF i = %IDNO    THEN
          XPRINT CLOSE
          XPRINT ATTACH CHOOSE
          IF LEN(XPRINT$) = 0 THEN
            MSGBOX "es wurde kein Drucker ausgewählt!",64,"Druckerauswahl Error"
            EXIT FUNCTION
          END IF
        END IF
      END IF
      '================================
XPRINT GET CLIENT TO ncWidth!, ncHeight!
'xprint scale (0,0) - (2100,2970) ' = Alternative für noch größere Auflösung
XPRINT SCALE (0,0)-(210,297)       ' alle Werte in mm angeben, wohin gedruckt werden soll!
      'get page specs
      XPRINT FONT sFont, fSize, fStyle  ' set the font first
      XPRINT GET LINES TO PageLines ' 57 MSGBOX STR$(PageLines),64,"PageLines"
      XPRINT GET MARGIN TO nLeft, nTop, nRight, nBottom 'get margins
      XPRINT GET CLIENT TO PageWidth, PageHeight 'get print area
      PrntMargin = PageWidth * 0.06 ' MSGBOX STR$(PrntMargin),64,"PrntMargin"
      PageWidth  = PageWidth - ( PrntMargin*2 ) ' MSGBOX STR$(PageWidth),64,"PageWidth"
'============================================================================
      'break up long lines
      sPrint = ""
      FOR i = 1 TO PARSECOUNT( sText, $CRLF )                     ' go thru the whole file
          sLine = PARSE$( sText, $CRLF, i )                       ' get string that is too long
          XPRINT TEXT SIZE sLine TO TxtWidth, TxtHeight           ' get length of line
          IF TxtWidth > PageWidth THEN                            ' the line is longer than the page width
            POS = INSTR( 1, sLine, " " )                          ' find first word
            WHILE LEN(sLine)
              POS   = INSTR( 1, sLine, " " )                      ' find the end of the first word
              DO                                                  ' step thru the line word by word
                LastPos = POS                                     ' save last step
                POS     = INSTR( POS+1, sLine, " " )              ' next word
                sTemp   = LEFT$( sLine, POS-1 )                   ' load line so far
                XPRINT TEXT SIZE sTemp TO TxtWidth, TxtHeight     ' get length of line so far
                IF POS = 0 THEN                                     ' at the end of the line
                  IF TxtWidth > PageWidth THEN                      ' we have a very long word!
                    IF LastPos THEN EXIT LOOP                       ' end of line and PageWidth coincide
                    DO                                              ' loop thru the word one char at a time
                      INCR POS
                      sTemp = LEFT$( sLine, POS )                   ' compile word
                      XPRINT TEXT SIZE sTemp TO TxtWidth, TxtHeight ' Test length
                      LastPos = POS                                 ' Last Char is under PageWidth
                    LOOP UNTIL TxtWidth >= PageWidth                ' Exit when Pagewidth exceeded
                    EXIT LOOP                                       ' Done
                  ELSE
                    LastPos = LEN(sLine)+1                          ' Line is shorter than PageWidth
                    EXIT LOOP                                       ' Done
                  END IF
                END IF
              LOOP UNTIL TxtWidth > PageWidth                     ' now line is one step too long
              sTemp  = LEFT$( sLine, LastPos-1 )                  ' Line at last step befor exceded PageWidth
              sPrint = sPrint + TRIM$(sTemp) + $CRLF              ' Add correct length line to lines so far
              sLine  = RIGHT$( sLine, -(LastPos-1) )              ' Remove from line and continue on (PB8)
              POS    = 1                                          ' start at beggining of what is left of line
            WEND
          ELSE
            sPrint = sPrint + TRIM$(sLine) + $CRLF                ' Line length is less than Page Width
          END IF
      NEXT i                                                      ' repeat for all lines in sText
      sPrint = RTRIM$( sPrint, $CRLF )                            ' Remove trailing $CRLF's
      '================================


'      OPEN "FormattedLetter.txt" FOR BINARY AS #hFile ' for testing
'          IF ERR THEN
'            MSGBOX "Problem creating file",64,"File Error"+STR$(ERRCLEAR)
'            CLOSE #hFile
'            EXIT FUNCTION
'          END IF
'          PUT$ #hFile, sPrint
'      CLOSE #hFile
'      EXIT FUNCTION
'      '================================
' das Prgm hier ist absichtlich "unordentlich" zusammengesetzt, um zu zeigen,
' daß es NICHT auf die Reihenfolge im Programmablauf ankommt, was  gedruckt wird, sondern
' es darf ruhig 'wild durcheinander' programmiert werden: d.h. mal auf den Blattanfang drucken,
' dann unten, dann in der Mitte..., das ist also vollständig egal! Denn XPRINT ordnet alles selbständig
' und druckt alles so, wie es der Programmierer als GANZES vorsieht!
' also, man kann hier im Programmlisting alle Objekte auch so anordnen, daß alles von oben nach unten
' und von links nach rechts der Reihe nach im Listing steht. Aber im Ausdruck selbst ändert das
' ÜBERHAUPT NICHTS!

      'print header
      Page  = 1 : a = 0
      sHeader="Firma soundso"  '
      XPRINT TEXT SIZE sHeader TO TxtWidth, TxtHeight ' Header width
'      MSGBOX STR$(TxtWidth) + "     " + STR$(TxtHeight)
      XPRINT COLOR RGB(3,135,63), -2
      XPRINT FONT "Comic Sans MS",26,3
      XPRINT SET POS (70, 0)        'orig.:       XPRINT SET POS (60, 25)
      XPRINT sHeader

            sHeader="Suse"
      XPRINT FONT "Comic Sans MS",12,3
      XPRINT SET POS (75, 11)
      XPRINT sHeader

            sHeader="von"
      XPRINT FONT "Comic Sans MS",10,3
      XPRINT SET POS (81, 16)
      XPRINT sHeader

            sHeader="und zu"
      XPRINT FONT "Comic Sans MS",12,3
      XPRINT SET POS (88,16)
      XPRINT sHeader

      sHeader="Fröhlich"
      XPRINT FONT "Comic Sans MS",24,3
      XPRINT SET POS (103,10)
      XPRINT sHeader

      b = 0       'senkrechte Verschiebung: nach oben o. unten: -/+
       sHeader="Amselweg 7, 08150 Irgendwo"
      XPRINT FONT "Comic Sans MS",13,3
      XPRINT SET POS (68,25 )
      XPRINT sHeader
       sHeader="Tel./Fax: 0815/01010"
      XPRINT FONT "Comic Sans MS",13,3
      XPRINT SET POS (68, 32)
      XPRINT sHeader
       sHeader="www.suse_vonundzu_froehlich.de"
      XPRINT FONT "Comic Sans MS",11,3
      XPRINT SET POS (136, 62)
      XPRINT sHeader
       sHeader="email: suse_vzf_@web.de"
      XPRINT FONT "Comic Sans MS",11,3
      XPRINT SET POS (69, 40)
      XPRINT sHeader
'--------------------------------------------------------------------------------------------
       sHeader=Datum$
      XPRINT FONT "Comic Sans MS",11,3     ' Datum:
      XPRINT COLOR RGB(0,0,0),-1
      XPRINT SET POS (163, 80)
      XPRINT sHeader
' Falzkante markieren: kurze Linie am linken Rand
      XPRINT COLOR RGB(0,0,0),-1
'      XPRINT FONT "Comic Sans MS",11,3
     XPRINT LINE (0, 110) - (7, 110)      ' orig.: 108
      '================================
      ' drucke BMP:
  nfile&=FREEFILE
  OPEN "bild1.bmp" FOR BINARY AS nfile&
  GET #nFile&, 19, nwidth&
  GET #nFile&, 23, nHeight&
  CLOSE nFile&
  XPRINT RENDER "bild1.bmp", (150,5)-(205,72)
   IF ERR THEN MSGBOX "Status von XPRINT RENDER" + STR$(ERRCLEAR)
       '================================   Mitte: Logo familyv.bmp
   nfile&=FREEFILE
  OPEN "bhj.bmp" FOR BINARY AS nfile&
  GET #nFile&, 20, nwidth&
  GET #nFile&, 24, nHeight&
  CLOSE nFile&
  XPRINT RENDER "bhj.bmp", (0,0)-(65,45)
   IF ERR THEN MSGBOX "Status von XPRINT RENDER" + STR$(ERRCLEAR)
       '================================  Rechts: brommi_rh_col.bmp

'  nfile&=FREEFILE
'  OPEN "bild2.bmp" FOR BINARY AS nfile&
'  GET #nFile&, 19, nwidth&
'  GET #nFile&, 23, nHeight&
'  CLOSE nFile&
'  XPRINT RENDER "bild2.bmp", (165,5)-(206,44)
'   IF ERR THEN MSGBOX "Status von XPRINT RENDER" + STR$(ERRCLEAR)
       '================================
' Umrahmen mit: ¤ :
'      XPRINT COLOR RGB(63,135,63), -2
'      XPRINT FONT "Comic Sans MS",12,3
'      XPRINT SET POS (50, 24)
'      XPRINT string$(150, "~")
' ..........   oberer Rand ...........................  unterer Rand: blaue Wellenlinie
      XPRINT COLOR RGB(7,146,248), -2
      XPRINT FONT "Comic Sans MS",13,3
      XPRINT SET POS (5, 45)
      XPRINT STRING$(49, "~")   ' orig.: 75 bei Schriftgröße 12;  70 bei S.gr. 13;
  ' allgemeine Druckfarbe festlegen für restlichen Ausdruck:
      XPRINT COLOR RGB(0,0,0),-1
      XPRINT FONT "Comic Sans MS",8,5
      XPRINT SET POS (18, 52)
      XPRINT "Abs.: Suse vonundzu Fröhlich, Amselweg 7, 08150 Irgendwo"
 '     XPRINT FONT "Comic Sans MS",11,3
      XPRINT FONT "Comic Sans MS",11,3    ' Schriftgröße für restlichen Brieftext
'.........................................................................................
      'Print the pages line by line
'      Count = 4 ' 4 lines for header
'msgbox str$(PrntMargin+10)              ' li Rand jetzt 22.7
        XPRINT GET POS TO x, y :y=600
      FOR i = 1 TO PARSECOUNT( sPrint, $CRLF )
        INCR Count
        XPRINT GET POS TO x, y
        y=y/10+5*i
'        msgbox str$(x)+ ", "+str$(y)
'        XPRINT SET POS (PrntMargin+120, y )  ' move print start position to calculated margin
 XPRINT SET POS (PrntMargin+10, y )             ' orig.:  XPRINT SET POS (PrntMargin+5, y )
        sLine = PARSE$( sPrint, $CRLF, i )
        XPRINT sLine
        IF Count = PageLines THEN
          INCR Page
          XPRINT FORMFEED ' New page
          XPRINT TEXT SIZE sHeader TO TxtWidth, TxtHeight ' Header width
'          XPRINT SET POS (PrntMargin+120, nTop+TxtHeight )
    XPRINT SET POS (PrntMargin+10, nTop+TxtHeight )   ' orig.:     XPRINT SET POS (PrntMargin+5, nTop+TxtHeight )
          XPRINT "Seite " + FORMAT$(Page, "0")
          XPRINT SET POS (((PageWidth-TxtWidth)/2), nTop+TxtHeight )
          XPRINT sHeader
          XPRINT
'          Count = 4
        END IF
      NEXT i
      '================================

' ab zum Druck!!
      'Detach the printer
      XPRINT CLOSE
      '================================

  FUNCTION = Page ' return # of pages printed

END FUNCTION

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'
FUNCTION PBMAIN

  LOCAL i, hFile AS LONG
  LOCAL sFile, sLine, sTemp AS STRING

' feststellen, welches Betriebssystem: bei WINXP einen "Vergrößerungsfaktor anwenden: winxp=1.66
'     winver$= osversion
' msgbox osversion
  IF INSTR (osversion,"WINXP") THEN
    winxp=1
   ELSE
    winxp=0
  END IF

  ' aktuelles Datum in Bestätigung einfügen
CALL heutedatum
' nun schreibe den aktuellen Bestätigungstext mit der zugehörigen Anschrift des Gastes:
    hFile = FREEFILE  '
    ' fewobesx.txt beginnt mit 10 Leerzeilen, es folgt die Anschrift, Anrede und Brieftext, Gruß
    OPEN "fewobesx.txt" FOR BINARY AS hFile ' <------------------CHANGE THIS
'    OPEN "fewobesx.txt" AS hFile ' <------------------CHANGE THIS
      IF ERR THEN
          MSGBOX "Problem mit dem Öffnen des Files",64,"File Error"+STR$(ERRCLEAR)
          CLOSE hFile
          EXIT FUNCTION
      END IF
      GET$ hFile, LOF(hFile), sFile ' read the whole file into a string
    CLOSE hFile
    '================================

    i = XPrintText( sFile, "", "Comic Sans MS", 12, 0 ) ' Print the text
    IF i THEN
'        MSGBOX STR$(i)+" Seiten gedruckt",64,"Ausdruck komplett"
    ELSE
        MSGBOX "Nichts wurde gedruckt",64,"Druck fehlgeschlagen!"
    END IF
    '================================
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'