PureBasic Forums - English

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

CreateGadget

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

Page 1 of 1

CreateGadget

Posted: Fri Sep 02, 2011 6:39 pm
by User_Russian
Please tell me how to compile this code in PureBasic 4.51 x64 (Windows)?
In the x86 version is compiled without errors, but when compiling in x64 appears this error:
Image

Code: Select all

Structure PB_Gadget_VT
  GadgetType.i
  SizeOf.i
  GadgetCallback.i
  FreeGadget.i
  GetGadgetState.i
  SetGadgetState.i
  GetGadgetText.i
  SetGadgetText.i
  AddGadgetItem2.i
  AddGadgetItem3.i
  RemoveGadgetItem.i
  ClearGadgetItemList.i
  ResizeGadget.i
  CountGadgetItems.i
  GetGadgetItemState.i
  SetGadgetItemState.i
  GetGadgetItemText.i
  SetGadgetItemText.i
  OpenGadgetList2.i
  GadgetX.i
  GadgetY.i
  GadgetWidth.i
  GadgetHeight.i
  HideGadget.i
  AddGadgetColumn.i
  RemoveGadgetColumn.i
  GetGadgetAttribute.i
  SetGadgetAttribute.i
  GetGadgetItemAttribute2.i
  SetGadgetItemAttribute2.i
  SetGadgetColor.i
  GetGadgetColor.i
  SetGadgetItemColor2.i
  GetGadgetItemColor2.i
  SetGadgetItemData.i
  GetGadgetItemData.i
EndStructure

