Quelltexte/ Codesnippets | | | | - Seite 1 - |
| | Horizontaler Splitter mit Xprofan von Andreas Miethe: KompilierenMarkierenSeparieren#############################
XProfan
#############################
Author : Andreas Miethe
2003
#############################
Thema : Horizontal-Splitter
#############################
SetTrueColor 1
set("FastMode",1)
------------------------
Header-Dateien einbinden
------------------------
$H windows.ph
$H structs.ph
$H messages.ph
------------------------
------------------------
Definitionen
------------------------
DEF HiWord(1) And(&(1)>>16,$FFFF)
DEF LoWord(1) And(&(1),$FFFF)
DEF MakeLong(2) Or(&(1),&(2)<<16)
------------------------
------------------------
Strukturen
------------------------
STRUCT MyWindowClass = ~WndClass
STRUCT MyMsg = ~Msg
STRUCT rect = ~RECT
------------------------
Declare hCursor&,Classname$,WindowTitle$,WindowIcon$
Declare WindowClass#, Msg#, Size#
PROC WindowProc
parameters Wnd&, Msg&, wParam&, lParam&
IF Msg& = ~WM_SIZE
IF HIWORD(lParam&) < dwSplitterPos&
dwSplitterPos& = HIWORD(lParam&)-10
Endif
~MoveWindow(Edit1&, 0, 0, LOWORD(lParam&), dwSplitterPos& , 1)
~MoveWindow(Edit2&, 0, dwSplitterPos&+4, LOWORD(lParam&),HIWORD(lParam&) - dwSplitterPos& -4, 1)
Endif
IF Msg& = ~WM_MOUSEMOVE
Declare rect#
DIM rect#,rect
IF HIWORD(lParam&) > 40
~SetCursor(hCursor&)
IF wParam& = ~MK_LBUTTON
~GetClientRect(Wnd&, rect#)
IF (HIWORD(lParam&) > rect#.bottom& -40)
RETURN 0
ENDIF
dwSplitterPos& = HIWORD(lParam&)
~SendMessage(Wnd&,~WM_SIZE, 0, MAKELONG(rect#.right&, rect#.bottom&))
~UpdateWindow(Edit1&)
~UpdateWindow(Edit2&)
ENDIF
ENDIF
DISPOSE Rect#
ENDIF
IF Msg& = ~WM_LBUTTONDOWN
~SetCursor(hCursor&)
bSplitterMoving& = 1
~SetCapture(Wnd&)
Endif
IF Msg& = ~WM_LBUTTONUP
~ReleaseCapture()
bSplitterMoving& = 0
Endif
IF Msg& = ~WM_CLOSE
~DeleteObject(hCursor&)
Messagebox("und Tschüss !","Ende",64)
~PostQuitMessage(0)
endif
RETURN ~DefWindowProc(Wnd&, Msg&, wParam&, lParam&)
endproc
PROC Main
Declare Ende&,Edit1&,Edit2&,bSplitterMoving&,dwSplitterPos&,Window&
DIM WindowClass#,MyWindowClass
DIM Msg#,MyMsg
Classname$ = "XPrfWndClass"
WindowTitle$ = "H-Splitter"
WindowIcon$ = "A"
WITH WindowClass#
.style& = 0
.lpfnWndProc& = ProcAddr(WindowProc,4)
.cbClsExtra& = 0
.cbWndExtra& = 0
.hInstance& = %HInstance
.hIcon& = ~LoadIcon(%hInstance,Addr(WindowIcon$))
.hCursor& = ~LoadCursor(0, ~IDC_ARROW)
.hbrBackground& = ~CreateSolidBrush(~GetSysColor(~COLOR_BTNFACE))
.lpszMenuName& = Addr(Classname$)
.lpszClassName& = Addr(Classname$)
EndWith
IF ~RegisterClass(WindowClass#) = 0
MessageBox("Fehler beim Registrieren der Anwendung !","Fehler...",16)
End
Endif
Window& = ~CreateWindowEx(
0,
Addr(Classname$),
Addr(WindowTitle$),
~ws_OverlappedWindow,
~cw_UseDefault,
~cw_UseDefault,
640,
480,
0,
0,
%HInstance,
0)
Edit1& = ~CreateWindowEx(~WS_EX_CLIENTEDGE,"edit", 0,OR(OR(OR(OR(~WS_CHILD,~WS_VISIBLE),~WS_CLIPSIBLINGS),~ES_MULTILINE),~WS_VSCROLL),0, 0, width(window&), Height(window&)/2, window&, 1001,%hInstance,0)
Edit2& = ~CreateWindowEx(~WS_EX_CLIENTEDGE,"edit", 0,OR(OR(OR(OR(~WS_CHILD,~WS_VISIBLE),~WS_CLIPSIBLINGS),~ES_MULTILINE),~WS_VSCROLL),0, Height(Edit1&)+6, width(window&), Height(window&)/2, window&, 1002,%hInstance,0)
ClearList
AddFiles "C:\*.*"
MoveListToEdit(Edit1&)
MoveListToEdit(Edit2&)
hCursor& = ~LoadCursor(0,~IDC_SIZENS)
bSplitterMoving& = 0
dwSplitterPos& = (Height(window&)/2) + 4
~ShowWindow(Window&, ~SW_SHOWNORMAL)
~UpdateWindow(Window&)
WHILE ~GetMessage(Msg#, 0, 0, 0) > 0
~TranslateMessage(Msg#)
~DispatchMessage(Msg#)
Endwhile
EndProc
Main
Salve, iF |
| | | | |
| | « Dieser Beitrag wurde als Lösung gekennzeichnet. » | | Jörg Sellmeyer | und repariert...
$I profalt.inc
'#############################
'XProfan
'#############################
'Author : Andreas Miethe
'2003
'#############################
'Thema : Horizontal-Splitter
'#############################
'SetTrueColor 1
set("FastMode",1)
'------------------------
'Header-Dateien einbinden
'------------------------
$H windows.ph
$H structs.ph
$H messages.ph
'------------------------
'------------------------
'Definitionen
'------------------------
DEF HiWord(1) And(&(1)>>16,$FFFF)
DEF LoWord(1) And(&(1),$FFFF)
DEF MakeLong(2) Or(&(1),&(2)<<16)
'------------------------
'------------------------
'Strukturen
'------------------------
STRUCT MyWindowClass = ~WndClass
STRUCT MyMsg = ~Msg
STRUCT rect = ~RECT
'------------------------
Declare hCursor&,Classname$,WindowTitle$,WindowIcon$
Declare WindowClass#, Msg#, Size#
PROC WindowProc
parameters Wnd&, Msg&, wParam&, lParam&
IF Msg& = ~WM_SIZE
IF HIWORD(lParam&) < dwSplitterPos&
dwSplitterPos& = HIWORD(lParam&)-10
Endif
~MoveWindow(Edit1&, 0, 0, LOWORD(lParam&), dwSplitterPos& , 1)
~MoveWindow(Edit2&, 0, dwSplitterPos&+4, LOWORD(lParam&),HIWORD(lParam&) - dwSplitterPos& -4, 1)
Endif
IF Msg& = ~WM_MOUSEMOVE
Declare rect#
DIM rect#,rect
IF HIWORD(lParam&) > 40
~SetCursor(hCursor&)
IF wParam& = ~MK_LBUTTON
~GetClientRect(Wnd&, rect#)
IF (HIWORD(lParam&) > rect#.bottom& -40)
RETURN 0
ENDIF
dwSplitterPos& = HIWORD(lParam&)
~SendMessage(Wnd&,~WM_SIZE, 0, MAKELONG(rect#.right&, rect#.bottom&))
~UpdateWindow(Edit1&)
~UpdateWindow(Edit2&)
ENDIF
ENDIF
DISPOSE Rect#
ENDIF
IF Msg& = ~WM_LBUTTONDOWN
~SetCursor(hCursor&)
bSplitterMoving& = 1
~SetCapture(Wnd&)
Endif
IF Msg& = ~WM_LBUTTONUP
~ReleaseCapture()
bSplitterMoving& = 0
Endif
IF Msg& = ~WM_CLOSE
~DeleteObject(hCursor&)
Messagebox("und Tschüss !","Ende",64)
~PostQuitMessage(0)
endif
RETURN ~DefWindowProc(Wnd&, Msg&, wParam&, lParam&)
endproc
PROC Main
Declare Ende&,Edit1&,Edit2&,bSplitterMoving&,dwSplitterPos&,Window&
DIM WindowClass#,MyWindowClass
DIM Msg#,MyMsg
Classname$ = "XPrfWndClass"
WindowTitle$ = "H-Splitter"
WindowIcon$ = "A"
WITH WindowClass#
.style& = 0
.lpfnWndProc& = ProcAddr(WindowProc,4)
.cbClsExtra& = 0
.cbWndExtra& = 0
.hInstance& = %HInstance
.hIcon& = ~LoadIcon(%hInstance,Addr(WindowIcon$))
.hCursor& = ~LoadCursor(0, ~IDC_ARROW)
.hbrBackground& = ~CreateSolidBrush(~GetSysColor(~COLOR_BTNFACE))
.lpszMenuName& = Addr(Classname$)
.lpszClassName& = Addr(Classname$)
EndWith
IF ~RegisterClass(WindowClass#) = 0
MessageBox("Fehler beim Registrieren der Anwendung !","Fehler...",16)
End
Endif
Window& = ~CreateWindowEx(\
0,\
Addr(Classname$),\
Addr(WindowTitle$),\
~ws_OverlappedWindow,\
~cw_UseDefault,\
~cw_UseDefault,\
640,\
480,\
0,\
0,\
%HInstance,\
0)
Edit1& = ~CreateWindowEx(~WS_EX_CLIENTEDGE,"edit", 0,OR(OR(OR(OR(~WS_CHILD,~WS_VISIBLE),~WS_CLIPSIBLINGS),~ES_MULTILINE),~WS_VSCROLL),0, 0, width(window&), Height(window&)/2, window&, 1001,%hInstance,0)
Edit2& = ~CreateWindowEx(~WS_EX_CLIENTEDGE,"edit", 0,OR(OR(OR(OR(~WS_CHILD,~WS_VISIBLE),~WS_CLIPSIBLINGS),~ES_MULTILINE),~WS_VSCROLL),0, Height(Edit1&)+6, width(window&), Height(window&)/2, window&, 1002,%hInstance,0)
ClearList
AddFiles "C:\*.*"
MoveListToEdit(Edit1&)
MoveListToEdit(Edit2&)
hCursor& = ~LoadCursor(0,~IDC_SIZENS)
bSplitterMoving& = 0
dwSplitterPos& = (Height(window&)/2) + 4
~ShowWindow(Window&, ~SW_SHOWNORMAL)
~UpdateWindow(Window&)
WHILE ~GetMessage(Msg#, 0, 0, 0) > 0
~TranslateMessage(Msg#)
~DispatchMessage(Msg#)
Endwhile
EndProc
Main
|
| | | | | |
| | p.specht
| Ich wollte im obigen Programm die veraltete Schreibweise Edit1& = OR(~WS_CHILD,~WS_VISIBLE) mit anschließendem MoveListToEdit, was noch zulässig ist und gut funktioniert, solange man die PROFALT.INC einbindet, ... ... auf XProfan-11-Schreibweise ändern: (~WS_CHILD OR ~WS_VISIBLE) und nachfolgendes MoveListToHandle.
Allein, dies führt zur Fehlermeldung "Funktion nicht auf dieses Fensterobjekt anwendbar!" - Wieso bitte? |
| | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 11.12.2018 ▲ |
| |
| | Matthias Arlt | Ersetze auch das OR selbst und schreib es besser so: ... (~WS_CHILD | ~WS_VISIBLE) ...
Gruß Matthias |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 11.12.2018 ▲ |
| |
| | p.specht
| AHHHHHHHHHHHHHHHHHHHHHHHH !!! DANKE ! Manchmal ist man wie vernagelt ...
|
| | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 11.12.2018 ▲ |
| |
|
Zum QuelltextThemenoptionen | 5.649 Betrachtungen |
ThemeninformationenDieses Thema hat 4 Teilnehmer: |