Drucker umstellen (Portait oder Landscape)

[H.Brill]

Hallo,
Hab da eine Routine, ursprünglich in XProfan
von Andreas Hötker geschrieben, die ich in
PB umgesetzt habe. Umstellen auf Landscape
geht, aber es läßt sich nicht mehr zurückstellen.
Weiß jemand, wo der Haken ist ?
Außerdem würde ich noch gerne eine Fehlerbehandlung
einbauen.
PS: Die Printer -lib scheint bei mir unter XP und PB4.4
Beta 6 nicht zu funktionieren. Hab auch sonst nichts
gefunden, was funktioniert hätte.

Code: Alles auswählen

#VER_PLATFORM_WIN32_WINDOWS = 1
#VER_PLATFORM_WIN32_NT = 2

Global Dim OS.OSVERSIONINFO(1)

Procedure PrinterMode(mode.l) ; 1=Portait 2= Landscape
; ursprüngliche Routine in XProfan von Andreas Hötker
Protected WinVer.l, SectionName.s, Keyname.s, DefaultString.s, ReturnBuffer.l, PrinterName.s, PHandle.l
Protected PDevice.s, Count.l, Laenge.l, DevMode.l, DevMode2.l, Fehler.l, Offset.l, Zaehler.l
Protected Found.l, Laenge2.l, Vergleich.l, SubKey.s
Protected pcount.l, Pointer_To_DevMode.l, pHandle1.l

;OnErrorGoto(?ErrorHandler)

OS(0)\dwOSVersionInfoSize = 148 
GetVersionEx_(@*OS)
WinVer = 8
If OS(0)\dwPlatformID = #VER_PLATFORM_WIN32_WINDOWS
   If OS(0)\dwMajorVersion = 4
      Select OS(0)\dwMinorVersion
        Case 0  : WinVer = 1
        Case 10 : WinVer = 2
        Case 90 : WinVer = 3
      EndSelect       
   EndIf
ElseIf OS(0)\dwPlatformID = #VER_PLATFORM_WIN32_NT
   Select OS(0)\dwMajorVersion
      Case 4 : Win_Ver = 4
      Case 5 : Win_Ver = 5
      Case 6 : Win_Ver = 6
      Case 7 : Win_Ver = 7
   EndSelect   
