PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Creating a Win32-Window for replacing ContainerGadget

https://www.purebasic.fr/english/viewtopic.php?t=38860

Page 1 of 1

Creating a Win32-Window for replacing ContainerGadget

Posted: Mon Aug 31, 2009 3:23 pm
by Peyman
hi,
from last day until now im working on something to create on window for replacing ContainerGadget so first i must find really ContainerGadget is what, and create hook on RegisterClassExA and RegisterClassA and CreateWindowExA and find PureBasic Team what do when we call ContainerGadget they register a class then create a window with that class and set parent it to main window.

i create a example so you can see PB team what do when you create a object :

Code: Select all

Global Dim RegisterClassExA.b(5)
Global Dim RegisterClassA.b(5)
Global Dim CreateWindowExA.b(5)

Procedure.s Cursor(hcursor)
  Select hcursor
    Case 65575 : ProcedureReturn "#IDC_APPSTARTING"
    Case 65553 : ProcedureReturn "#IDC_ARROW"
    Case 65559 : ProcedureReturn "#IDC_CROSS"
    Case 65581 : ProcedureReturn "#IDC_HAND"
    Case 65577 : ProcedureReturn "#IDC_HELP"
    Case 65555 : ProcedureReturn "#IDC_IBEAM"
    Case 0     : ProcedureReturn "#IDC_ICON OR #IDC_SIZE"
    Case 65573 : ProcedureReturn "#IDC_NO"
    Case 65561 : ProcedureReturn "#IDC_UPARROW"
    Case 65567 : ProcedureReturn "#IDC_SIZEWE"
    Case 65563 : ProcedureReturn "#IDC_SIZENWSE"
    Case 65569 : ProcedureReturn "#IDC_SIZENS"
    Case 65565 : ProcedureReturn "#IDC_SIZENESW"
    Case 65557 : ProcedureReturn "#IDC_WAIT"
    Default   : ProcedureReturn Str(hcursor)
  EndSelect
EndProcedure

Procedure.s Background(backcolor)
  Select backcolor
    Case #COLOR_ACTIVEBORDER : ProcedureReturn "#COLOR_ACTIVEBORDER"
    Case #COLOR_ACTIVECAPTION : ProcedureReturn "#COLOR_ACTIVECAPTION"
    Case #COLOR_APPWORKSPACE : ProcedureReturn "#COLOR_APPWORKSPACE"
    Case #COLOR_BACKGROUND : ProcedureReturn "#COLOR_BACKGROUND"
    Case #COLOR_BTNFACE : ProcedureReturn "#COLOR_BTNFACE"
    Case #COLOR_BTNSHADOW : ProcedureReturn "#COLOR_BTNSHADOW"
    Case #COLOR_BTNTEXT     : ProcedureReturn "#COLOR_BTNTEXT"
    Case #COLOR_CAPTIONTEXT : ProcedureReturn "#COLOR_CAPTIONTEXT"
    Case #COLOR_GRAYTEXT : ProcedureReturn "#COLOR_GRAYTEXT"
    Case #COLOR_HIGHLIGHT : ProcedureReturn "#COLOR_HIGHLIGHT"
    Case #COLOR_HIGHLIGHTTEXT : ProcedureReturn "#COLOR_HIGHLIGHTTEXT"
    Case #COLOR_INACTIVEBORDER : ProcedureReturn "#COLOR_INACTIVEBORDER"
    Case #COLOR_INACTIVECAPTION : ProcedureReturn "#COLOR_INACTIVECAPTION"
    Case #COLOR_MENU : ProcedureReturn "#COLOR_MENU"
    Case #COLOR_MENUTEXT : ProcedureReturn "#COLOR_MENUTEXT"
    Case #COLOR_SCROLLBAR : ProcedureReturn "#COLOR_SCROLLBAR"
    Case #COLOR_WINDOW : ProcedureReturn "#COLOR_WINDOW"
    Case #COLOR_WINDOWFRAME : ProcedureReturn "#COLOR_WINDOWFRAME"
    Case #COLOR_WINDOWTEXT : ProcedureReturn "#COLOR_WINDOWTEXT"
    Default   : ProcedureReturn Str(backcolor)
  EndSelect
EndProcedure

Procedure.s Flags(flag.l)

  ;-- dwExStyles
  ret.s = ""
  If flag & #WS_EX_ACCEPTFILES
    ret + "#WS_EX_ACCEPTFILES" + "|"
  EndIf
  If flag & #WS_EX_APPWINDOW
    ret + "#WS_EX_APPWINDOW" + "|"
  EndIf
  If flag & #WS_EX_CLIENTEDGE
    ret + "#WS_EX_CLIENTEDGE" + "|"
  EndIf
  If flag & #WS_EX_COMPOSITED
    ret + "#WS_EX_COMPOSITED" + "|"
  EndIf
  If flag & #WS_EX_CONTROLPARENT
    ret + "#WS_EX_CONTROLPARENT" + "|"
  EndIf
  If flag & #WS_EX_DLGMODALFRAME
    ret + "#WS_EX_DLGMODALFRAME" + "|"
  EndIf
  If flag & #WS_EX_LAYERED
    ret + "#WS_EX_LAYERED" + "|"
  EndIf
  If flag & #WS_EX_LAYOUTRTL
    ret + "#WS_EX_LAYOUTRTL" + "|"
  EndIf  
  If flag & #WS_EX_LEFT
    ret + "#WS_EX_LEFT" + "|"
  EndIf  
  If flag & #WS_EX_LEFTSCROLLBAR
    ret + "#WS_EX_LEFTSCROLLBAR" + "|"
  EndIf  
  If flag & #WS_EX_LTRREADING
    ret + "#WS_EX_LTRREADING" + "|"
  EndIf  
  If flag & #WS_EX_MDICHILD
    ret + "#WS_EX_MDICHILD" + "|"
  EndIf
  If flag & #WS_EX_NOACTIVATE
    ret + "#WS_EX_NOACTIVATE" + "|"
  EndIf  
  If flag & #WS_EX_NOPARENTNOTIFY
    ret + "#WS_EX_NOPARENTNOTIFY" + "|"
  EndIf  
  If flag & #WS_EX_OVERLAPPEDWINDOW
    ret + "#WS_EX_OVERLAPPEDWINDOW" + "|"
  EndIf  
  If flag & #WS_EX_PALETTEWINDOW
    ret + "#WS_EX_PALETTEWINDOW" + "|"
  EndIf  
  If flag & #WS_EX_RIGHT
    ret + "#WS_EX_RIGHT" + "|"
  EndIf  
  If flag & #WS_EX_RIGHTSCROLLBAR
    ret + "#WS_EX_RIGHTSCROLLBAR" + "|"
  EndIf  
  If flag & #WS_EX_RTLREADING
    ret + "#WS_EX_RTLREADING" + "|"
  EndIf  
  If flag & #WS_EX_STATICEDGE
    ret + "#WS_EX_STATICEDGE" + "|"
  EndIf    
  If flag & #WS_EX_TOOLWINDOW
    ret + "#WS_EX_TOOLWINDOW" + "|"
  EndIf  
  If flag & #WS_EX_TOPMOST
    ret + "#WS_EX_TOPMOST" + "|"
  EndIf  
  If flag & #WS_EX_TRANSPARENT
    ret + "#WS_EX_TRANSPARENT" + "|"
  EndIf  
  If flag & #WS_EX_WINDOWEDGE
    ret + "#WS_EX_WINDOWEDGE" + "|"
  EndIf
  
  ;-- dwStyles
  
  If flag & #WS_BORDER
    ret + "#WS_BORDER" + "|"
  EndIf  
  If flag & #WS_CAPTION
    ret + "#WS_CAPTION" + "|"
  EndIf    
  If flag & #WS_CHILD
    ret + "#WS_CHILD" + "|"
  EndIf  
  If flag & #WS_CHILDWINDOW
    ret + "#WS_CHILDWINDOW" + "|"
  EndIf  
  If flag & #WS_CLIPCHILDREN
    ret + "#WS_CLIPCHILDREN" + "|"
  EndIf  
  If flag & #WS_CLIPSIBLINGS
    ret + "#WS_CLIPSIBLINGS" + "|"
  EndIf 
  If flag & #WS_DISABLED
    ret + "#WS_DISABLED" + "|"
  EndIf  
  If flag & #WS_DLGFRAME
    ret + "#WS_DLGFRAME" + "|"
  EndIf    
  If flag & #WS_GROUP
    ret + "#WS_GROUP" + "|"
  EndIf  
  If flag & #WS_HSCROLL
    ret + "#WS_HSCROLL" + "|"
  EndIf  
  If flag & #WS_ICONIC
    ret + "#WS_ICONIC" + "|"
  EndIf  
  If flag & #WS_MAXIMIZE
    ret + "#WS_MAXIMIZE" + "|"
  EndIf  
  If flag & #WS_MAXIMIZEBOX
    ret + "#WS_MAXIMIZEBOX" + "|"
  EndIf  
  If flag & #WS_MINIMIZE
    ret + "#WS_MINIMIZE" + "|"
  EndIf    
  If flag & #WS_MINIMIZEBOX
    ret + "#WS_MINIMIZEBOX" + "|"
  EndIf  
  If flag & #WS_OVERLAPPED
    ret + "#WS_OVERLAPPED" + "|"
  EndIf  
  If flag & #WS_OVERLAPPEDWINDOW
    ret + "#WS_OVERLAPPEDWINDOW" + "|"
  EndIf  
  If flag & #WS_POPUP
    ret + "#WS_POPUP" + "|"
  EndIf  
  If flag & #WS_POPUPWINDOW
    ret + "#WS_POPUPWINDOW" + "|"
  EndIf  
  If flag & #WS_SIZEBOX
    ret + "#WS_SIZEBOX" + "|"
  EndIf    
  If flag & #WS_SYSMENU
    ret + "#WS_SYSMENU" + "|"
  EndIf  
  If flag & #WS_TABSTOP
    ret + "#WS_TABSTOP" + "|"
  EndIf  
  If flag & #WS_THICKFRAME
    ret + "#WS_THICKFRAME" + "|"
  EndIf  
  If flag & #WS_TILED
    ret + "#WS_TILED" + "|"
  EndIf  
  If flag & #WS_TILEDWINDOW
    ret + "#WS_TILEDWINDOW" + "|"
  EndIf  
  If flag & #WS_VISIBLE
    ret + "#WS_VISIBLE" + "|"
  EndIf    
  If flag & #WS_VSCROLL
    ret + "#WS_VSCROLL" + "|"
  EndIf  

  ProcedureReturn Left(ret, Len(ret)-1)

