XProfan

declare calender&,lesen&
declare dtp#
DEF getsystime(2) SendMessage(&(1),4097,0,&(2))
dim dtp#,20

PROC GETDATE

    declare d$,m$,y$
    parameters chdl&
    getsystime(chdl&,dtp#)
    d$=format$(00,word(dtp#,6))
    m$=format$(00,word(dtp#,2))
    y$=format$(0000,word(dtp#,0))
    return d$+.+m$+.+y$

ENDPROC

cls
calender&=Control(SysMonthCal32,,$54000004,1,1,202,155,%hwnd,2000,%hinstance)
lesen&=Create(Button,%hwnd,Zeige,220,10,100,20)

while 1

    waitinput

    if getfocus(lesen&)

        getdate calender&
        messagebox($(0),Gewählt,0)

    endif

wend

dispose dtp#

(C) 2007 by Marc-Gordon Kröhn, http://www.marc-gordon.de
 $P*
USERMESSAGES 16
Declare lvdll&,exit%,liste&,freelist&,text$,lvfont&,idx%,idx2%,Kalender&,X&,wochenende%,zeile1$,zeile2$
Declare AnzahlSpalten%,BreiteAnfang%,BreiteEnde%,ZeileY%,MerkeX%,MerkeY%,Kalender&,spalte$,ende$,styleset$,st%
Declare Kal_Innen&,Kal_NoAct&,Kal_Text&,Kal_Title&,Kal_TitleText&,Background&,Frage&,butmann&,butfrau&,frageexit%
Declare lvu%,neux%
Def GSC(1) !USER32,GetSysColor
Def GetWindowRect(2) !USER32, GetWindowRect
WindowStyle 16
Frage&=CreateDialog(%hwnd,Frage,((%maxX/2)-127),((%maxY/2)-45),255,91)
CreateText(Frage&,Sind Sie männlich oder weiblich?,5,5,242,20)
butmann&=CreateButton(Frage&,männlich,5,30,92,25)
butfrau&=CreateButton(Frage&,weiblich,150,30,92,25)

WhileNot frageexit%

    GetMessage

    if GetFocus(butmann&)

        st%=1  Style 1
        frageexit%=1

    elseif GetFocus(butfrau&)

        st%=2  Style 2
        frageexit%=1

    endif

Wend

DestroyWindow(Frage&)
##### EINSTELLUNGEN #####
wochenende%=1        Mit Wochenende=1 | Kein Wochenende=0
Case st%=1:Background&=rgb(209,246,255)  Fensterhintergrund Style 1
Case st%=2:Background&=rgb(234,207,239)  Fensterhintergrund Style 2
##### Grafiken & Style #####

Proc Style

    Parameters getstyle%
    Case getstyle%=1:styleset$=\set1  Style 1
    Case getstyle%=2:styleset$=\set2  Style 2
    spalte$=$ProgDir+styleset$+\Spalte.bmp
    zeile1$=$ProgDir+styleset$+\zeile1.bmp
    zeile2$=$ProgDir+styleset$+\zeile2.bmp
    ende$=$ProgDir+styleset$+\endezeile.bmp
    Farben für den Kalender

    if getstyle%=1

        Kal_Innen&=rgb(255,255,210)     Innenfarbe
        Kal_NoAct&=rgb(125,125,125)     Farbe für nicht-aktuellen Monat
        Kal_Text&=rgb(0,0,0)            Textfarbe
        Kal_Title&=rgb(71,118,179)      Titelhintergrund
        Kal_TitleText&=rgb(255,255,255) Titeltext

    elseif getstyle%=2

        Kal_Innen&=rgb(255,255,210)
        Kal_NoAct&=rgb(125,125,125)
        Kal_Text&=rgb(0,0,0)
        Kal_Title&=rgb(154,17,108)
        Kal_TitleText&=rgb(255,255,255)

    endif

EndProc

Proc BMPXY

    ##### Automatische Grafikeinstellungen #####
    ##### Lade Garfiken und ermittel die Größe #####
    MLoadBmp zeile1$
    ZeileY%=%BmpY         Höhe einer Zeile (Nicht Anfangszeile)
    MLoadBmp spalte$
    BreiteAnfang%=%BmpX   Breite der ersten Grafik
    MLoadBmp ende$
    BreiteEnde%=%BmpX      Breite der letzten Grafik

EndProc

##### ListView.dll einbinden
lvdll&=usedll($ProgDir+Listview.dll)
 $I ListView_Funktionen.inc
Register(123456) Oder so ähnlich ;-)
lvfont&=Create(Font,Verdana,14,0,1,0,0)
##### ListView #####

Proc Liste

    Declare wechsel%,Uhrzeit%,Uhrzeit$,text$
    liste&=CreateListview(%hwnd,%hinstance,0,-1,-1,$400)
    EnableEdits(liste&,1)
    text$=011111
    SelectColumnEdits(liste&,addr(text$))
    InsertColumn liste&,,54,0
    InsertColumn liste&,Montag,150,0
    InsertColumn liste&,Dienstag,150,0
    InsertColumn liste&,Mittwoch,150,0
    InsertColumn liste&,Donnerstag,150,0
    InsertColumn liste&,Freitag,150,0
    Case Wochenende%=1:InsertColumn liste&,Samstag,150,0
    Case Wochenende%=1:InsertColumn liste&,Sonntag,150,0
    freelist&=SetLineHeight(liste&,ZeileY%-1)
    DestroyImageList(freelist&)
    wechsel%=2
    Uhrzeit%=0

    WhileLoop 48

        if wechsel%=2

            if Uhrzeit%<10

                Uhrzeit$=0+Str$(Uhrzeit%)+:00

            else

                Uhrzeit$=Str$(Uhrzeit%)+:00

            endif

            SetItem liste&,Uhrzeit$,
            wechsel%=1

        else

            SetItem liste&,,
            Inc wechsel%
            Inc Uhrzeit%

        endif

    EndWhile

    SetFont liste&,lvfont&
    ShowListview(liste&,10,10,width(%hwnd)-220,height(%hwnd)-50)
    InitMessages(%hwnd)
    AnzahlSpalten%=GetColumns(liste&)-1    Anzahl der normalen Zeilen ohne die Anfangszeile

EndProc

##### Erstellt die Hintergrundgrafik für das ListView mit Profan-Mitteln #####

Proc makegrf

    Parameters Lang%
    Declare zf&,StartZeichnenX%,StartZeichnenY%,multi%
    StartZeichnenX%=0
    StartZeichnenY%=0
    multi%=1
    windowStyle 80
    zf&=Create(Window,%hwnd,,0,0,%maxX,ZeileY%*3)
    #### Zeichnen
    StartPaint zf&
    LoadBmp spalte$,StartZeichnenX%,StartZeichnenY%;0
    LoadSizedBmp zeile1$,BreiteAnfang%+StartZeichnenX%,StartZeichnenY%-Lang%,ZeileY%;0
    LoadSizedBmp zeile2$,BreiteAnfang%+StartZeichnenX%,StartZeichnenY%+ZeileY%-Lang%,ZeileY%;0

    WhileNot multi%=AnzahlSpalten%

        loadbmp ende$,Lang%*multi%+BreiteAnfang%,StartZeichnenY%;0
        LoadSizedBmp zeile1$,Lang%*multi%+BreiteAnfang%+BreiteEnde%,StartZeichnenY%-Lang%,ZeileY%;0
        LoadSizedBmp zeile2$,Lang%*multi%+BreiteAnfang%+BreiteEnde%,StartZeichnenY%+ZeileY%-Lang%,ZeileY%;0
        inc multi%

    Wend

    loadbmp ende$,Lang%*multi%+BreiteAnfang%,StartZeichnenY%;0
    SaveBmp $TempDir+LVBACK.BMP,StartZeichnenX%,StartZeichnenY%-Lang%*multi%+BreiteAnfang%+25,ZeileY%*2  +20für evtl. Scrollbar
    endPaint
    DestroyWindow(zf&)
    text$=$TempDir+lvback.bmp
    SetBackImage(liste&,addr(text$),1)

endproc

Proc LVGroesse

    Declare LangLV%,Spaltenbreite%,idx%
    LangLV%=width(liste&)-5
    Spaltenbreite%=(LangLV%-BreiteAnfang%)/AnzahlSpalten%
    idx%=1

    WhileNot idx%=AnzahlSpalten%+1

        SetColumnWidth(liste&,idx%,Spaltenbreite%)
        Inc idx%

    Wend

    makegrf Spaltenbreite%

EndProc

Proc Kal

    Kalender&=Control(SysMonthCal32,,$54000004,width(liste&)+40,10,180,height(liste&),%hwnd,2000,%hinstance)
    SetFont Kalender&,lvfont&
    SendMessage(Kalender&,$100A,0,Background&)Hintergrund
    SendMessage(Kalender&,$100A,4,Kal_Innen&)
    SendMessage(Kalender&,$100A,5,Kal_NoAct&)
    SendMessage(Kalender&,$100A,1,Kal_Text&)
    SendMessage(Kalender&,$100A,2,Kal_Title&)
    SendMessage(Kalender&,$100A,3,Kal_TitleText&)

Endproc

Proc SetOptimalSize

    Parameters hmc&
    Declare h&,w&,mrect#,am%,hoch%
    Dim mrect#,16
    SendMessage(hmc&,$1009,0,mrect#)
    Let w&=Sub(Long(mrect#,8),Long(mrect#,0))
    Let h&=Sub(Long(mrect#,12),Long(mrect#,4))
    am%=height(%hwnd)/h&
    hoch%=(am%*h&)
    neux%=((Width(%hwnd)-10)-w&)
    SetWindowPos Kalender&=neux%,10-w&,hoch%;0
    Dispose mrect#

EndProc

##### Update ListView #####
lvu%=1

Proc Update

    Case Width(%hwnd)<790:SetWindowPos %hwnd=%WinLeft,%WinTop-800,%WinBottom-%WinTop;0
    Case Height(%hwnd)<570:SetWindowPos %hwnd=%WinLeft,%WinTop-%WinRight-%WinLeft,600;0
    MerkeX%=Width(%hwnd)
    MerkeY%=Height(%hwnd)
    SetOptimalSize Kalender&
    SetWindowPos liste&=10,10-neux%-20,height(%hwnd)-30;0 ***
    LVGroesse
    MerkeX%=Width(%hwnd)
    MerkeY%=Height(%hwnd)
    WindowTitle LV-Test - Anzahl LV-Updates:+Str$(lvu%)
    Inc lvu%

EndProc

*** = Da wartet jemand sehnsüchtig auf seine XPrf10
um die Thread.pcu von iF zu benutzen :-)
##### Hauptfenster #####

Proc Hauptfenster

    SetTrueColor 1
    WindowStyle $003F
    WindowTitle LV Test
    Window ((%maxX/2)-512),((%maxY/2)-384)-1024,768
    CLS Background&
    UseFont Verdana,13,0,1,0,0
    SetDialogFont 1

EndProc

##### Hauptprogramm #####
Hauptfenster
Case st%=1:Style 1
Case st%=2:Style 2
BMPXY
Liste
LVGroesse
Kal
Update
##### Hauptprogrammschleife #####
MerkeX%=Width(%hwnd)
MerkeY%=Height(%hwnd)

WhileNot exit%

    GetMessage
    Case %Umessage=16:exit%=1
    CaseNot MerkeX%=Width(%hwnd):Update
    CaseNot MerkeY%=Height(%hwnd):Update
    Case Width(%hwnd)<790:Update
    Case Height(%hwnd)<570:Update

Wend

DestroyWindow(liste&)
CloseMessages(%hwnd)
 $I ListView_Dispose.inc
freedll lvdll&

Declare hWin&, hButton&, Ende&, hDate&
hWin& = @Create(Dialog, %hWnd, Test, 100, 100, 200, 200)
hButton& = @Create(Button, hWin&, Ende, 10, 10, 180, 24)
hDate& = @Create(DateEdit, hWin&, , 10, 50, 100, 24)
Clear Ende&

WhileNot Ende&

    WaitInput

    If @GetFocus(hButton&)

        Ende& = 1

    EndIf

EndWhile

@MessageBox(@GetText$(hDate&), Datum, 0)
End