XProfan

 $H commctrl.ph
 $H Structs.ph
 $H Messages.ph

Proc CountGridColumns

    Parameters Handle hGrid
    Declare Memory b
    Declare flag&
    Var TotalColumns& = 0
    Struct LV_COLUMN = ~LV_COLUMN
    Dim b, LV_COLUMN
    b.mask& = ~LVCF_WIDTH

    Repeat

        Inc TotalColumns&
        flag& = SendMessage(hGrid, ~LVM_GETCOLUMN, TotalColumns&, b)

    Until flag& = 0

    Dispose b
    Return TotalColumns&

EndProc

Proc LV_GETCOLUMN

    Parameters Handle Hdl,Index&
    Declare Column#,Text$,Erfolg%
    Struct LVCOLUMN = mask&, fmt&, cx&, pszText%%, cchTextMax&, iSubItem&, iImage&, iOrder&
    Dim Column#, LVCOLUMN
    Text$ = MkStr$("\z",160)' hier anpassen, wenn die Texte länger sein sollten
    Column#.mask& = ~LVCF_TEXT
    Column#.pszText%% = Addr(Text$)
    Column#.cchTextMax& = 160' s.o.
    SendMessage(Hdl,~LVM_GETCOLUMN,Index&,Column#)
    Return Text$

EndProc

Proc ErstelleHTM

    Parameters Handle dGrid, us$, htmdatei$
    Declare anz&, zeile$, cols&, column$, tmp$
    cols& = CountGridColumns(dGrid)
    Declare Memory b
    Assign #1, htmdatei$
    Rewrite #1
    Print #1,"<!DOCTYPE html PUBLIC"+chr$(34)+"-//W3C//DTD XHTML 1.0 Transitional//EN"+chr$(34)+"https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"+chr$(34)+">"
    Print #1, "<html xmlns="+chr$(34)+"https://www.w3.org/1999/xhtml"+chr$(34)+" xml:lang="+chr$(34)+"de"+chr$(34)+" lang="+chr$(34)+"de"+chr$(34)+">"
    Print #1,"<head>"
    Print #1, "<title>" + us$ + "</title>"
    Print #1, "<style type="+chr$(34)+"text/css"+chr$(34)+">"
    Print #1, "td {font-family:Verdana; font-size:12px; border: 1px solid rgb(0, 0, 0); padding: 3px; text-align: left}"
    Print #1, "th {font-family:Verdana; font-size:12px; font-weight:bold; border: 1px solid rgb(0, 0, 0); padding: 3px; text-align: left}"
    Print #1, ".zeile1 {font-family:Verdana; font-size:12px; }"
    Print #1, ".zeile3 {font-family:Verdana; font-size:12px;color:black; background-color:#A8D2FD;}"
    Print #1, "</style>"
    Print #1,"</head>"
    Print #1, "<body>"
    Print #1, "<table>"
    Print #1, "<colgroup>"
    Struct LV_COLUMN = Maske&,Formate&,SpaltenBreite&,pointerText&,TextLen&,Spalte&
    Declare Column#,x&
    Dim Column#,LV_COLUMN

    WhileLoop 0,(cols& - 1),1

        With Column#

            .Maske&         = $000F
            .Spalte&        = &loop

        EndWith

        SendMessage(Grid,$1019,&loop,Column#)
        x&= SendMessage(Grid,$101D,&loop,0)
        Print #1, "<col width="+chr$(34)+Str$(x&)+"px"+chr$(34)+">"

    EndWhile

    Print #1, "</colgroup>"
    Print #1, "<tr >"

    WhileLoop 0, Cols&-1

        Print #1, "<th class="+chr$(34)+"zeile3"+chr$(34)+">" + Trim$(LV_GETCOLUMN(dGrid, &loop)) + "</th>"

    EndWhile

    Print #1, "</tr>"
    anz& = GetCount(dGrid)
    Var x%=0

    While x%<anz&

        Print #1, "<tr>"

        WhileLoop 0, Cols&-1

            Print #1, "<td class="+chr$(34)+"zeile1"+chr$(34)+">" + Trim$(GetText$(dGrid, x%, &loop)) + "</td>"

        EndWhile

        Print #1, "</tr>"
        inc x%

    EndWhile

    Print #1, "</table>"
    Print #1, "</body>"
    Print #1, "</html>"
    Close #1
    '@ShellExec(htmdatei$, "open", 1)

EndProc

Proc ShowHtm

    Parameters Handle hwindow, Grid, String datei, us$
    Declare Handle htmWin, hWin, hbtn1, hbtn2, Int ende2
    ende2 = 0
    ErstelleHTM(Grid, us$, datei)' Html-Datei erzeugen
    hWin  = @Create("Dialog", hwindow, "HTML - Fenster", 10, 10, 800, 400)
    hbtn1 = @Create("Button", hWin, "Drucke", 10, 10, 60, 25)
    hbtn2 = @Create("Button", hWin, "Ende", 100,  10, 60, 25)
    htmWin = @Create("HTMLWin", hWin, datei, 1, 10, 60, 750, 300)

    WhileNot ende2

        WaitInput

        If @Clicked(hbtn1)

            ' Drucken
            Messagebox("Mit rechter Maustaste auf die Tabelle klicken\nund im Kontexmenü Drucken auswählen !", "Info", 0)
            '@ShellExec(datei, "print", 0)

        ElseIf @Clicked(hbtn2)

            DestroyWindow(hWin)
            ende2 = 1
            SetActiveWindow(%HWnd)

        EndIf

    EndWhile

    DestroyWindow(hWin)

EndProc

Declare Handle label1, label2, edit1, edit2, static
Declare Handle btn1, btn2
Declare Int ende
Window 800, 400
static = Create("Static", %HWnd, 10, 10, 350, 200)
label1 = Create("Text", static, "Nummer :", 10, 10, 80, 25)
label2 = Create("Text", static, "Name   :", 10, 40, 80, 25)
edit1  = Create("Edit", static, "", 90, 10, 40, 25)
edit2  = Create("Edit", static, "", 90, 40, 120, 25)
btn1   = Create("Button", %Hwnd, "Drucken", 380, 10, 60, 25)
btn2   = Create("Button", %HWnd, "Ende",    380, 40, 60, 25)
StartPaint static
DrawIcon "A", 50, 80
DrawIcon "GESICHT", 100, 80
UseFont "ARIAL", 24, 16, 1, 0, 0
DrawText 10, 120, "Erster Text !"
UseFont "ARIAL", 16,   8, 1, 0, 0
DrawText 10, 170, "Zweiter Text !"
EndPaint
ende = 0

WhileNot ende

    WaitInput

    If Clicked(btn1)

        ' Drucken
        WinCopy static

    ElseIf Clicked(btn2)

        ende = 1

    EndIf

    Case %Key = 2 : ende = 1

EndWhile

End