EndProcedure

Procedure Hook(Libname.s,FuncName.s,NewFunctionAddress,Backup)
 
dwAddr =GetProcAddress_(GetModuleHandle_(LibName), FuncName)
OriginalAdress=dwAddr
Result=ReadProcessMemory_(GetCurrentProcess_(), dwAddr, Backup, 6, @readbytes) ;save old Bytes
 
 
 Dim a.b(6)
 a(0)=$e9
 a(5)=$C3
 
 dwCalc = NewFunctionAddress - dwAddr - 5;   //((to)-(from)-5)
 
 CopyMemory(@dwCalc,@a(1),4)
 
 Result = WriteProcessMemory_(GetCurrentProcess_(), dwAddr, @a(0), 6, @written);
 
EndProcedure
 
Procedure UnHook(Libname.s,FuncName.s,Backup)
 
dwAddr = GetProcAddress_(GetModuleHandle_(LibName), FuncName)
Result= WriteProcessMemory_(GetCurrentProcess_(), dwAddr, Backup, 6, @written);

EndProcedure



Procedure MyRegisterClassEx(*Clas.WNDCLASSEX)

 Debug "RegisterClassEx : "
 Debug "Class Name : " + PeekS(*Clas\lpszClassName)
 
 Debug "Procedure : " + Str(*Clas\lpfnWndProc)
 Debug "Cursor : " + Cursor(*Clas\hCursor)
 Debug "Background : " + Background(*Clas\hbrBackground)
 
 If *Clas\style <> 0
  Debug "style : " + Flags(*Clas\style)
 Else
  Debug "style : #NULL"
 EndIf
 
 Debug "cbClsExtra : " + Str(*Clas\cbClsExtra)
 Debug "cbWndExtra : " + Str(*Clas\cbWndExtra)
 
 If *Clas\hInstance <> 0
  Debug "hInstance : " + Str(*Clas\hInstance)
 Else
  Debug "hInstance : #NULL"
 EndIf
 
 Debug "hIcon : " + Str(*Clas\hIcon)
 
 If *Clas\lpszMenuName <> 0
  Debug "lpszMenuName : " + PeekS(*Clas\lpszMenuName)
 Else
  Debug "lpszMenuName : #NULL"
 EndIf
 
 If *Clas\hIconSm <> 0
  Debug "hIconSm : " + Str(*Clas\hIconSm)
 Else
  Debug "hIconSm : #NULL"
 EndIf
 
 Debug "------------------------"
 
 UnHook("user32.dll", "RegisterClassExA", @RegisterClassExA(0))
 ret = RegisterClassEx_(*Clas)
 Hook("user32.dll", "RegisterClassExA", @MyRegisterClassEx(), @RegisterClassExA(0));
  
 ProcedureReturn ret
 
EndProcedure

Procedure MyRegisterClassA(*Clas.WNDCLASSEX)

 Debug "RegisterClassA : "
 Debug "Name Number : " + Str(*Clas\lpszClassName)
 
 ;Debug "Class Name : " + PeekS(*Clas\lpszClassName)
 
 Debug "Procedure : " + Str(*Clas\lpfnWndProc)
 Debug "Cursor : " + Cursor(*Clas\hCursor)
 Debug "Background : " + Background(*Clas\hbrBackground)
 
 If *Clas\style <> 0
  Debug "style : " + Flags(*Clas\style)
 Else
  Debug "style : #NULL"
 EndIf
 
 Debug "cbClsExtra : " + Str(*Clas\cbClsExtra)
 Debug "cbWndExtra : " + Str(*Clas\cbWndExtra)
 
 If *Clas\hInstance <> 0
  Debug "hInstance : " + Str(*Clas\hInstance)
 Else
  Debug "hInstance : #NULL"
 EndIf
  
 If hIcon <> 0
  Debug "hIcon : " + Str(hIcon)
 Else
  Debug "hIcon : #NULL"
 EndIf
 
 If *Clas\lpszMenuName <> 0
  Debug "lpszMenuName : " + PeekS(*Clas\lpszMenuName)
 Else
  Debug "lpszMenuName : #NULL"
 EndIf
  
 If *Clas\hIconSm <> 0
  Debug "hIconSm : " + Str(*Clas\hIconSm)
 Else
  Debug "hIconSm : #NULL"
 EndIf

 Debug "------------------------"
 
 UnHook("user32.dll", "RegisterClassA", @RegisterClassA(0))
 ret = RegisterClass_(*Clas)
 Hook("user32.dll", "RegisterClassA", @MyRegisterClassA(), @RegisterClassA(0));
 
 ProcedureReturn ret
 
EndProcedure

