XProfan

 $P+
Set("ErrorLevel",0)
 $H WINDOWS.PH
 $H MESSAGES.PH
 $H STRUCTS.PH
 $H SHELLAPI.PH
 $H COMMCTRL.PH
 $I LOHNGRUPPEN4.INC

Proc OnApplicationExit

    DeleteObject hToolBmp&

EndProc

Proc OnApplicationInit

EndProc

OnApplicationInit
Def CalcLeft(1) (%MaxX - %(1)) / 2
Def CalcTop(1) (%MaxY - %(1)) / 2
Declare appexit%
Declare Button1&
Declare LG_DesignForm&
Declare LG_PageControl1_Sheet1&, LG_PageControl1_Sheet2&, LG_PageControl1_Sheet3&, LG_PageControl1_Sheet4&, LG_PageControl1_Sheet5&, LG_PageControl1_Sheet6&
Declare LG_PageControl1&
var TextFont1&        = Create("Font","MS Sans Serif",13,0,0,0,0)
var TooltipFont1&      = Create("FONT","MS Sans Serif",10,0,0,0,0)
Class TabControl = Handle&,            \
TabControl@,        \
GetHandel@,         \
InsertTab@,         \
CreateTabSheet@,    \
SetActiveSheet@,    \
GetActiveTab@,      \
SetActiveTab@,      \
TabChanged@,        \
TBFont@,            \
SetStyle@,          \
GetStyle@

Proc TabControl.TabControl

    Parameters ParentHandle&, x%, y%, dx%, dy%, hImagelist&, TooltipText$
    .Handle& = Create("TabCtrl", ParentHandle&, hImagelist&, x%, y%, dx%, dy%)
    var Tooltip& = Create("Tooltip",ParentHandle&,.Handle&,TooltipText$)
    SetFont Tooltip&,TooltipFont1&
    Return .Handle&

EndProc

Proc TabControl.GetHandel

    Return .Handle&

EndProc

Proc TabControl.InsertTab

    Parameters ColumnTab&, Reiter$,Icon&
    var Tab& = InsertTab(.Handle&,ColumnTab&,Reiter$,Icon&)
    Return Tab&

EndProc

Proc TabControl.CreateTabSheet

    Parameters x%, y%, dx%, dy%, Id&, Set%
    Declare TabSheet&
    TabSheet& = Control("DIALOG","",$54000000,x%,y%,dx%,dy%,.Handle&,Id&,%hinstance)
    ShowWindow(TabSheet&,Set%)
    EnableWindow TabSheet&,Set%
    Return TabSheet&

EndProc

Proc TabControl.SetActiveSheet

    Parameters TabSheets&, Set%
    EnableWindow TabSheets&,Set%
    ShowWindow(TabSheets&,Set%)
    SetFocus(.Handle&)

EndProc

Proc TabControl.GetActiveTab

    Declare ActiveTab&
    ActiveTab& = GetActiveTab(.Handle&)
    Return ActiveTab&

EndProc

Proc TabControl.SetActiveTab

    Parameters Set%
    SendMessage(.Handle&,~TCM_SETCURFOCUS,Set%,0)

EndProc

Proc TabControl.TabChanged

    Declare TabChanged&
    TabChanged& = TabChanged(.Handle&)
    Return TabChanged&

EndProc

Proc TabControl.TBFont

    Parameters Font&
    SendMessage(.Handle&,~WM_SETFONT,Font&,0)

EndProc

Proc TabControl.SetStyle

    Parameters SetStyle&
    Declare Style&
    Style& = ~SetWindowLong(.Handle&,~GWL_STYLE,Or(~GetWindowLong(.Handle&,~GWL_STYLE),SetStyle&))
    Return Style&

EndProc

Proc TabControl.GetStyle

    Declare Style&
    Style& = ~GetWindowLong(.Handle&,~GWL_STYLE)
    Return Style&

EndProc

Set("TrueColor",1)
WindowStyle $003F
WindowTitle "DesignForm"
Window %maxX + 5,114 - 498,415
Cls ~GetSysColor(15)
UseFont "MS Sans Serif",13,0,0,0,0
SetDialogFont 1
'SetFormIcon "",0
var hToolBmp& = Create("hPic", 0, "TOOLBAR")
var hImageList1& = Create("ImageList", 16, 16, hToolBmp&, rgb(192, 192, 192))
Button1&=Create("Button",%hwnd,"Button1",116,130,75,25)
SetWindowPos %hwnd = 207,114 - 498,415;0

WhileNot appexit%

    WaitInput

    If %key = 2

        appexit%=1

    ElseIf Clicked(Button1&)

        LG_DesignForm

    ElseIf %key = 4

        ' Fenstergröße

    ElseIf %key = 5

        ' Hilfe

    EndIf

4 href='./../../function-references/xprofan/endwhile/'>EndWhile

OnApplicationExit

Proc LG_DesignForm

    Declare LG_DesignForm&
    Declare dlgexit%
    Declare Button1&
    Set("TrueColor",1)
    LG_DesignForm&=Create("Dialog",%hwnd,"Arbeitskostenstammdaten",%maxX + 5,114,732,547)
    UseFont "MS Sans Serif",13,0,0,0,0
    SetDialogFont 1
    var LG_TBC1# = New (TabControl,LG_DesignForm&,0,110,722,362,hImageList1&,"Arbeitskostenstammdaten")
    LG_PageControl1& = LG_TBC1#.GetHandel()
    LG_TBC1#.TBFont(TextFont1&)
    LG_PageControl1_Sheet1& = LG_TBC1#.CreateTabSheet(4,25,714,333,2000,1)
    LG_TBC1#.InsertTab(1,"Grunddaten",9)
    LG_PageControl1_Sheet2& = LG_TBC1#.CreateTabSheet(4,25,714,333,2001,0)
    LG_TBC1#.InsertTab(2,"Lohnfortzahlungskosten",9)
    LG_PageControl1_Sheet3& = LG_TBC1#.CreateTabSheet(4,25,714,333,2002,0)
    LG_TBC1#.InsertTab(3,"Basiskosten",9)
    LG_PageControl1_Sheet4& = LG_TBC1#.CreateTabSheet(4,25,714,333,2003,0)
    LG_TBC1#.InsertTab(4,"Sozialversicherungskosten",9)
    LG_PageControl1_Sheet5& = LG_TBC1#.CreateTabSheet(4,25,714,333,2004,0)
    LG_TBC1#.InsertTab(5,"Ergebnis",9)
    LG_PageControl1_Sheet6& = LG_TBC1#.CreateTabSheet(4,25,714,333,2005,0)
    LG_TBC1#.InsertTab(6,"Kalender",9)
    Button1&=Create("Button",LG_DesignForm&,"Button2",8,8,75,25)
    SetWindowPos LG_DesignForm& = CalcLeft(732),CalcTop(547) - 732,547;0

    WhileNot dlgexit%

        WaitInput

        If %key = 2

            dlgexit%=1

        ElseIf Clicked(LG_PageControl1&)

            dlgexit%=1

        ElseIf Clicked(Button1&)

            dlgexit%=1

        ElseIf %key = 5

            ' Aiuto

        EndIf

    EndWhile

    DestroyWindow(LG_DesignForm&)
    Dispose LG_TBC1#

EndProc

Class objekt = objekt@

Proc objekt.objekt

    print "Test"

EndProc

cls
var nocrash&=Create("Button",%hwnd,"No Crash!",100,5,100,25)
var crash&=Create("Button",%hwnd,"Crash!",100,45,100,25)
declare b#

While 1

    WaitInput

    If Clicked(nocrash&)

        dim b#,objekt
        b#.objekt()
        Dispose b#

    ElseIf Clicked(crash&)

        b# = New(objekt)
        Dispose b#

    EndIf

EndWhile

end