CompilerIf Defined(PB_Gadget, #PB_Structure) = #False
Structure PB_Gadget
  Gadget.i
  *VT.PB_GadgetVT
  UserData.i
  OldCallback.i
  Daten.l[4]
EndStructure
CompilerEndIf

  ;GetGadgetParent
;
;                  Rueckgabe : Parent Handle
;

!EXTRN _PB_Object_GetOrAllocateID@8
!EXTRN _PB_Gadget_RegisterGadget@16
!EXTRN _PB_Gadget_RegisterGadget_UNICODE@16
!EXTRN _PB_Gadget_Objects
!EXTRN _PB_Object_GetThreadMemory@4
!EXTRN _PB_Gadget_Globals
Procedure GetGadgetParent()

  !MOV   Eax,[_PB_Gadget_Globals]
  !push  eax
  !call  _PB_Object_GetThreadMemory@4
  !MOV   Eax,[Eax]
  ProcedureReturn
EndProcedure

Structure Gadget_Info
  OldCallback.i
  DestroyProc.i
  PBID.i
EndStructure

Procedure RegGadget_Callback(hwnd, msg, wparam, lparam)
  Protected *Gadget_Info.Gadget_Info = GetProp_(hwnd, "GadgetInfo")
  Protected OldProc = *Gadget_Info\OldCallback
  
  If msg = #WM_NCDESTROY
    If *Gadget_Info
      If *Gadget_Info\DestroyProc
        CallFunctionFast(*Gadget_Info\DestroyProc, *Gadget_Info\pbid)
      EndIf
    EndIf
    RemoveProp_(hwnd, "GadgetInfo")
    FreeMemory(*Gadget_Info)
  EndIf
  
  ProcedureReturn CallWindowProc_(OldProc, hwnd, msg, wparam, lparam)
EndProcedure


Procedure RegisterGadget(hwnd.i, ID.i, DestroyProc.i , *vttemp.PB_Gadget_VT)
  Protected *Gadget_Info.Gadget_Info
  Protected OldCallback.l
  Protected *vt.PB_Gadget_VT
  Shared RegisterGadget_temphwnd, RegisterGadget_tempid
  
  If ((hwnd = 0) Or (id < #PB_Any))
    ProcedureReturn 0
  EndIf
  
  *vt = AllocateMemory(SizeOf(PB_Gadget_VT))
  If *vttemp <> 0
    CopyMemory(*vttemp,*vt,SizeOf(PB_Gadget_VT))
  EndIf
  
  RegisterGadget_temphwnd = hwnd
  RegisterGadget_tempid   = Id
  
  !MOV   esi,dword[v_RegisterGadget_tempid]
  !MOV   edi,[v_RegisterGadget_temphwnd]
  !PUSH  dword[v_RegisterGadget_tempid]
  !PUSH  dword [_PB_Gadget_Objects]   
  !CALL  _PB_Object_GetOrAllocateID@8 
  
  !PUSH  dword[p.p_vt]      ; vt 
  !PUSH  edi                ; hwnd 
  !PUSH  eax                ; *gadget
  !PUSH  esi                ; ID
  
  
  CompilerIf #PB_Compiler_Unicode
    !CALL  _PB_Gadget_RegisterGadget_UNICODE@16
  CompilerElse
    !CALL  _PB_Gadget_RegisterGadget@16
  CompilerEndIf
  
  !mov   [p.v_hwnd],eax
  
  If DestroyProc
    
    *Gadget_Info = AllocateMemory(SizeOf(Gadget_Info))
    
    If id = #PB_Any
      *Gadget_Info\PBID = hwnd
    Else
      *Gadget_Info\PBID = ID
    EndIf   
    
    *Gadget_Info\DestroyProc = DestroyProc
    *Gadget_Info\OldCallback = SetWindowLong_(GadgetID(*Gadget_Info\PBID), #GWL_WNDPROC, @RegGadget_Callback())
    
    SetProp_(GadgetID(*Gadget_Info\PBID), "GadgetInfo", *Gadget_Info)
    
  EndIf
  
  ProcedureReturn hwnd
EndProcedure

Procedure Create_Gadget(Id.i, ClassName.s, Text.s, Style.i, X.l, Y.l, CX.l, CY.l, ExStyle.i=0, DestroyProc.i=0, *vt.PB_Gadget_VT=0)
  Protected hwnd.i
  Protected Parent.i    = GetGadgetParent()
  Protected hInstance.i = GetModuleHandle_(0)
  
  hwnd = CreateWindowEx_(ExStyle, ClassName, Text, Style, X, Y, CX, CY, Parent, 0, hInstance, 0)
  SendMessage_(hWnd, #WM_SETFONT, GetGadgetFont(#PB_Default), 1);

  If hwnd = #False : ProcedureReturn #False : EndIf
  
  ProcedureReturn RegisterGadget(hwnd, ID, DestroyProc, *vt)
EndProcedure

Re: CreateGadget

Posted: Fri Sep 02, 2011 7:13 pm
by ts-soft
The ASM-Code is for x86 only, you have to change the registers. The first 2 members of PB_GadgetVT a longs:

Code: Select all

Structure PB_GadgetVT
  GadgetType.l   
  SizeOf.l
and so on ...

Re: CreateGadget

Posted: Sat Sep 03, 2011 11:39 am
by User_Russian
Rewrote the program and now it is compiled for x86 and x64 mode.
Maybe someone will prove useful.

Code: Select all

Structure My_PB_Gadget_VT
  GadgetType.i
  SizeOf.i
  GadgetCallback.i
  FreeGadget.i
  GetGadgetState.i
  SetGadgetState.i
  GetGadgetText.i
  SetGadgetText.i
  AddGadgetItem2.i
  AddGadgetItem3.i
  RemoveGadgetItem.i
  ClearGadgetItemList.i
  ResizeGadget.i
  CountGadgetItems.i
  GetGadgetItemState.i
  SetGadgetItemState.i
  GetGadgetItemText.i
  SetGadgetItemText.i
  OpenGadgetList2.i
  GadgetX.i
  GadgetY.i
  GadgetWidth.i
  GadgetHeight.i
  HideGadget.i
  AddGadgetColumn.i
  RemoveGadgetColumn.i
  GetGadgetAttribute.i
  SetGadgetAttribute.i
  GetGadgetItemAttribute2.i
  SetGadgetItemAttribute2.i
  SetGadgetColor.i
  GetGadgetColor.i
  SetGadgetItemColor2.i
  GetGadgetItemColor2.i
  SetGadgetItemData.i
  GetGadgetItemData.i
EndStructure


Structure My_PB_Gadget
  Gadget.i
  *VT.PB_Gadget_VT
  UserData.i
  OldCallback.i
  Daten.i[4]
EndStructure


Structure My_Gadget_Info
  OldCallback.i
  DestroyProc.i
  PBID.i
EndStructure

Import ""
  CompilerIf Defined(*PB_GADGET_OBJECTS, #PB_Variable)=#False
    CompilerIf #PB_Compiler_Processor=#PB_Processor_x64
      *PB_GADGET_OBJECTS As "PB_Gadget_Objects"
    CompilerElse
      *PB_GADGET_OBJECTS As "_PB_Gadget_Objects"
    CompilerEndIf
  CompilerEndIf
  
  CompilerIf Defined(*PB_GADGET_GLOBALS, #PB_Variable)=#False
    CompilerIf #PB_Compiler_Processor=#PB_Processor_x64
      *PB_GADGET_GLOBALS As "PB_Gadget_Globals"
    CompilerElse
      *PB_GADGET_GLOBALS As "_PB_Gadget_Globals"
    CompilerEndIf
  CompilerEndIf
  
  CompilerIf Defined(PB_Object_GetThreadMemory, #PB_Procedure)=#False
    PB_Object_GetThreadMemory(*PB_Object)
  CompilerEndIf
  
  CompilerIf Defined(PB_Object_GetOrAllocateID, #PB_Procedure)=#False
    PB_Object_GetOrAllocateID(*PB_Object, ID)
  CompilerEndIf
  
  CompilerIf Defined(CreateGadgetWindow, #PB_Procedure)=#False
    CompilerIf #PB_Compiler_Unicode
      CompilerIf #PB_Compiler_Processor=#PB_Processor_x64
        PB_Gadget_RegisterGadget(ID, *Gadget, hwnd, *vt.My_PB_Gadget_VT)
      CompilerElse
        PB_Gadget_RegisterGadget(ID, *Gadget, hwnd, *vt.My_PB_Gadget_VT) As "_PB_Gadget_RegisterGadget_UNICODE@16"
      CompilerEndIf
    CompilerElse
      PB_Gadget_RegisterGadget(ID, *Gadget, hwnd, *vt.My_PB_Gadget_VT)
    CompilerEndIf
  CompilerEndIf
  
  CompilerIf Defined(PB_Gadget_SendGadgetCommand, #PB_Procedure)=#False
    PB_Gadget_SendGadgetCommand(hwnd, EventType)
  CompilerEndIf
EndImport


Procedure RegGadget_Callback(hwnd, msg, wparam, lparam)
  Protected *Gadget_Info.My_Gadget_Info = GetProp_(hwnd, "GadgetInfo")
  Protected OldProc = *Gadget_Info\OldCallback
  
  If msg = #WM_NCDESTROY
    If *Gadget_Info
      If *Gadget_Info\DestroyProc
        CallFunctionFast(*Gadget_Info\DestroyProc, *Gadget_Info\pbid)
      EndIf
    EndIf
    RemoveProp_(hwnd, "GadgetInfo")
    FreeMemory(*Gadget_Info)
  EndIf
  
  ProcedureReturn CallWindowProc_(OldProc, hwnd, msg, wparam, lparam)
EndProcedure


Procedure RegisterGadget(hwnd.i, ID.i, DestroyProc.i , *vttemp.My_PB_Gadget_VT)
  Protected *Gadget_Info.My_Gadget_Info
  Protected OldCallback.i
  Protected *vt.My_PB_Gadget_VT
  
  If ((hwnd = 0) Or (id < #PB_Any))
    ProcedureReturn 0
  EndIf
  
  *vt = AllocateMemory(SizeOf(My_PB_Gadget_VT))
  If *vttemp <> 0
    CopyMemory(*vttemp,*vt,SizeOf(My_PB_Gadget_VT))
  EndIf

  *Gadget=PB_Object_GetOrAllocateID(*PB_GADGET_OBJECTS, ID)
  result=PB_Gadget_RegisterGadget(ID, *Gadget, hwnd, *vt)
  
  If DestroyProc
    
    *Gadget_Info = AllocateMemory(SizeOf(My_Gadget_Info))
    
    If id = #PB_Any
      *Gadget_Info\PBID = hwnd
    Else
      *Gadget_Info\PBID = ID
    EndIf   
    
    *Gadget_Info\DestroyProc = DestroyProc
    *Gadget_Info\OldCallback = SetWindowLong_(GadgetID(*Gadget_Info\PBID), #GWL_WNDPROC, @RegGadget_Callback())
    
    SetProp_(GadgetID(*Gadget_Info\PBID), "GadgetInfo", *Gadget_Info)
    
  EndIf
  
  ProcedureReturn hwnd
EndProcedure

Procedure Create_Gadget(Id.i, ClassName.s, Text.s, Style.i, X.l, Y.l, CX.l, CY.l, ExStyle.i=0, DestroyProc.i=0, *vt.My_PB_Gadget_VT=0)
  Protected hwnd.i
  Protected Parent.i    = PeekI(PB_Object_GetThreadMemory(*PB_GADGET_GLOBALS))
  Protected hInstance.i = GetModuleHandle_(0)
  
  hwnd = CreateWindowEx_(ExStyle, ClassName, Text, Style, X, Y, CX, CY, Parent, 0, hInstance, 0)
  SendMessage_(hWnd, #WM_SETFONT, GetGadgetFont(#PB_Default), 1);

  If hwnd = #False : ProcedureReturn #False : EndIf
  
  ProcedureReturn RegisterGadget(hwnd, ID, DestroyProc, *vt)
EndProcedure

Re: CreateGadget

Posted: Sat Sep 03, 2011 12:20 pm
by ts-soft
some error replacement and optimation:

Code: Select all

EnableExplicit

Structure My_PB_Gadget_VT
  GadgetType.l
  SizeOf.l
  GadgetCallback.i
  FreeGadget.i
  GetGadgetState.i
  SetGadgetState.i
  GetGadgetText.i
  SetGadgetText.i
  AddGadgetItem2.i
  AddGadgetItem3.i
  RemoveGadgetItem.i
  ClearGadgetItemList.i
  ResizeGadget.i
  CountGadgetItems.i
  GetGadgetItemState.i
  SetGadgetItemState.i
  GetGadgetItemText.i
  SetGadgetItemText.i
  OpenGadgetList2.i
  GadgetX.i
  GadgetY.i
  GadgetWidth.i
  GadgetHeight.i
  HideGadget.i
  AddGadgetColumn.i
  RemoveGadgetColumn.i
  GetGadgetAttribute.i
  SetGadgetAttribute.i
  GetGadgetItemAttribute2.i
  SetGadgetItemAttribute2.i
  SetGadgetColor.i
  GetGadgetColor.i
  SetGadgetItemColor2.i
  GetGadgetItemColor2.i
  SetGadgetItemData.i
  GetGadgetItemData.i
EndStructure


Structure My_PB_Gadget
  Gadget.i
  *VT.PB_Gadget_VT
  UserData.i
  OldCallback.i
  Daten.l[4]
EndStructure


Structure My_Gadget_Info
  OldCallback.i
  DestroyProc.i
  PBID.i
EndStructure

Import ""
  PB_Gadget_Objects
  PB_Gadget_Globals
  PB_Object_GetThreadMemory(*PB_Object)
  PB_Object_GetOrAllocateID(*PB_Object, ID)
  PB_Gadget_RegisterGadget(ID, *Gadget, hwnd, *vt.My_PB_Gadget_VT)
  PB_Gadget_SendGadgetCommand(hwnd, EventType)
EndImport


Procedure RegGadget_Callback(hwnd, msg, wparam, lparam)
  Protected *Gadget_Info.My_Gadget_Info = GetProp_(hwnd, "GadgetInfo")
  Protected OldProc = *Gadget_Info\OldCallback
 
  If msg = #WM_NCDESTROY
    If *Gadget_Info
      If *Gadget_Info\DestroyProc
        CallFunctionFast(*Gadget_Info\DestroyProc, *Gadget_Info\pbid)
      EndIf
    EndIf
    RemoveProp_(hwnd, "GadgetInfo")
    FreeMemory(*Gadget_Info)
  EndIf
 
  ProcedureReturn CallWindowProc_(OldProc, hwnd, msg, wparam, lparam)
EndProcedure


Procedure RegisterGadget(hwnd.i, ID.i, DestroyProc.i , *vttemp.My_PB_Gadget_VT)
  Protected *Gadget_Info.My_Gadget_Info
  Protected OldCallback.i
  Protected *vt.My_PB_Gadget_VT
  Protected *Gadget, result
 
  If ((hwnd = 0) Or (id < #PB_Any))
    ProcedureReturn 0
  EndIf
 
  *vt = AllocateMemory(SizeOf(My_PB_Gadget_VT))
  If *vttemp <> 0
    CopyMemory(*vttemp,*vt,SizeOf(My_PB_Gadget_VT))
  EndIf

  *Gadget = PB_Object_GetOrAllocateID(PB_GADGET_OBJECTS, ID)
  result = PB_Gadget_RegisterGadget(ID, *Gadget, hwnd, *vt)
 
  If DestroyProc
   
    *Gadget_Info = AllocateMemory(SizeOf(My_Gadget_Info))
   
    If id = #PB_Any
      *Gadget_Info\PBID = hwnd
    Else
      *Gadget_Info\PBID = ID
    EndIf   
   
    *Gadget_Info\DestroyProc = DestroyProc
    *Gadget_Info\OldCallback = SetWindowLongPtr_(GadgetID(*Gadget_Info\PBID), #GWL_WNDPROC, @RegGadget_Callback())
   
    SetProp_(GadgetID(*Gadget_Info\PBID), "GadgetInfo", *Gadget_Info)
   
  EndIf
 
  ProcedureReturn hwnd
EndProcedure

Procedure Create_Gadget(Id.i, ClassName.s, Text.s, Style.i, X.l, Y.l, CX.l, CY.l, ExStyle.i=0, DestroyProc.i=0, *vt.My_PB_Gadget_VT=0)
  Protected hwnd.i
  Protected Parent.i    = PeekI(PB_Object_GetThreadMemory(PB_GADGET_GLOBALS))
  Protected hInstance.i = GetModuleHandle_(0)
 
  hwnd = CreateWindowEx_(ExStyle, ClassName, Text, Style, X, Y, CX, CY, Parent, 0, hInstance, 0)
  SendMessage_(hWnd, #WM_SETFONT, GetGadgetFont(#PB_Default), 1);

  If hwnd = #False : ProcedureReturn #False : EndIf
 
  ProcedureReturn RegisterGadget(hwnd, ID, DestroyProc, *vt)
EndProcedure
greetings - Thomas
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited