XProfan

English

Dirk
Kuntzmann

Hello Profaner,
there in Profan The Possibility whom Calendar, How it with Dateedit aufklappt, immediate and constantly Show To let?

glad christmas (had to have) all

Greeting Dirk

12/26/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Rolf
Koch

Hi
meinste something like?
[web]https://XProfan.com/thread.core?t=5474&highlight=sysmonthcal32[/web]

12/26/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Dirk
Kuntzmann

Hello Rolf,
if You something mail becomes it sure functions, I Have no Prefellow to hand, so that the Test something last can.
nevertheless many Thanks first once for speedy response.

Greeting Dirk

12/26/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

too already here geschaut? [...]

12/26/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Rolf
Koch

or again something, I strain zusammengestellt have and plainer is:
Compile Mark Separation

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#

12/26/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Dietmar
Horn

Hello Dirk,

load you simply here from the Wettbewerbsbereich our MMJ-Quellcodesammlung down. there find You, the of Rolf named example and in the Unterordner system any possible from the far over 1000 Demoquellcodes required Include- and other Files, so The Demos immediate run are (The each suitable Profan²- or. XProfan-Version naturally presupposed).

If you in the Suchfunktion the Quellcodesammlung whom concept Calendar eingibst, then find You further Examples moreover, The You yourself adjust can.

Marc-Gordon Kröhn having this year time a complete Terminverwaltung published (these is u.a. in the XProfan-manager include: courses -> demonstration-programs):

for the complete Program becomes of course The ListView.dll of Frank Abbing needed, but the Kalenderteil functions too without these DLL. there can You you useful everything adjust, what your marrow begehrt, because the code is very well documents.
Compile Mark Separation

(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&)
Clo

ages(%hwnd) $I ListView_Dispose.inc freedll lvdll&

Greeting
Dietmar

Multimedia für Jugendliche und junge Erwachsene - MMJ Hoyerswerda e.V. [...]

Windows 95 bis Windows 7
Profan² 6.6 bis XProfan X2 mit XPSE

Das große XProfan-Lehrbuch: [...]

12/26/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Dirk
Kuntzmann

Hi,
many Thanks for eure trouble. the short Example of Rolf is really everything, I z. Z. sought have. I have me of course in the meantime again Prfellow installs, but Rolf small Program mach Yes really the same.
Perhaps would the Yes something for a new Profan-Version, as expansion the Date$-function and where then the angeklickte date with gettext$ same read go can.

Greeting Dirk

12/26/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Michael
Wodrich

ex XProfan 8.0 is this wish erfüllt:

(the example from the Helpfile)
Compile Mark Separation

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

Best wishes
Michael Wodrich

Programmieren, das spannendste Detektivspiel der Welt.

12/26/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Dirk
Kuntzmann

Hello Michael,
this is Yes the normal dateedit, where the Calendar first aufklappt, if the Button pressed becomes. The wish is Yes, that the Calendar always displayed and is read go can, without that first one Button betätigt go must. See kurzes Example of Rolf.

Greeting Dirk

12/27/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Michael
Wodrich

Yes, there Have I well slept.... (standing integrally explicit in Your first Posting).

there should Roland then one Set(DateEdit, 0|1 ) building. and with the opportunity too The SetDate- and SetTime-functions nachrüsten.
yet does it indeed only with a ploy.

alas Yes, and with the opportunity then too Set TimeFormat and SetDateFormat for Formatstrings with install.

Best wishes
Michael Wodrich

Programmieren, das spannendste Detektivspiel der Welt.

12/27/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

RGH

Michael Wodrich

and with the opportunity too The SetDate- and SetTime-functions nachrüsten.

ex the next Version is commands SetText properly extended, so that for both Controls TimeEdit and DateEdit with SetText The Time beziehungsweise the date tuned go can.

Greeting
Roland

Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

12/27/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote