XProfan

'Größenänderung von Steuerelementen in Echtzeit
 $I PROFALT.INC'Include-File per Quellcodes früher Profan-Versionen (vor XProfan 11.0), die noch keine Operatoren nutzen.
'Bei Verwendung von  XProfan < 11.0 kann die obige Include-Zeile "$I PROFALT.INC" bedenkenlos gelöscht werden.
'Im folgenden Beispiel wird die Größenänderung eines Steuerelementes,
' in diesem Fall ein Button, in Echtzeit demonstriert. Mit Veränderung der Dimensione des Fensters
' verändert sich auch die Dimensione des Buttons.
'-Begin-----------------------------------------------------------------
'-HeaderFiles---------------------------------------------------------
 $H Windows.ph
 $H Messages.ph
'-Variables Declaration-----------------------------------------------
Declare Ende%, OldWndProc&, hButton%
'-CallBack Routine----------------------------------------------------

Proc ChangeControl

    Parameters hWnd&, Message&, wParam&, lParam&
    Declare btnHeight&

    If Message& = ~WM_SIZE

        '-Abfrage, damit Button nicht kleiner 16 Pixel Hoehe------------

        If @Height(%hWnd) / 5 < 16

            btnHeight& = 16

        Else

            btnHeight& = @Height(%hWnd) / 5

        EndIf

        '-Groesse des Buttons aendern-----------------------------------
        SetWindowPos hButton%, 10, 34 - @Width(%hWnd) - 20, btnHeight&

    EndIf

    Return ~CallWindowProc(OldWndProc&, hWnd&, Message&, \
    wParam&, lParam&)

EndProc

'-Main----------------------------------------------------------------
'-Erweitertes MessageHandling abschalten----------------------------
Set("FastMode", 1)
'-Fenster oeffnen und GUI aufbauen----------------------------------
Window 0, 0 - 640, 480
WindowTitle "Größenänderung von Steuerelementen in Echtzeit"
'-Hintergrundfarbe des Fensters setzten---------------------------
Declare Color&, Red%, Green%, Blue%
Color& = ~GetSysColor(~COLOR_3DFACE)
Red% = @GetRValue(Color&)
Green% = @GetGValue(Color&)
Blue% = @GetBValue(Color&)
Cls @RGB(Red%, Green%, Blue%)
'-----------------------------------------------------------------
@Create("Text", %hWnd, "Ändere die Dimensione dieses Fensters", 10, \
10, 250, 20)
hButton% = @Create("Button", %hWnd, "Ende", 10, 34, \
@Width(%hWnd) - 20, @Height(%hWnd) / 5)
'-ProgramMainRoutine mit CallBack umleiten auf eigene---------------
OldWndProc& = ~GetWindowLong(%hWnd, ~GWL_WNDPROC)
~SetWindowLong(%hWnd, ~GWL_WNDPROC, @ProcAddr("ChangeControl", 4))
'-Dialog-Schleife---------------------------------------------------
Clear Ende%

WhileNot Ende%

    WaitInput

    If %Key = 2

        Ende% = 1

    ElseIf @Clicked(hButton%)

        Ende% = 1

    EndIf

EndWhile

'-Urspruengliche ProgramMainRoutine wieder herstellen---------------
~SetWindowLong(%hWnd, ~GWL_WNDPROC, OldWndProc&)
'-End-------------------------------------------------------------------
End

 $H Windows.ph
cls
var RtfDll&=usedll("riched32.dll")
var Edit&=control("RichEdit20A","",$500050c4,50,50,100,28,%hwnd,5000,0)
~SetWindowLong(Edit&,~GWL_EXSTYLE,0)
settext Edit&,"Text eingeben"
SetStyle Edit&,GetStyle(Edit&) | ~ws_thickFrame

while 0=0

    waitinput

EndWhile

destroywindow(Edit&)
freedll rtfDll&

 $H Windows.ph
Declare listview&,lvdll&,text$,bytes&,bereich#,x&,y&,z&
Def GetSysColor(1) !"USER32","GetSysColor"
 $I Listview_Funktionen.inc
lvdll&=usedll("Listview.dll")
SetTrueColor 1
Windowstyle 543
Windowtitle "Listview.dll Dimensione ändern..."
Window 0,0-800,600
Cls GetSysColor(15)
Usefont "MS Sans Serif",13,0,0,0,0
SetDialogFont 1
x&=MixRGBs(GetSysColor(15),$00ffffffff)
listview&=CreateListView(%hwnd,%hinstance,0,x&,-1,$11)
SetStyle listview&,GetStyle(listview&) | ~ws_thickFrame
EnableEdits(listview&,1)
InsertColumn listview&,"Name",80,0
InsertColumn listview&,"Index",80,1
InsertColumn listview&,"Bewertung",96,2
InsertColumn listview&,"Kommentar",308,0
SetItem listview&,"A",1,"befriedigend","Sieht ganz anständig aus"
SetItem listview&,"DOS",2,"gut","Klar verständlich"
SetItem listview&,"Eimer",3,"ungenügend","Nicht mal Mülltonnen-Oskar würde dort reinkriechen"
SetItem listview&,"Gesicht",4,"ungenügend","Komisches Gesicht"
SetItem listview&,"Müll",5,"mangelhaft","Nicht erkennbar"
AutoSortListview listview&,0,1,2,1,1
SortManual(listview&,2,0)
ShowListView(listview&,8,76,452,280)
InitMessages(%hwnd)

While 1

    waitinput
    Case %key=2:BREAK

Wend

DestroyWindow(listview&)
CloseMessages(%hwnd)
freedll lvdll&
 $I Listview_Dispose.inc
End

 $H Windows.ph
Def GetSysColor(1) !"USER32","GetSysColor"
cls GetSysColor(15)
Usefont "MS Sans Serif",13,0,0,0,0
SetDialogFont 1
var Edit&= Control("EDIT","",$54010000,150,50,140,22,%hwnd,0,%hinstance, $00000001)
~SetWindowLong(Edit&,~GWL_EXSTYLE,0)
settext Edit&,"Text eingeben"
SetStyle Edit&,GetStyle(Edit&) | ~ws_thickFrame

while 0=0

    waitinput
    SetWindowPos edit&=150,50-Width(edit&),22;0

EndWhile

destroywindow(Edit&)