EndIf  
*ReturnBuffer = AllocateMemory(256)
SectionName = "Windows"
KeyName     = "device"
DefaultString = ""
GetProfileString_(@SectionName, @KeyName, @DefaultString, *ReturnBuffer, 256)
Printername = StringField(PeekS(*ReturnBuffer), 1, ",")
FreeMemory(*ReturnBuffer)
PDevice = ""
If Win_Ver < 6
   *pHandle = AllocateMemory(4)
   Fehler = OpenPrinter_(@PrinterName, *pHandle, 0)
   ;Fehler = ErrorCode()
   Laenge = DocumentProperties_(WindowID(#MyWindow), PeekL(*pHandle), @PDevice, 0, 0, 0)
   ;Fehler = ErrorCode()
   *DevMode = AllocateMemory(Laenge)
   *DevMode2 = AllocateMemory(Laenge)
   Fehler = DocumentProperties_(WindowID(#MyWindow), PeekL(*pHandle), @Device, *DevMode, 0, 2)
   ;Fehler = ErrorCode()
   Fehler = DocumentProperties_(WindowID(#myWindow), PeekL(*pHandle), @PDevice, *DevMode2, 0, 2)
   ;Fehler = ErrorCode()
   Fehler = PeekW(*DevMode + 44)
   PokeL(*DevMode + 40, 1)
   PokeW(*DevMode + 44, mode)
   Fehler = DocumentProperties_(WindowID(#MyWindow), PeekL(*pHandle), @PDevice, *DevMode, *DevMode, 8|2|1)
   ;Fehler = ErrorCode()
   Fehler = ClosePrinter_(PeekL(*pHandle))
   Fehler = OpenPrinter_(@PrinterName, *pHandle, 0)
   ;Fehler = ErrorCode()
   Fehler = DocumentProperties_(WindowID(#MyWindow), PeekL(*pHandle), @PDevice, *DevMode2, 0, 2)
   ;Fehler = ErrorCode()
   Fehler = PeekW(*DevMode +44)
   Fehler = ClosePrinter_(PeekL(*pHandle))
   FreeMemory(*DevMode)
   FreeMemory(*pHandle)
   FreeMemory(*DevMode2)
Else
   *pHandle = AllocateMemory(4)
   Fehler = OpenPrinter_(@PrinterName, *pHandle, 0)
   ;Fehler = ErrorCode()
   Laenge2 = DocumentProperties_(WindowID(#MyWindow), PeekL(*pHandle), @PDevice, 0, 0, 0)
   ;Fehler = ErrorCode()
   *DevMode = AllocateMemory(Laenge2)
   Fehler = DocumentProperties_(WindowID(#MyWindow), PeekL(*pHandle), @PDevice, *DevMode, 0, 2)
   ;Fehler = ErrorCode()
   Fehler = PeekW(*DevMode + 44+32)
   *DevMode2 = AllocateMemory(Laenge2)
   Fehler = ClosePrinter_(PeekL(*pHandle))
   PokeW(*DevMode + 44+32, mode)
   *Handle = AllocateMemory(4)
   SubKey = "Printers\DevModePerUser"
   RegCreateKey_($80000001, @SubKey, *Handle)
   RegSetValueEx_(PeekL(*Handle), @PrinterName, 0, 3, *DevMode, Laenge2)
   RegCloseKey_(PeekL(*Handle))
   SubKey = "Printers\DevModes2"
   RegCreateKey_($80000001, @Subkey, *Handle)
   RegSetValueEx_(PeekL(*Handle), @PrinterName, 0, 3, *DevMode, Laenge2)
   RegCloseKey_(PeekL(*Handle))
   FreeMemory(*Handle)
   SendMessage_($FFFF, $001A, 0, 0)
   SendMessage_($FFFF, $001B, 0, 0)
   Fehler = OpenPrinter_(@PrinterName, *pHandle, 0)
   ;Fehler = ErrorCode()
   Fehler = DocumentProperties_(WindowID(#MyWindow), PeekL(*pHandle), @PDevice, *DevMode2, 0, 2)
   ;Fehler = ErrorCode()
   Fehler = PeekW(*DevMode2 + 44+32)
   Fehler = ClosePrinter_(PeekL(*pHandle))
   FreeMemory(*pHandle)
   FreeMemory(*DevMode2)
   FreeMemory(*DevMode) 
EndIf
ErrorHandler:
;MessageRequester("Fehlermeldung", "Der folgende Fehler trat auf: " + ErrorMessage(Fehler))
EndProcedure  

[dysti]

Hallo bobobo,
ist das Problem noch aktuell oder hast du es zwischenzeitlich gelöst?

[bobobo]

die in pb übliche abfolge zum drucken stellt erst den Drucker ein per PrintRequester(...) (dort dann auch hoch oder quer ..) und danach darauf auszudrucken.

zu Fuss geht es wohl auch (es lebe das Codearchiv)
http://www.purearea.net/pb/CodeArchiv/P ... ideways.pb

ömm -- beim drucken setzt die Anwendung die orientierung und
überschreibt dabei NICHT die im Treiber voreingestellte Orientierung
um da global was umzustellen, muss man in die Druckereinstellungen
(unter xp -start - einstellungen - drucker und faxgeräte)

anbei noch der codearchiv-code leicht abgewandelt.

Code: Alles auswählen

;
#hoch=1
#quer=2

Enumeration 0
  #win
  #text
  #knopp
  #knoppw
  #hochg
  #querg
EndEnumeration

OpenWindow(#win,0,0,500,500,"switch",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OptionGadget(#hochg, 30, 20, 60, 20, "hoch")
OptionGadget(#querg, 30, 45, 60, 20, "quer")
ButtonGadget(#knopp,0,65,500,20,"machen Sie es so .. Energie")
ButtonGadget(#knoppw,0,85,500,20,"nach hause gehen")

STDPrinterName$ = Space(260)
GetPrivateProfileString_("WINDOWS","DEVICE","", @STDPrintername$, 260, "Win.Ini")
STDPrintername$ = StringField(STDPrintername$, 1,",")

PrinterHandle.l = 0
OpenPrinter_(StdPrintername$,PrinterHandle.l,0)

Dim DevIn.DEVMODE(1)
Dim DevOut.DEVMODE(1)

DocumentProperties_(0,Printerhandle,StdPrintername$,DevIn(0),DevOut(0),#DM_OUT_BUFFER|#DM_IN_BUFFER)
ClosePrinter_(PrinterHandle)
TextGadget(#text,0,0,500,20,STDPrinterName$)
If DevIn(0)\dmOrientation =1
  SetGadgetState(#hochg,1)
Else
  SetGadgetState(#querg,1)
EndIf
Repeat
  event=WaitWindowEvent()
  egadget=EventGadget()
  Select event
  Case  #PB_Event_CloseWindow
  quit=1
  Case #PB_Event_Gadget
  Select egadget
  Case #knopp
    If GetGadgetState(#hochg)=0
      ori=2
      ausgabe.s="KwerDruck (ein uralter joke ) Also hömma nä? ..mhmmm.. ich mag ja besonders gerne .. mhmm..schwarzen Kaffe nä? .. mhmm"
    Else
      ori=1
      ausgabe.s="Längsdruck"
    EndIf
    DevIn(0)\dmOrientation = ori ;auf Längs oder Quer setzen
    PrinterDC.l = CreateDC_("WINSPOOL",StdPrintername$,0,DevIn(0))
    DocInf.DOCINFO
    DocInf\cbSize = SizeOf(DOCINFO)
    DocInf\lpszDocName = @"Mein Dok"
    DocInf\lpszOutput = #Null
    If StartDoc_(PrinterDC,@DocInf) > 0
      If StartPage_(PrinterDC) > 0
        TextOut_(PrinterDC,120,140,ausgabe,Len(ausgabe))
        EndPage_(PrinterDC)
        EndDoc_(PrinterDC)
      EndIf
    EndIf
  Case #knoppw
  quit=1
  EndSelect
  EndSelect
Until quit
End
[code]

und so ein paar Print-Prozeduren für dickeren text (mit umbruch und so) zum selberweitertüfteln
[code]
;
;
;
Procedure  StartPrint(Dokname.s)
  mDI.DOCINFO
  mDI\cbSize = 12
  mDI\lpszDocName = @Dokname
  mDI\lpszOutput = 0
  StartDoc_(PrinterDC,mDI)
EndProcedure

Procedure  am_Drawtext(x.l,y.l,w.l,h.l,s.s,LCR,Color.l,Font.s,FontHeight.l,FontPar)
  ;######################################################
  ;Textausgabe
  ;######################################################
  SetBkMode_(PrinterDC,#TRANSPARENT)
  SetTextColor_(PrinterDC,Color)
  FontID = LoadFont(0,Font,FontHeight,FontPar)
  SelectObject_(PrinterDC,FontID(0))
  r.RECT
  r\left = x
  r\top = y
  r\right = x + w
  r\bottom = y + h
  Printertext.s = s
  DrawText_(PrinterDC,Printertext,Len(Printertext),r, LCR)
  FreeFont(0)
EndProcedure

Procedure Do_Print(drucker.s,Ausgabename.s,t.s)
  ;  Debug drucker
  ;  Debug t
  PrinterDC.l = CreateDC_("WINSPOOL",drucker,0,0)
  If PrinterDC
    PrintersWidth=GetDeviceCaps_(PrinterDC,8);Blattbreite in Pixel
    PrintersHeight=GetDeviceCaps_(PrinterDC,10);Blatthöhe in Pixel
    ;    Debug PrintersWidth
    ;    Debug Printersheight
    StartPrint(Ausgabename.s);startet den Ausdruck
    StartPage_(PrinterDC)
    fonth.f=0.30 * PrintersHeight/29.7
    FontHeight.l=fonth.f
    am_Drawtext(0,0,PrintersWidth,PrintersHeight,t,#DT_LEFT,RGB(0,0,0),"Courier New",69,#PB_Font_HighQuality|#PB_Font_Bold)
    EndPage_(PrinterDC);Seite abschliessen
    EndDoc_(PrinterDC);Ausdruckl beenden
    DeleteDC_(PrinterDC);Device-Context freigeben
    bearbeitet=1
  Else
    ;Debug "Drucker will nicht"
    ;Debug "Drucker will nicht"
  EndIf
EndProcedure

[dysti]

...also verwendest du den obigen Code nicht mehr?

[bobobo]

ich verwende den eh nicht und hab den auch nie verwendet ....
ich weiß auch gar nicht warum ich überhaupt der adressat sein soll
aber ich helf ja gerne mal (wenn es denn hilft) (obiger beitrag editiert)

[dysti]

.......ooooooohhhhhhhh Sche............!
Weiß auch nicht wieso ich dein Nicknamen (bobobo) benutzt habe.
Entschuldige bitte.
Ich meinte natürlich -> H.Brill.

[bobobo]

hihi .. immerhin findet er nun ne lösung (falls das da oben eine ist).