SysMonthCal32

[GT43A]

Hallo Andreas,

jetzt ist alles sichtbar.
Die abfrage geht natürlich nur auf dem %Hwnd, wenn man es weiß ist das Ok.

Und danke für deinen Beitrag, den hab ich schon in meiner Vorlagen Sammlung aufgenommen!
MfG

[Andreas Miethe]

Zitat von GT43A

Hallo Andreas,

jetzt ist alles sichtbar.
Die abfrage geht natürlich nur auf dem %Hwnd, wenn man es weiß ist das Ok.

Und danke für deinen Beitrag, den hab ich schon in meiner Vorlagen Sammlung aufgenommen!
MfG

Geht doch auch in einem anderen Fenster !!

$H Windows.ph
$H Messages.ph

Declare Ende%

Subclassproc
If SubClassMessage(Kalender& , 15)'Tag angeklickt
  SetMenuItem 15000
  Set("WinProc",1)
EndIf
EndProc

Proc Kal_GetDate
  Declare Datum#
  Dim Datum#,20
  SendMessage(Kalender&,4097,0,Datum#)
  Var Zurück$ = format$("00",word(Datum#,6))+"."+format$("00",word(Datum#,2))+"."+format$("0000",word(Datum#,0))
  Dispose Datum#
  Return Zurück$
EndProc

Proc Kal_SetDate
  PARAMETERS Kalender&,Datum$
  Declare DATA#
  Dim DATA#,20
  Word DATA#,0 = Val(substr$(datum$,3,"."))' Jahr
  Word DATA#,2 = Val(substr$(datum$,2,"."))' Monat
  Word DATA#,6 = Val(substr$(datum$,1,"."))' Tag
  SendMessage(Kalender&,$1002,0,DATA#)
  Dispose DATA#
EndProc

Proc Kal_SetBKColor
  Parameters Kalender&,Color&
  SendMessage(Kalender&, 4106, 0, Color&)
Endproc

Proc Kal_SetDayColor
  Parameters Kalender&,Color&
  SendMessage(Kalender&, 4106, 1, Color&)
Endproc

Proc Kal_SetHeaderColor
  Parameters Kalender&,Color&
  SendMessage(Kalender&, 4106, 2, Color&)
Endproc

Proc Kal_SetFontColor
  Parameters Kalender&,Color&
  SendMessage(Kalender&, 4106, 3, Color&)
Endproc

Proc Kal_SetMonthBk
  Parameters Kalender&,Color&
  SendMessage(Kalender&, 4106, 4, Color&)
Endproc


WINDOW 800,600
Var DLG& = Create("Window",%Hwnd,"",0,0,300,300)

Var Kalender&=Control("SysMonthCal32","Kalender",$5000000C,10,10,width(dlg&),height(dlg&),DLG&,5000,%hinstance,0)

'Theme für den Kalender abschalten
Var Level& = Set("ErrorLevel", -1)
ImportDll("UxTheme.dll","")
SetWindowTheme(Kalender&,"","")
Set("ErrorLevel",Level&)

SubClass Kalender&,1

Kal_SetDate(Kalender&,"1.6.2024")
Kal_SetBKColor(Kalender&,$FFFFFF)
Kal_SetDayColor(Kalender&, $058800)
Kal_SetHeaderColor(Kalender&, $0080FF)
Kal_SetMonthBk(Kalender&, $C6FFFF)

Useicon "A"
WhileNot Ende%
  WaitInput
  If %Key = 2
    Ende% = 1
  ElseIf @MenuItem(15000)
    Locate 0,0
    Print  Kal_GetDate()
  EndIf
EndWhile
SubClass Kalender&,0
End

[GT43A]

Sorry,

ja mei bin ich... das %Hwnd war überdeckt.