Procedure MyCreateWindowEx(dwExStyle, *lpClassName, *lpWindowName, dwStyle, x, y, nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam)
  
 Debug "CreateWindowEx : "
 
 If dwExStyle <> 0 
  Debug "dwExStyle : " + Flags(dwExStyle)
 Else
  Debug "dwExStyle : #NULL"
 EndIf
 
 Debug "lpClassName : " + PeekS(*lpClassName)
 
 If *lpWindowName <> 0
  Debug "lpWindowName : " + PeekS(*lpWindowName)
 Else
  Debug "lpWindowName : #NULL"
 EndIf
 
 If dwStyle <> 0 
  Debug "dwStyle : " + Flags(dwStyle)
 Else
  Debug "dwStyle : #NULL"
 EndIf
 
 
 Debug "x : " + Str(x) 
 Debug "y : " + Str(y)
 Debug "nWidth : " + Str(nWidth)
 Debug "nHeight : " + Str(nHeight)
 
 If hWndParent <> 0
  windowtext.s = ""
  GetWindowText_(hWndParent, @windowtext, #MAX_PATH)
  If windowtext <> ""
    Debug "hWndParent : " + Str(hWndParent) + " - " + windowtext
  Else
    Debug "hWndParent : " + Str(hWndParent)
  EndIf
 Else
  Debug "hWndParent : #NULL"
 EndIf
 
 If hMenu <> 0
  Debug "hMenu : " + Str(hMenu)
 Else
  Debug "hMenu : #NULL"
 EndIf
 
 If hInstance <> 0
  Debug "hInstance : " + Str(hInstance)
 Else
  Debug "hInstance : #NULL"
 EndIf
  
 If lpParam <> 0
  Debug "lpParam : " + Str(lpParam)
 Else
  Debug "lpParam : #NULL"
 EndIf
 
 Debug "------------------------"
 
 UnHook("user32.dll", "CreateWindowExA", @CreateWindowExA(0))
 ret = CreateWindowEx_(dwExStyle, *lpClassName, *lpWindowName, dwStyle, x, y, nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam)
 Hook("user32.dll", "CreateWindowExA", @MyCreateWindowEx(), @CreateWindowExA(0));
  
 ProcedureReturn ret
 
EndProcedure

 
Hook("user32.dll", "RegisterClassExA", @MyRegisterClassEx(), @RegisterClassExA(0));
Hook("user32.dll", "RegisterClassA", @MyRegisterClassA(), @RegisterClassA(0));
Hook("user32.dll", "CreateWindowExA", @MyCreateWindowEx(), @CreateWindowExA(0));


If OpenWindow(0, 0, 0, 230, 90, "Event handling example...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)


   ContainerGadget(#PB_Any, 0, 0, 230, 90)
   ButtonGadget  (1, 10, 10, 200, 20, "Click me")
   CheckBoxGadget(2, 10, 40, 200, 20, "Check me")
   ListIconGadget(0,  10,  25, 300, 70, "Column 1", 100)


   Repeat
     Event = WaitWindowEvent()
   Until Event = #PB_Event_CloseWindow
 EndIf
Enjoy!

Posted: Mon Aug 31, 2009 3:33 pm
by srod
Crashes on Vista unless running under an admin account or the 'request administrator mode' compiler setting is checked.

Posted: Mon Aug 31, 2009 3:46 pm
by Peyman
srod wrote:Crashes on Vista unless running under an admin account or the 'request administrator mode' compiler setting is checked.
oh, i dont have vista thanks for say this.

Posted: Mon Aug 31, 2009 4:01 pm
by Rings
plz change topic to a readable and usefull one.
a 'hack' is something different imho...

Posted: Mon Aug 31, 2009 7:41 pm
by Peyman
Rings wrote:plz change topic to a readable and usefull one.
a 'hack' is something different imho...
yea you alright, so mmmmmm.., but what name is better you suggest a good topic name.

Posted: Mon Aug 31, 2009 8:02 pm
by Demivec
Why not "Creating a window for replacing ContainerGadget"? :wink:

Posted: Mon Aug 31, 2009 10:06 pm
by Peyman
Demivec wrote:Why not "Creating a window for replacing ContainerGadget"? :wink:
if your guestion is why i want do this i must say because i want use COMatePlus in a dll for other programs and other programming language that cant work with com, COMatePlus is very easy to learn (thank srod) and can be a lib or dll or plugin for other Program and programming lang, but have a problem in COMate_CreateActiveXControl because when we call this func, this create a ContainerGadget on our window that before called it but this job just good for PureBasic Programs so im trying to create something like ContainerGadget on all window and im do it with this Class Hunting on create window but one tiny problem comes.
http://purebasic.fr/english/viewtopic.p ... &start=105

Posted: Mon Aug 31, 2009 10:11 pm
by srod
Peryman, this is not the approach to take if you simply want to export the COMate_CreateActiveXControl() function in a dll.

You don't need to alter PB's container gadget in any way. Simply alter the function by adding an extra parameter which takes the handle of a parent window. Then use the function UseGadgetList() to ensure that the container is added to this parent window etc. That is all you need do.

I think you are wasting your time, however, in trying to convert COMatePLUS to a dll for use with other languages. It is going to be a hell of a lot of work dealing with strings and the like. Also, some other languages will not be able to make use of the event procedures etc.

Posted: Mon Aug 31, 2009 10:46 pm
by Peyman
yea im wasting my time on do this but learn many things in this tiny time :D, so im happy, maybe know im want work on a Windows Hunter :lol: .
Thanks srod.

Posted: Tue Sep 01, 2009 8:05 am
by Rings
changed topic....
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited