Zeiger auf Structure/Interface in DWL_USER der Dialogbox

Windowsspezifisches Forum , API ,..
Beiträge, die plattformübergreifend sind, gehören ins 'Allgemein'-Forum.
Benutzeravatar
FS-1281
Beiträge: 8
Registriert: 13.05.2015 15:44

Zeiger auf Structure/Interface in DWL_USER der Dialogbox

Beitrag von FS-1281 »

Hallo,

ich möchte gerne den Zeiger auf eine Struktur in der Callback-Funktion einer
Dialogbox während der initialisierung im Benutzerspeicher ablegen!

Die Struktur enthält unter anderem einen Zeiger auf eine Funktionstabelle, sowie einen String.
Der Zeiger auf die Struktur wird über den lParam an die Callback-Funktion wie folgt übergeben

Code: Alles auswählen

CreateDialogParam_(hInstance, *This\szTemplateName, *This\pParentWnd, @DialogProc(), *This);
Ich speicher den Zeiger dann während #WM_INITDIALOG im Benutzerspeicher mit folgendem Aufruf

Code: Alles auswählen

SetWindowLong_(hWnd, #DWL_USER, lParam)
um den Zeiger wieder aus dem Benutzerspeicher zu holen benutze ich

Code: Alles auswählen

*This.m_grClass = GetWindowLong_(hWnd, #DWL_USER)
Das Problem ist, wenn ich den Dialog
über das [X] schließe stimmt der Zeiger auf die Funktionstabelle,
sowie der String in der Struktur (*this) nicht mehr.

Alle anderen Variablen stimmen soweit.
Irgendwie zerschießt es mir die Struktur (*this)

Woran könnte dies liegen ?


hier mal noch der komplette Code der "Klasse" zum jetzigen Stand (geändert 01.11.18).

DialogClass.pb

Code: Alles auswählen

;/////////////////////////////////////////////////////////////////////////////////
;'CMainDlg' class 
;/////////////////////////////////////////////////////////////////////////////////
DeclareModule CMainDlg
  
  ;- public declaration
  
  ; construct
  Declare.i CDialog(nIDTemplate.i = #Null, pParentWnd.i = #Null)
  
  ;- class interface
  Interface iClass
    ; destruct
    close()
    ; public procedures
    Create.b(hInstance.i, nIDTemplate.i, pParentWnd.i)
    DoModal.b(hInstance.i)
    Quit.b(nResult.i = #Null);
    Refresh.b()
    UpdateData.b(bSaveAndValidate.b = #True)
    ShowWindow.b(nCmdShow.l)
    
    ; properties
    GetHandle.i()
    GetText.s()
    GetMenu.i()
    GetControlHandle.i(nID.i)
    
    SetPosition.b(x.i = #Null, y.i = #Null, nWidth.i = #Null, nHeight.i = #Null, bRepaint.b = #True)
    SetText.b(szText.s)
    SetMenu.b(hMenu.i) 
    SetFocus.b()
  EndInterface
  
  ;- class structure
  Structure grClass
    *vtable ;function table
  EndStructure
  
EndDeclareModule 

Module CMainDlg
  EnableExplicit
  
  ;- privat declaration
 
  ; destruct
  Declare close(*This) 

  Declare.b Create(*This, hInstance.i, nIDTemplate.i, pParentWnd.i)
  Declare.b DoModal(*This, hInstance.i)
  Declare.b Quit(*This, nResult.i = #Null)
  Declare.b Refresh(*This)
  Declare.b UpdateData(*This, bSaveAndValidate.b = #True)
  Declare.b ShowWindow(*This, nCmdShow.l)
  
  Declare DialogProc(hWnd.i, message.i, wParam.i, lParam.i)
  
  Declare OnNCDestroy(*This)
  Declare OnInitDialog(*This, hWndFocus.i)
  Declare OnCommand(*This, iCode.i, iID.i, hWndCtl.i)
  Declare OnKeyDown(*This, iKeyCode.i, Flag.i)
  Declare OnSize(*This, uSizeType.i, iWidth.i, iHeight.i);
  Declare OnNotify(*This, iID.i, *pNMHDR)    
  Declare OnColor(*This, hdcCtrl, hCtrl, nCtlColor);
  Declare OnPaint(*This)
  Declare OnDrawItem(*This, *pdis)
  
  Declare GetCtlColorBrush(nCtlColor)
  Declare InitDlgData(*This)
  Declare clearDlgData(*This)
  
  ;- private variables
  Structure m_grClass Extends grClass
    ; ----------    
    hWnd.i
    pParentWnd.i
    nIDTemplate.i 
    nIDHelp.i      
    ; ----------
    szTemplateName.s
    bModal.b 
    hFont.i
    hInstance.i
    hHook.i
  EndStructure
    
  ;- construct
  
  Procedure InitDlgData(*This.m_grClass)
    
  EndProcedure
  
  Procedure.i CDialog(nIDTemplate.i = #Null, pParentWnd.i = #Null)
    
    Protected *Object.m_grClass
    
    *Object = AllocateStructure(m_grClass)
    
    If *Object
      *Object\vTable = ?vtClass
      If nIDTemplate
        *Object\nIDTemplate = nIDTemplate
        *Object\szTemplateName =  "#" + Str(nIDTemplate)
      EndIf
      *Object\pParentWnd = pParentWnd
      
      InitDlgData(*Object)
    EndIf  
    ProcedureReturn *Object
  EndProcedure
  
  ;- destruct  
  
  Procedure clearDlgData(*This.m_grClass)
    
  EndProcedure
  
  Procedure close(*This.m_grClass)
    If *This
      clearDlgData(*This)
      If *This\hFont
        DeleteObject_(*This\hFont)
        *This\hFont = #Null
      EndIf
      
      Quit(*This)
      
      
      FreeStructure(*This)
      *This = #Null
      
    EndIf
  EndProcedure
  
  Procedure.b Create(*This.m_grClass, hInstance.i, nIDTemplate.i, pParentWnd.i)
    If (*This\hWnd) 
      ProcedureReturn #False;
    EndIf
    *This\nIDTemplate = nIDTemplate
    *This\szTemplateName = "#" + Str(nIDTemplate)
    *This\pParentWnd = pParentWnd
    *This\bModal = #False;
    *This\hInstance = hInstance
    
    *This\hWnd = CreateDialogParam_(hInstance, *This\szTemplateName, *This\pParentWnd, @DialogProc(), *This);
    ProcedureReturn Bool(*This\hWnd <> #Null)                                                                ;
  EndProcedure
  
  Procedure.b DoModal(*This.m_grClass, hInstance.i)
    If *This
      If (*This\hWnd) 
        ProcedureReturn #False;
      EndIf
      *This\hInstance = hInstance
      *This\bModal = #True;
      ProcedureReturn DialogBoxParam_(hInstance, *This\szTemplateName, *This\pParentWnd, @DialogProc(), *This);
    EndIf
  EndProcedure
  
  Procedure.b Quit(*This.m_grClass, nResult.i = #Null)
    Define Result.b
    If *This\hHook
      UnhookWindowsHookEx_(*This\hHook)
      *This\hHook = #Null
    EndIf
    
    If *This\hWnd
      If *This\bModal
        result = Bool(EndDialog_(*This\hWnd, nResult) <> #False)
      Else
        result = Bool(DestroyWindow_(*This\hWnd) <> #False)
      EndIf
      *This\hWnd = #Null
    EndIf
    ProcedureReturn result
  EndProcedure
  
  Procedure.b Refresh(*This.m_grClass)
    ProcedureReturn Bool(UpdateWindow_(*This\hWnd) <> 0);
  EndProcedure
  
  Procedure.b UpdateData(*This.m_grClass, bSaveAndValidate.b = #True)
    Define result.b

    ;DDX::DoDataExchange(*This\hWnd)
    ; TODO:
    ProcedureReturn result
  EndProcedure
  
  Procedure.b ShowWindow(*This.m_grClass, nCmdShow.l)
    ProcedureReturn Bool(ShowWindow_(*This\hWnd, nCmdShow) = 0)
  EndProcedure
    
  ;- Dialog CallBack function   
  Procedure DialogProc(hWnd.i, message.i, wParam.i, lParam.i)
    Protected result = #False
    Protected *This.m_grClass
    
    If Message = #WM_INITDIALOG
      *This = lParam
      SetWindowLongPtr_(hWnd, #DWL_USER, lParam)
      If *This And *This\hWnd = #Null
        *This\hWnd = hWnd
      EndIf
      result = OnInitDialog(*This, wParam)
    Else
      *This.m_grClass = GetWindowLongPtr_(hWnd, #DWL_USER)
      Select Message
        Case #WM_DESTROY
          result = #False
        Case #WM_NCDESTROY
          result = OnNCDestroy(*This)
        Case #WM_ACTIVATEAPP
          result = #False
        Case #WM_SETFONT
          result = #False
        Case #WM_WINDOWPOSCHANGING
          result = #False
        Case #WM_COMMAND
          result = OnCommand(*This, ((wParam >> 16) & $FFFF), (wParam & $FFFF), lParam);
        Case #WM_KEYDOWN
          result = OnKeyDown(*This, wParam, lParam)
        Case #WM_SIZE
          result = OnSize(*This, wParam, (lParam & $FFFF), ((lParam >> 16) & $FFFF));
        Case #WM_NOTIFY
          result = OnNotify(*This, wParam, lParam);
        Case #WM_CTLCOLORBTN, #WM_CTLCOLORDLG, #WM_CTLCOLOREDIT, #WM_CTLCOLORLISTBOX , #WM_CTLCOLORMSGBOX, #WM_CTLCOLORSCROLLBAR, #WM_CTLCOLORSTATIC
          result = OnColor(*This, wParam, lParam, message)
        Case #WM_PAINT
          result = OnPaint(*This)
        Case #WM_DRAWITEM
          result = OnDrawItem(*This, lParam)
        Case #WM_CLOSE
          close(*This)
        Default
          result = #False
      EndSelect
    EndIf
    ProcedureReturn result
  EndProcedure
  
  ;- message event procedures
  Procedure OnNCDestroy(*This.m_grClass)
    ProcedureReturn #False
  EndProcedure
    
  Procedure OnInitDialog(*This.m_grClass, hWndFocus.i)
    
    UpdateData(*This, #False)
    ProcedureReturn #True
  EndProcedure
    
    Procedure OnCommand(*This, iCode.i, iID.i, hWndCtl.i)
    
    If (iCode = #BN_CLICKED)
      If (iID = #IDCANCEL) 
        UpdateData(*This, #False)
        Quit(*this, #IDCANCEL);
      EndIf
    EndIf
    ProcedureReturn #True
  EndProcedure
  
  Procedure OnKeyDown(*This, iKeyCode.i, Flag.i)
    ProcedureReturn #False
  EndProcedure
  
  Procedure OnSize(*This, uSizeType.i, iWidth.i, iHeight.i)
    ProcedureReturn #False
  EndProcedure
  
  Procedure OnNotify(*This, iID.i, *pNMHDR.NMHDR)
    ProcedureReturn #False
  EndProcedure
  
  Procedure GetCtlColorBrush(nCtlColor)
    Select nCtlColor
      Case #WM_CTLCOLORBTN 
        ProcedureReturn GetSysColorBrush_(#COLOR_BTNFACE)
      Case #WM_CTLCOLORDLG 
        ProcedureReturn GetSysColorBrush_(#COLOR_3DFACE)
      Case #WM_CTLCOLOREDIT 
        ProcedureReturn GetSysColorBrush_(#COLOR_WINDOW)
      Case #WM_CTLCOLORLISTBOX  
        ProcedureReturn GetSysColorBrush_(#COLOR_WINDOW)
      Case #WM_CTLCOLORMSGBOX 
        ProcedureReturn GetSysColorBrush_(#COLOR_3DFACE)
      Case #WM_CTLCOLORSCROLLBAR 
        ProcedureReturn GetSysColorBrush_(#COLOR_BTNFACE)
      Case #WM_CTLCOLORSTATIC
        ProcedureReturn GetSysColorBrush_(#COLOR_3DFACE)
    EndSelect
  EndProcedure
  
  Procedure OnColor(*This.m_grClass, hdcCtrl, hCtrl, nCtlColor)
    Define hbrSys;
    Define hbrResult;
    Define hbrBGC   ;
    
    hbrSys = GetCtlColorBrush(nCtlColor)
    ; TODO:
    ;Select ( GetDlgCtrlID_(hCtrl) )

      ;Case 21010, 21020, 21021, 21022, 21030, 21031, 21032
        ;SetBkMode_(hdcCtrl,#TRANSPARENT)
        ;SetTextColor_(hdcCtrl, 41943040);
        ;hbrResult = hbrSys              ;                                                                              ;                                                                      ;              ;
      ;Default:
        ;If nCtlColor = #WM_CTLCOLORSTATIC
          ;SetBkMode_(hdcCtrl,#TRANSPARENT)  
          ;SetTextColor_(hdcCtrl, 41943040);
          ;hbrResult = hbrSys 
        ;ElseIf nCtlColor = #WM_CTLCOLORLISTBOX  
          ;SetBkMode_(hdcCtrl,#TRANSPARENT)
          ;SetTextColor_(hdcCtrl, 50266112)
          ;hbrResult = hbrSys
        ;ElseIf nCtlColor = #WM_CTLCOLOREDIT
          ;If GetDlgCtrlID_(GetParent_(hCtrl)) = 21011
            ;SetTextColor_(hdcCtrl, 50266112);
            ;hbrResult = hbrSys
          ;EndIf           
        ;EndIf 
        
    ;EndSelect
    ProcedureReturn hbrResult;
    
  EndProcedure
  
  Procedure OnPaint(*This)
    ProcedureReturn #False
  EndProcedure
    
  Procedure OnDrawItem(*This, *pdis.DRAWITEMSTRUCT)                                                   
    ProcedureReturn #True
  EndProcedure
  
  ;- properties
  Procedure.i GetHandle(*This.m_grClass)
    ProcedureReturn *This\hWnd
  EndProcedure
  
  Procedure.s GetText(*This.m_grClass)
    Define.s szText ;
    Define.i iTextLength = GetWindowTextLength_(*This\hWnd) + 1;
    
    szText = Space(iTextLength);
    GetWindowText_(*This\hWnd, @szText, iTextLength)
    ProcedureReturn szText;
  EndProcedure
  
  Procedure.i GetMenu(*This.m_grClass);
    ProcedureReturn GetMenu_(*This\hWnd);
  EndProcedure
  
  Procedure.i GetControlHandle(*This.m_grClass, nID.i)
    ProcedureReturn GetDlgItem_(*This\hWnd, nID);
  EndProcedure
  
  
  Procedure.b SetPosition(*This.m_grClass, x.i = #Null, y.i = #Null, nWidth.i = #Null, nHeight.i = #Null, bRepaint.b = #True)
    Define.RECT rc 
    Define.RECT rcDlg
    Define.RECT rcOwner
    
    If x = 0 And y = 0 And nWidth = 0 And nheight = #Null
      Define *hwndOwner = *This\pParentWnd
      If (*hwndOwner = #Null) 
        *hwndOwner = GetDesktopWindow_(); 
      EndIf
      
      GetWindowRect_(*hwndOwner, rcOwner); 
      GetWindowRect_(*This\hWnd, rcDlg)  ; 
      CopyRect_(rc, rcOwner)             ; 
      
      OffsetRect_(rcDlg, -rcDlg\left, -rcDlg\top); 
      OffsetRect_(rc, -rc\left, -rc\top)         ; 
      OffsetRect_(rc, -rcDlg\right, -rcDlg\bottom); 
      
      ProcedureReturn Bool(SetWindowPos_(*This\hWnd, #HWND_TOP, rcOwner\left + (rc\right / 2), rcOwner\top + (rc\bottom / 2), 0, 0, #SWP_NOSIZE) <> 0); ignore size arguments
    Else
      ProcedureReturn Bool(MoveWindow_(*This\hWnd, x, y, nWidth, nHeight, bRepaint) <> 0)
    EndIf
  EndProcedure
  
  Procedure.b SetText(*This.m_grClass, szText.s);
    ProcedureReturn Bool(SetWindowText_(*This\hWnd, @szText) <> 0);
  EndProcedure
  
  Procedure.b SetMenu(*This.m_grClass, hMenu.i) ;
    ProcedureReturn Bool(SetMenu_(*This\hWnd, hMenu) <> 0);
  EndProcedure
  
  Procedure.b SetFocus(*This.m_grClass);
    SetForegroundWindow_(*This\hWnd)
    SetFocus_(*This\hWnd)
  EndProcedure
  
 
  DataSection
    vtClass:
    Data.i @close()
    ; public procedures
    Data.i @Create()
    Data.i @DoModal()
    Data.i @Quit()
    Data.i @Refresh()
    Data.i @UpdateData()
    Data.i @ShowWindow()
    
    ; properties:
    Data.i @GetHandle()
    Data.i @GetText()
    Data.i @GetMenu()
    Data.i @GetControlHandle()
    
    Data.i @SetPosition()
    Data.i @SetText()
    Data.i @SetMenu()
    Data.i @SetFocus()
  EndDataSection
EndModule


;...
Define.CMainDlg::iClass *MainDlg
;...
*MainDlg = CMainDlg::CDialog(150, 0)
;...
;...
*MainDlg\DoModal(hInstance)
;...
*MainDlg\close()
;
Dialog.pbp

Code: Alles auswählen

<?xml version="1.0" encoding="UTF-8"?>

<project xmlns="http://www.purebasic.com/namespace" version="1.0" creator="PureBasic 5.46 LTS (Windows - x86)">
  <section name="config">
    <options closefiles="1" openmode="0" name="DialogClass"/>
  </section>
  <section name="data">
    <explorer view="D:\Program Files\PureBasic\Examples\" pattern="0"/>
    <log show="1"/>
    <lastopen date="2018-10-31 18:26" user="xxx" host="xxx"/>
  </section>
  <section name="files">
    <file name="DialogClass.pb">
      <config load="0" scan="1" panel="1" warn="1" lastopen="1" panelstate="+"/>
      <fingerprint md5="04ae6b2d7e1aa51080ac29b960f46f6e"/>
    </file>
    <file name="resource.rc">
      <config load="0" scan="0" panel="1" warn="1" lastopen="1" panelstate="+"/>
      <fingerprint md5="ca218c8f968842f63884d1a2f6258538"/>
    </file>
  </section>
  <section name="targets">
    <target name="Standard-Ziel" enabled="1" default="1">
      <inputfile value="DialogClass.pb"/>
      <outputfile value=""/>
      <options onerror="1" debug="1"/>
      <compilecount enable="1" value="1"/>
      <buildcount enable="1" value="0"/>
      <resources>
        <resource value="resource.rc"/>
      </resources>
    </target>
  </section>
</project>
resource.rc

Code: Alles auswählen

//
// Dialog resources
//
LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL
150 DIALOG 0, 0, 186, 95
STYLE DS_3DLOOK | DS_CENTER | DS_MODALFRAME | WS_CAPTION | WS_VISIBLE | WS_POPUP | WS_SYSMENU
CAPTION "Dialog"
FONT 8, "Ms Shell Dlg"
{
    PUSHBUTTON      "Abbrechen", IDCANCEL, 129, 24, 50, 14, 0, WS_EX_LEFT
    DEFPUSHBUTTON   "OK", IDOK, 129, 7, 50, 14, 0, WS_EX_LEFT
}
Compiler: Purebasic 5.46 LTS (x86)
OS: Windows 7 x64
Zuletzt geändert von FS-1281 am 01.11.2018 10:42, insgesamt 4-mal geändert.
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

Re: Zeiger auf Structure/Interface in DWL_USER der Dialogbox

Beitrag von Bisonte »

Ich hab nicht wirklich Ahnung von OOP, aber wenn man ein Interface benutzt....
Sollte da nicht das erste Element in der Struktur nicht der Zeiger auf die Funktionstabelle sein ?!

Aber nichtsdestotrotz ist da noch ein Fehler, den ich auf Anhieb sehe :

Du nutzt Long(.l) variablen als Halter für OS Handles...

Das wird früher oder später zu merkwürdigem Verhalten führen.
Immer Integer (.i) dafür nutzen. Das OS kann einen Zeiger aus dem kompletten Speicherbereich übergeben. Wenn mehr
als 2GB Ram da sind, reicht ein Long nicht aus. Dabei ist das Betriebssystem egal. Windows 32 oder 64Bit spielt da keine Rolle,
auch nicht ob das PB Programm in x86 oder x64 kompiliert wurde.

Die Fehlersuche ist dabei sehr Zeitraubend !
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Zeiger auf Structure/Interface in DWL_USER der Dialogbox

Beitrag von mk-soft »

Die *vTable ist bereit an der ersten Stelle durch Extends...

Ich glaube hier ist das Problem.

Code: Alles auswählen

Case #WM_INITDIALOG
        SetWindowLong_(hWnd, #DWL_USER, lParam)
     
Das *this ist ja schon beim anlegen Gesetz worden.

Leider ist kein ausführbarer Test-Code hinzugefügt um diese schnell zu überprüfen...

Handle sollten immer Integer sein damit es auch unter X64 läuft.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

Re: Zeiger auf Structure/Interface in DWL_USER der Dialogbox

Beitrag von Bisonte »

Code: Alles auswählen

Case #WM_INITDIALOG
        SetWindowLong_(hWnd, #DWL_USER, lParam)
Das alleine ist schon grob fahrlässig. MS selbst sagt, SetWindowLongPTR_ benutzen !
Und Integer IMMER für vom OS zurückgegebene Adressen. EGAL ob x86 oder x64 !!!
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
Benutzeravatar
FS-1281
Beiträge: 8
Registriert: 13.05.2015 15:44

Re: Zeiger auf Structure/Interface in DWL_USER der Dialogbox

Beitrag von FS-1281 »

erstmal Danke für die Antworten und die Hinweise!
Du nutzt Long(.l) variablen als Halter für OS Handles...

Das wird früher oder später zu merkwürdigem Verhalten führen.
Immer Integer (.i) dafür nutzen. Das OS kann einen Zeiger aus dem kompletten Speicherbereich übergeben. Wenn mehr
als 2GB Ram da sind, reicht ein Long nicht aus. Dabei ist das Betriebssystem egal. Windows 32 oder 64Bit spielt da keine Rolle,
auch nicht ob das PB Programm in x86 oder x64 kompiliert wurde.
Das mit Long und Integer war mir neu,
da beide Datentypen unter x86 ja 4byte groß sind und somit die gleiche Menge an Daten aufnehmen sollten.
Wenn dies bei handles so essenziell wichtig ist, sollte dies auch in der Hilfe von PB erwähnt werden.

Das ändern auf Datentyp Integer hat das Problem leider nicht behoben.
Das alleine ist schon grob fahrlässig. MS selbst sagt, SetWindowLongPTR_ benutzen !
Und Integer IMMER für vom OS zurückgegebene Adressen. EGAL ob x86 oder x64 !!!
SetWindowLongPtr_(hWnd, #DWLP_USER, lParam) und GetWindowLongPtr_(hWnd, #DWLP_USER)
habe ich auch schon probiert, dann wird aber ein Null-Zeiger zurückgegeben.
mit SetWindowLongPtr_(hWnd, #DWL_USER, lParam) und GetWindowLongPtr_(hWnd, #DWL_USER)
habe ich den gleichen Effekt wie mit SetWindowLong_(hWnd, #DWL_USER, lParam) und GetWindowLong_(hWnd, #DWL_USER),
da bei x86 Programmen SetWindowLongPtr automatisch SetWindowLong verwendet.
Leider ist kein ausführbarer Test-Code hinzugefügt um diese schnell zu überprüfen...
Habe den Code oben mal angepasst
Benutzeravatar
FS-1281
Beiträge: 8
Registriert: 13.05.2015 15:44

Re: Zeiger auf Structure/Interface in DWL_USER der Dialogbox

Beitrag von FS-1281 »

Ich hab den Fehler gefunden!

Lösung folgt!
Benutzeravatar
FS-1281
Beiträge: 8
Registriert: 13.05.2015 15:44

Re: Zeiger auf Structure/Interface in DWL_USER der Dialogbox

Beitrag von FS-1281 »

Da hatte ich wohl ein Brett vor dem Kopf!
so geht's

Code: Alles auswählen

;/////////////////////////////////////////////////////////////////////////////////
;'CMainDlg' class 
;/////////////////////////////////////////////////////////////////////////////////
DeclareModule CMainDlg
  
  ;- public declaration
  
  ; construct
  Declare.i CDialog(nIDTemplate.i = #Null, pParentWnd.i = #Null)
  
  ;- class interface
  Interface iClass
    ; destruct
    Release()
    ; public procedures
    Create.b(hInstance.i, nIDTemplate.i, pParentWnd.i)
    DoModal.b(hInstance.i)
    Quit.b(nResult.i = #Null);
    Refresh.b()
    UpdateData.b(bSaveAndValidate.b = #True)
    ShowWindow.b(nCmdShow.l)
    
    ; properties
    GetHandle.i()
    GetText.s()
    GetMenu.i()
    GetControlHandle.i(nID.i)
    
    SetPosition.b(x.i = #Null, y.i = #Null, nWidth.i = #Null, nHeight.i = #Null, bRepaint.b = #True)
    SetText.b(szText.s)
    SetMenu.b(hMenu.i) 
    SetFocus.b()
  EndInterface
  
  ;- class structure
  Structure grClass
    *vtable ;function table
  EndStructure
  
EndDeclareModule 

Module CMainDlg
  EnableExplicit
  
  ;- privat declaration
 
  ; destruct
  Declare Release(*This) 

  Declare.b Create(*This, hInstance.i, nIDTemplate.i, pParentWnd.i)
  Declare.b DoModal(*This, hInstance.i)
  Declare.b Quit(*This, nResult.i = #Null)
  Declare.b Refresh(*This)
  Declare.b UpdateData(*This, bSaveAndValidate.b = #True)
  Declare.b ShowWindow(*This, nCmdShow.l)
  
  Declare DialogProc(hWnd.i, message.i, wParam.i, lParam.i)
  
  Declare OnNCDestroy(*This)
  Declare OnInitDialog(*This, hWndFocus.i)
  Declare OnCommand(*This, iCode.i, iID.i, hWndCtl.i)
  Declare OnKeyDown(*This, iKeyCode.i, Flag.i)
  Declare OnSize(*This, uSizeType.i, iWidth.i, iHeight.i);
  Declare OnNotify(*This, iID.i, *pNMHDR)    
  Declare OnColor(*This, hdcCtrl, hCtrl, nCtlColor);
  Declare OnPaint(*This)
  Declare OnDrawItem(*This, *pdis)
  Declare OnClose(*This)
  
  Declare GetCtlColorBrush(nCtlColor)
  Declare InitDlgData(*This)
  Declare clearDlgData(*This)
  
  ;- private variables
  Structure m_grClass Extends grClass
    ; ----------    
    hWnd.i
    pParentWnd.i
    nIDTemplate.i 
    nIDHelp.i      
    ; ----------
    szTemplateName.s
    bModal.b 
    hFont.i
    hInstance.i
    hHook.i
  EndStructure
    
  ;- construct
  
  Procedure InitDlgData(*This.m_grClass)
    
  EndProcedure
  
  Procedure.i CDialog(nIDTemplate.i = #Null, pParentWnd.i = #Null)
    
    Protected *Object.m_grClass
    
    *Object = AllocateStructure(m_grClass)
    
    If *Object
      *Object\vTable = ?vtClass
      If nIDTemplate
        *Object\nIDTemplate = nIDTemplate
        *Object\szTemplateName =  "#" + Str(nIDTemplate)
      EndIf
      *Object\pParentWnd = pParentWnd
      
      InitDlgData(*Object)
    EndIf  
    ProcedureReturn *Object
  EndProcedure
  
  ;- destruct  
  
  Procedure clearDlgData(*This.m_grClass)
    
  EndProcedure
  
  Procedure Release(*This.m_grClass)
    If *This
      clearDlgData(*This)
      If *This\hFont
        DeleteObject_(*This\hFont)
        *This\hFont = #Null
      EndIf
      
      Quit(*This)   
      
      FreeStructure(*This)
      *This = #Null
      
    EndIf
  EndProcedure
  
  Procedure.b Create(*This.m_grClass, hInstance.i, nIDTemplate.i, pParentWnd.i)
    If (*This\hWnd) 
      ProcedureReturn #False;
    EndIf
    *This\nIDTemplate = nIDTemplate
    *This\szTemplateName = "#" + Str(nIDTemplate)
    *This\pParentWnd = pParentWnd
    *This\bModal = #False;
    *This\hInstance = hInstance
    
    *This\hWnd = CreateDialogParam_(hInstance, *This\szTemplateName, *This\pParentWnd, @DialogProc(), *This);
    ProcedureReturn Bool(*This\hWnd <> #Null)                                                                ;
  EndProcedure
  
  Procedure.b DoModal(*This.m_grClass, hInstance.i)
    If *This
      If (*This\hWnd) 
        ProcedureReturn #False;
      EndIf
      *This\hInstance = hInstance
      *This\bModal = #True;
      ProcedureReturn DialogBoxParam_(hInstance, *This\szTemplateName, *This\pParentWnd, @DialogProc(), *This);
    EndIf
  EndProcedure
  
  Procedure.b Quit(*This.m_grClass, nResult.i = #Null)
    Define Result.b
    If *this
      If *This\hHook
        UnhookWindowsHookEx_(*This\hHook)
        *This\hHook = #Null
      EndIf
      
      If *This\hWnd
        If *This\bModal
          result = Bool(EndDialog_(*This\hWnd, nResult) <> #False)
        Else
          result = Bool(DestroyWindow_(*This\hWnd) <> #False)
        EndIf
        *This\hWnd = #Null
      EndIf
    EndIf
    ProcedureReturn result
  EndProcedure
  
  Procedure.b Refresh(*This.m_grClass)
    ProcedureReturn Bool(UpdateWindow_(*This\hWnd) <> 0);
  EndProcedure
  
  Procedure.b UpdateData(*This.m_grClass, bSaveAndValidate.b = #True)
    Define result.b

    ;DDX::DoDataExchange(*This\hWnd)
    ; TODO:
    ProcedureReturn result
  EndProcedure
  
  Procedure.b ShowWindow(*This.m_grClass, nCmdShow.l)
    ProcedureReturn Bool(ShowWindow_(*This\hWnd, nCmdShow) = 0)
  EndProcedure
    
  ;- Dialog CallBack function   
  Procedure DialogProc(hWnd.i, message.i, wParam.i, lParam.i)
    Protected result = #False
    Protected *This.m_grClass
    
    If Message = #WM_INITDIALOG
      *This = lParam
      SetWindowLongPtr_(hWnd, #DWL_USER, lParam)
      If *This And *This\hWnd = #Null
        *This\hWnd = hWnd
      EndIf
      result = OnInitDialog(*This, wParam)
    Else
      *This.m_grClass = GetWindowLongPtr_(hWnd, #DWL_USER)
      Select Message
        Case #WM_DESTROY
          result = #False
        Case #WM_NCDESTROY
          result = OnNCDestroy(*This)
        Case #WM_ACTIVATEAPP
          result = #False
        Case #WM_SETFONT
          result = #False
        Case #WM_WINDOWPOSCHANGING
          result = #False
        Case #WM_COMMAND
          result = OnCommand(*This, ((wParam >> 16) & $FFFF), (wParam & $FFFF), lParam);
        Case #WM_KEYDOWN
          result = OnKeyDown(*This, wParam, lParam)
        Case #WM_SIZE
          result = OnSize(*This, wParam, (lParam & $FFFF), ((lParam >> 16) & $FFFF));
        Case #WM_NOTIFY
          result = OnNotify(*This, wParam, lParam);
        Case #WM_CTLCOLORBTN, #WM_CTLCOLORDLG, #WM_CTLCOLOREDIT, #WM_CTLCOLORLISTBOX , #WM_CTLCOLORMSGBOX, #WM_CTLCOLORSCROLLBAR, #WM_CTLCOLORSTATIC
          result = OnColor(*This, wParam, lParam, message)
        Case #WM_PAINT
          result = OnPaint(*This)
        Case #WM_DRAWITEM
          result = OnDrawItem(*This, lParam)
        Case #WM_CLOSE
          result = OnClose(*This)
        Default
          result = #False
      EndSelect
    EndIf
    ProcedureReturn result
  EndProcedure
  
  ;- message event procedures
  Procedure OnNCDestroy(*This.m_grClass)
    ProcedureReturn #False
  EndProcedure
    
  Procedure OnInitDialog(*This.m_grClass, hWndFocus.i)
    
    UpdateData(*This, #False)
    ProcedureReturn #True
  EndProcedure
    
    Procedure OnCommand(*This, iCode.i, iID.i, hWndCtl.i)
    
    If (iCode = #BN_CLICKED)
      If (iID = #IDCANCEL) 
        UpdateData(*This, #False)
        Quit(*this, #IDCANCEL);
      EndIf
    EndIf
    ProcedureReturn #True
  EndProcedure
  
  Procedure OnKeyDown(*This, iKeyCode.i, Flag.i)
    ProcedureReturn #False
  EndProcedure
  
  Procedure OnSize(*This, uSizeType.i, iWidth.i, iHeight.i)
    ProcedureReturn #False
  EndProcedure
  
  Procedure OnNotify(*This, iID.i, *pNMHDR.NMHDR)
    ProcedureReturn #False
  EndProcedure
  
  Procedure GetCtlColorBrush(nCtlColor)
    Select nCtlColor
      Case #WM_CTLCOLORBTN 
        ProcedureReturn GetSysColorBrush_(#COLOR_BTNFACE)
      Case #WM_CTLCOLORDLG 
        ProcedureReturn GetSysColorBrush_(#COLOR_3DFACE)
      Case #WM_CTLCOLOREDIT 
        ProcedureReturn GetSysColorBrush_(#COLOR_WINDOW)
      Case #WM_CTLCOLORLISTBOX  
        ProcedureReturn GetSysColorBrush_(#COLOR_WINDOW)
      Case #WM_CTLCOLORMSGBOX 
        ProcedureReturn GetSysColorBrush_(#COLOR_3DFACE)
      Case #WM_CTLCOLORSCROLLBAR 
        ProcedureReturn GetSysColorBrush_(#COLOR_BTNFACE)
      Case #WM_CTLCOLORSTATIC
        ProcedureReturn GetSysColorBrush_(#COLOR_3DFACE)
    EndSelect
  EndProcedure
  
  Procedure OnColor(*This.m_grClass, hdcCtrl, hCtrl, nCtlColor)
    Define hbrSys;
    Define hbrResult;
    Define hbrBGC   ;
    
    hbrSys = GetCtlColorBrush(nCtlColor)
    ; TODO:
    ;Select ( GetDlgCtrlID_(hCtrl) )

      ;Case 21010, 21020, 21021, 21022, 21030, 21031, 21032
        ;SetBkMode_(hdcCtrl,#TRANSPARENT)
        ;SetTextColor_(hdcCtrl, 41943040);
        ;hbrResult = hbrSys              
      ;Default:
        ;If nCtlColor = #WM_CTLCOLORSTATIC
          ;SetBkMode_(hdcCtrl,#TRANSPARENT)  
          ;SetTextColor_(hdcCtrl, 41943040);
          ;hbrResult = hbrSys 
        ;ElseIf nCtlColor = #WM_CTLCOLORLISTBOX  
          ;SetBkMode_(hdcCtrl,#TRANSPARENT)
          ;SetTextColor_(hdcCtrl, 50266112)
          ;hbrResult = hbrSys
        ;ElseIf nCtlColor = #WM_CTLCOLOREDIT
          ;If GetDlgCtrlID_(GetParent_(hCtrl)) = 21011
            ;SetTextColor_(hdcCtrl, 50266112);
            ;hbrResult = hbrSys
          ;EndIf           
        ;EndIf 
        
    ;EndSelect
    ProcedureReturn hbrResult;
    
  EndProcedure
  
  Procedure OnPaint(*This.m_grClass)
    ProcedureReturn #False
  EndProcedure
    
  Procedure OnDrawItem(*This.m_grClass, *pdis.DRAWITEMSTRUCT)                                                   
    ProcedureReturn #True
  EndProcedure
  
  Procedure OnClose(*This.m_grClass)
    Quit(*This)  
    ProcedureReturn #False
  EndProcedure
  
  
  ;- properties
  Procedure.i GetHandle(*This.m_grClass)
    ProcedureReturn *This\hWnd
  EndProcedure
  
  Procedure.s GetText(*This.m_grClass)
    Define.s szText ;
    Define.i iTextLength = GetWindowTextLength_(*This\hWnd) + 1;
    
    szText = Space(iTextLength);
    GetWindowText_(*This\hWnd, @szText, iTextLength)
    ProcedureReturn szText;
  EndProcedure
  
  Procedure.i GetMenu(*This.m_grClass);
    ProcedureReturn GetMenu_(*This\hWnd);
  EndProcedure
  
  Procedure.i GetControlHandle(*This.m_grClass, nID.i)
    ProcedureReturn GetDlgItem_(*This\hWnd, nID);
  EndProcedure
  
  
  Procedure.b SetPosition(*This.m_grClass, x.i = #Null, y.i = #Null, nWidth.i = #Null, nHeight.i = #Null, bRepaint.b = #True)
    Define.RECT rc 
    Define.RECT rcDlg
    Define.RECT rcOwner
    
    If x = 0 And y = 0 And nWidth = 0 And nheight = #Null
      Define *hwndOwner = *This\pParentWnd
      If (*hwndOwner = #Null) 
        *hwndOwner = GetDesktopWindow_(); 
      EndIf
      
      GetWindowRect_(*hwndOwner, rcOwner); 
      GetWindowRect_(*This\hWnd, rcDlg)  ; 
      CopyRect_(rc, rcOwner)             ; 
      
      OffsetRect_(rcDlg, -rcDlg\left, -rcDlg\top); 
      OffsetRect_(rc, -rc\left, -rc\top)         ; 
      OffsetRect_(rc, -rcDlg\right, -rcDlg\bottom); 
      
      ProcedureReturn Bool(SetWindowPos_(*This\hWnd, #HWND_TOP, rcOwner\left + (rc\right / 2), rcOwner\top + (rc\bottom / 2), 0, 0, #SWP_NOSIZE) <> 0); ignore size arguments
    Else
      ProcedureReturn Bool(MoveWindow_(*This\hWnd, x, y, nWidth, nHeight, bRepaint) <> 0)
    EndIf
  EndProcedure
  
  Procedure.b SetText(*This.m_grClass, szText.s);
    ProcedureReturn Bool(SetWindowText_(*This\hWnd, @szText) <> 0);
  EndProcedure
  
  Procedure.b SetMenu(*This.m_grClass, hMenu.i) ;
    ProcedureReturn Bool(SetMenu_(*This\hWnd, hMenu) <> 0);
  EndProcedure
  
  Procedure.b SetFocus(*This.m_grClass);
    SetForegroundWindow_(*This\hWnd)
    SetFocus_(*This\hWnd)
  EndProcedure
  
 
  DataSection
    vtClass:
    Data.i @Release()
    ; public procedures
    Data.i @Create()
    Data.i @DoModal()
    Data.i @Quit()
    Data.i @Refresh()
    Data.i @UpdateData()
    Data.i @ShowWindow()
    
    ; properties:
    Data.i @GetHandle()
    Data.i @GetText()
    Data.i @GetMenu()
    Data.i @GetControlHandle()
    
    Data.i @SetPosition()
    Data.i @SetText()
    Data.i @SetMenu()
    Data.i @SetFocus()
  EndDataSection
EndModule


;...
Define.CMainDlg::iClass *MainDlg
;...
*MainDlg = CMainDlg::CDialog(150, 0)
;...
;...
*MainDlg\DoModal(hInstance)
;...
*MainDlg\Release()
;
Antworten