XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Monatskalender
 $P+
SetErrorLevel 0
set(FastMode,1)
SetTrueColor 1
Header-Dateien
 $H windows.ph
 $H structs.ph
 $H messages.ph
 $H commctrl.ph
 $H shellapi.ph
 $I C:PRFellowLIBWFICCREG.INC
Position von WFFORMS7.INC nicht verändern!
 $I C:PRFellowLIBWFFORMS7.INC
 $I C:PRFellowLIBWFEVENTS.INC
 $I C:PRFellowLIBWFMCAL.INC
 $I WFICCREG.INC
 $I WFFORMS7.INC
 $I WFEVENTS.INC
 $I WFMCAL.INC
Def GetActiveWin(0) !USER32,GetActiveWindow
Def MoveWindow(6) !USER32,MoveWindow
def SetwindowText(2) !USER32,SetWindowTextA
Def @ChooseColor(1) !COMDLG32.DLL, ChooseColorA
declare rc#,rc2#
struct RECT = Left&,Top&,Right&,Bottom&
Dim rc#,RECT
dim rc2#,rect

Proc ChooseColorProc

    Parameters hwd&,uMsg&,wParam&,lParam&
    declare hwndctl&,scrWidth&,scrHeight&,dlgWidth&,dlgHeight&,Kalhndle&

    if uMsg& = ~WM_INITDIALOG

        Kalhndle&=findwindow(Monatskalender)
        ~GetWindowRect(Kalhndle&,rc2#)
        ~GetWindowRect(hwd&,rc#)
        scrWidth& = rc2#.Right& - rc2#.Left&
        scrHeight& = rc2#.Bottom& - rc2#.Top&
        dlgWidth& = rc#.Right& - rc#.Left&
        dlgHeight& = rc#.Bottom& - rc#.Top&
        MoveWindow(hwd&,rc2#.Right&,rc2#.Top&, dlgWidth&, dlgHeight&, 1)
        SetWindowText(hwd&, Bitte Farbe wählen :)
        Return 1

    endif

Endproc

Proc color_choose

    -StructuresDefinition------------------------------------------------
    Declare CHOOSECOLOR#,c_handle&
    SetWindowPos %hwnd = 295,296 - 329,282;0
    Struct TCHOOSECOLOR = lStructSize&, hwndOwner&, hInstance&,
    rgbResult&, lpCustColors&, Flags&, lCustData&, lpfnHook&,
    lpTemplateName&
    Dim CHOOSECOLOR#, TCHOOSECOLOR
    -ConstantsDefinition-------------------------------------------------
    Def &CC_ANYCOLOR $100
    Def &CC_ENABLEHOOK $10
    Def &CC_ENABLETEMPLATE $20
    Def &CC_ENABLETEMPLATEHANDLE $40
    Def &CC_FULLOPEN $2
    Def &CC_PREVENTFULLOPEN $4
    Def &CC_RGBINIT $1
    Def &CC_SHOWHELP $8
    Def &CC_SOLIDCOLOR $80
    -VariablesDefinition-------------------------------------------------
    Declare UDC&[15]
    Declare Res$,Rot$,Grün$,Blau$,bg&
    -Main----------------------------------------------------------------
    -Define UserColors-------------------------------------------------
    UDC&[0] = @RGB(255, 127, 255)
    UDC&[1] = @RGB(255, 127, 127)
    UDC&[2] = @RGB(127, 127, 127)
    -------------------------------------------------------------------

    With CHOOSECOLOR#

        .lStructSize& = @SizeOf(CHOOSECOLOR#)
        .hwndOwner& = 0
        .hInstance& = 0
        .rgbResult& = @RGB(255, 0, 0)
        .lpCustColors& = @Addr(UDC&[0])
        .Flags& =  &CC_ANYCOLOR | &CC_RGBINIT | &CC_ENABLEHOOK
        .lCustData& = 0
        .lpfnHook& = procAddr(ChooseColorProc,4)
        .lpTemplateName& = 0

    EndWith

    If @ChooseColor(CHOOSECOLOR#)

        bg&=CHOOSECOLOR#.rgbResult&
        return bg&

    EndIf

    Dispose CHOOSECOLOR#
    -End-------------------------------------------------------------------
    End
    dispose rc#
    dispose rc2#

endproc

*** GlobalStatements der Form-Controls

Proc OnApplicationExit

EndProc

Proc OnApplicationInit

EndProc

OnApplicationInit
Declare appexit%
Declare MonthCal1&
Declare backc&
Declare textc&
Declare titelback&
Declare titletextc&
Declare calcolc&,c_handle&
Declare nonaktc&
Declare RadioButton8&
Declare RadioButton9&
Declare RadioButton10&
Declare RadioButton11&
declare bg&,txt&,titlebg&,titletext&,calcol&,month&
declare standardfarben&,Userfarben&

Proc RadioButton8_OnClick

    showweeknumbers(monthcal1&)

EndProc

Proc RadioButton9_OnClick

    hideweeknumbers(monthcal1&)

EndProc

SetTrueColor 1
WindowStyle $003F
WindowStyle 40
WindowTitle Monatskalender
Window Add(%maxX,5),86 - 329,282
Cls GetSysColor(15)
UseFont MS Sans Serif,13,0,0,0,0
SetDialogFont 1
SetFormIcon ,0
Let MonthCal1&=Control(SysMonthCal32,,$54000004,10,20,193,155,%hwnd,2000,%hinstance)
Let backc&=CreateRadioButton(%hwnd,bg&,250,30,113,17)
Let textc&=CreateRadioButton(%hwnd,txt&,250,50,113,17)
Let titelback&=CreateRadioButton(%hwnd,titelback&,250,70,113,17)
Let titletextc&=CreateRadioButton(%hwnd,titletext&,250,90,113,17)
Let calcolc&=CreateRadioButton(%hwnd,calcol&,250,110,113,17)
Let nonaktc&=CreateRadioButton(%hwnd,month&,250,130,113,17)
Let RadioButton8&=CreateRadioButton(%hwnd,Show_weeks,30,190,113,17)
Let RadioButton9&=CreateRadioButton(%hwnd,Hide_weeks,30,210,113,17)
Let Standardfarben&=CreateRadioButton(%hwnd,Standardfarben,160,190,113,17)
Let Userfarben&=CreateRadioButton(%hwnd,Userfarben,160,210,113,17)
SetWindowPos %hwnd = 135,296 - 329,282;0
bg&= rgb(255,255,255)
txt&=rgb(0,0,0)
titlebg&= rgb(0,0,241)
titletext&= rgb(255,255,255)
calcol&= rgb(255,255,255)
month&= rgb(192,192,192)
setmccolors(monthcal1&,bg&,txt&,titlebg&,titletext&,calcol&,month&)

WhileNot appexit%

    WaitInput
    WMNotifyHandler

    If Equ(%key,2)

        Let appexit%=1

    ElseIf BN_CLICKED(backc&)

        color_choose
        bg&=@&(0)
        setmccolors(monthcal1&,bg&,txt&,titlebg&,titletext&,calcol&,month&)

    ElseIf BN_CLICKED(textc&)

        color_choose
        txt&=@&(0)
        setmccolors(monthcal1&,bg&,txt&,titlebg&,titletext&,calcol&,month&)

    ElseIf BN_CLICKED(titelback&)

        color_choose
        titlebg&=@&(0)
        setmccolors(monthcal1&,bg&,txt&,titlebg&,titletext&,calcol&,month&)

    ElseIf BN_CLICKED(titletextc&)

        color_choose
        titletext&=@&(0)
        setmccolors(monthcal1&,bg&,txt&,titlebg&,titletext&,calcol&,month&)

    ElseIf BN_CLICKED(calcolc&)

        color_choose
        calcol&=@&(0)
        setmccolors(monthcal1&,bg&,txt&,titlebg&,titletext&,calcol&,month&)

    ElseIf BN_CLICKED(nonaktc&)

        color_choose
        month&=@&(0)
        setmccolors(monthcal1&,bg&,txt&,titlebg&,titletext&,calcol&,month&)

    ElseIf BN_CLICKED(RadioButton8&)

        RadioButton8_OnClick

    ElseIf BN_CLICKED(RadioButton9&)

        RadioButton9_OnClick

    ElseIf GetFocus(standardfarben&)

        bg&= rgb(255,255,255)
        txt&=rgb(0,0,0)
        titlebg&= rgb(0,0,241)
        titletext&= rgb(255,255,255)
        calcol&= rgb(255,255,255)
        month&= rgb(192,192,192)
        setmccolors(monthcal1&,bg&,txt&,titlebg&,titletext&,calcol&,month&)

    ElseIf GetFocus(userfarben&)

        bg&=rgb(192,192,192)		   Controlhintergrund        (Standard : rgb(255,255,255)
        txt&=rgb(236,114,43)		   Textfarbe                 (Standard : rgb(0,0,0)
        titlebg&=RGB(192,192,192)	   Titelhintergrundfarbe     (Standard : rgb(0,0,241)
        titletext&=RGB(0,128,0)	           Titel  Monatsname         (Standard : rgb(255,255,255)
        calcol&=RGB(255,255,255)           Hintergrund Monatsblatt   (Standard : rgb(255,255,255)
        month&=RGB(0,0,255)                Aktuelle Wochen	      (Standard : rgb(192,192,192)
        setmccolors(monthcal1&,bg&,txt&,titlebg&,titletext&,calcol&,month&)

    ElseIf Equ(%key,4)

        Fenstergröße

    ElseIf Equ(%key,5)

        Aiuto

    EndIf

Wend

OnApplicationExit