XProfan

 $P+
Set("ErrorLevel", 0)
 $H IncludeWindows.ph
 $H Includemessages.ph
 $H Includecommctrl.ph
 $H IncludeStructs.ph
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Drucker auf quer stellen
DEF @GetProfileString(5) !"kernel32","GetProfileStringA"
DEF @OpenPrinter(3) !"winspool.drv","OpenPrinterA"
DEF @DocumentProperties(6) !"winspool.drv","DocumentPropertiesA"
DEF @ClosePrinter(1) !"winspool.drv","ClosePrinter"
DEF @GetLastError(0) !"kernel32","GetLastError"
DEF @DocumentPropertiesW(6) !"winspool.drv","DocumentPropertiesW"
DEF @RegCREATEKEY(3)!"ADVAPI32","RegCreateKeyA"Schlüssel erstellen
def @RegSetValueEx(6) !"ADVAPI32","RegSetValueExA"
def @RegCloseKey(1) !"ADVAPI32","RegCloseKey"
Struct OSVERSIONINFO = dwOSVersionInfoSize&,dwMajorVersion&,dwMinorVersion&,dwBuildNumber&,dwPlatformId&,szCSDVersion$(128)

Proc Drucker_Orientation_Umstellen

    Parameters Orientation%1=Hochformat, 2=Querformat
    Declare SectionName$,KeyName$,DefautString$,ReturnBuffer#,Printername$,PHANDLE#,Länge2&
    Declare Pdevice$,DevMode#,DevMode2#,Fehler&
    Declare SubKey$
    Declare Handle#
    DIM ReturnBuffer#,256
    SectionName$="Windows"
    KeyName$="device"
    DefautString$=""
    @GetProfileString(@ADDR(SectionName$),@ADDR(KeyName$),@ADDR(DefautString$),ReturnBuffer#,256)
    Printername$=@SubStr$(@STRING$(ReturnBuffer#,0),1,",")
    Dispose ReturnBuffer#
    Pdevice$=""
    DIM PHANDLE#,4
    Fehler&=@OpenPrinter(@ADDR(Printername$),PHANDLE#,0)
    Länge2&=@DocumentPropertiesW(%HWND,@Long(PHANDLE#,0),@ADDR(Pdevice$),0,0,0)
    DIM DevMode#,Länge2&
    FEHLER&=@DocumentPropertiesW(%HWND,@Long(PHANDLE#,0),@ADDR(Pdevice$),DevMode#,0,2)
    Fehler&=@Word(DevMode#,44+32)
    Alte Ausgelesene Ausrichtung:
    old_prnRi&=Fehler&
    DIM DevMode2#,Länge2&
    WORD DEVMODE#,44+32=Orientation%
    Dim Handle#,4
    SubKey$="PrintersDevModePerUser"
    @RegCREATEKEY($80000001,@addr(SubKey$),Handle#)
    @RegSetValueEx(@LONG(Handle#,0),@ADDR(Printername$),0,3,DEVMODE#,Länge2&)
    @RegCloseKey(@LONG(Handle#,0))
    SubKey$="PrintersDevModes2"
    @RegCREATEKEY($80000001,@addr(SubKey$),Handle#)
    @RegSetValueEx(@LONG(Handle#,0),@ADDR(Printername$),0,3,DEVMODE#,Länge2&)
    @RegCloseKey(@LONG(Handle#,0))
    Dispose Handle#
    @Sendmessage($FFFF,$001A,0,0)
    @Sendmessage($FFFF,$001B,0,0)
    Fehler&=@OpenPrinter(@ADDR(Printername$),PHANDLE#,0)
    Fehler&=@GetLastError()
    FEHLER&=@DocumentPropertiesW(%HWND,@Long(PHANDLE#,0),@ADDR(Pdevice$),DevMode2#,0,2)
    Fehler&=@GetLastError()
    Fehler&=@Word(DevMode2#,44+32)
    Fehler&=@ClosePrinter(@Long(PHANDLE#,0))
    Dispose PHANDLE#
    Dispose DevMode2#
    Dispose DevMode#

Endproc

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetAutoPaint 0

Proc Statistik_Neu

    Declare old_prnRi&  alte Druckerausrichtung
    Declare text$

    If MS_Druck%=1

        Drucker_Orientation_Umstellen 2 Druck auf quer einstellen
        text$= "*Statistik"
        StartPrint text$

        If %Printing = 0

            Return

        EndIf

    EndIf

    case MS_Druck%=0 : startpaint B_dlg&
    UseFont "Arial",18,0,1,0,0
    TextColor @RGB(0,0,0),-1
    DrawText 210,100,"Mitgliederstatistik nach Eintrittsjahren"
    UseFont "Arial",12,0,0,0,0
    TextColor @RGB(0,0,0),-1
    DrawText 870,630,"Stand: "+Date$(0)
    Line 120,520-950,520
    UsePen 0,0,rgb(255,255,255)
    UseBrush 1,rgb(255,0,0)
    Rectangle 100,525,110,535
    UseBrush 1,rgb(0,255,0)
    Rectangle 100,540,110,550
    UseBrush 1,rgb(0,0,255)
    Rectangle 100,555,110,565
    case MS_Druck%=0 : endpaint B_dlg&

    If MS_Druck%=1

        endprint
        Drucker_Orientation_Umstellen old_prnRi&  Drucker auf alte Richtung stellen

    EndIf

EndProc

Proc Statistik

    Parameters MS_art%
    var B_dlg& = @Create("DIALOG",%hwnd,"  Mitglieder-Statistik " ,10,10,1018,720)
    var      MS_Datei$ = "Datei"
    var      MS_Beenden$ = "Beenden"
    var      MS_Druck$ = "Drucken"
    var      hMenu& = ~CreateMenu()
    var      hMenuPopup& = ~CreateMenu()
    ~AppendMenu(hMenuPopup&, ~MF_STRING, 4101, @Addr(MS_Druck$))
    ~AppendMenu(hMenuPopup&, ~MF_STRING, 4102, @Addr(MS_Beenden$))
    ~AppendMenu(hMenu&, ~MF_POPUP, hMenuPopup&, @Addr(MS_Datei$))
    ~SetMenu(B_Dlg&, hMenu&)
    var   MS_Druck%=0
    Statistik_neu
    @SetFocus(b_dlg&)

    While 1

        WaitInput
        case %wmpaint=1:Statistik_neu

        If %key = 2

            BREAK

        ElseIf @Int(@Abs(%MenuItem)) = 4102

            BREAK

        ElseIf @Int(@Abs(%MenuItem)) = 4101

            MS_Druck%=1
            Statistik_neu
            MS_Druck%=0
            @SetFocus(b_dlg&)

        EndIf

    Wend

    @DestroyWindow(B_dlg&)

Endproc

################################## H A U P T T E I L ####################################
Cls
Statistik
WaitInput
@DestroyWindow(%hWnd)
End