PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Gadget erstellen mit PB4

https://www.purebasic.fr/german/viewtopic.php?t=8071

Seite 1 von 4

Gadget erstellen mit PB4

Verfasst: 25.04.2006 13:56
von ts-soft
Hier eine Include-Datei, mit der echte Gadgets in reinem Basic erstellt werden können.

Update: Gadgets funktionieren auch im Unicode und/oder Threadsafe Mode!

Code: Alles auswählen

; Include zum Erstellen von Gadgets in reinem Basic!
; Autoren: Hallodri und TS-Soft
; Version 1.1  vom 30.04.2006
; Getestet mit PureBasic 4.0 Beta 11

Prototype.l PB_Object_GetOrAllocateID(Objects.l,ID.l)
Prototype.l PB_Gadget_RegisterGadget(ID.l,*Gadget.l,hwnd.l,*GadgetVT.l)

Enumeration
  #PB_GadgetType_Unknown 
  #PB_GadgetType_Button
  #PB_GadgetType_String
  #PB_GadgetType_Text
  #PB_GadgetType_CheckBox
  #PB_GadgetType_Option
  #PB_GadgetType_ListView
  #PB_GadgetType_Frame3D
  #PB_GadgetType_ComboBox
  #PB_GadgetType_Image
  #PB_GadgetType_HyperLink
  #PB_GadgetType_Container
  #PB_GadgetType_ListIcon
  #PB_GadgetType_IPAddress
  #PB_GadgetType_ProgressBar
  #PB_GadgetType_ScrollBar
  #PB_GadgetType_ScrollArea
  #PB_GadgetType_TrackBar
  #PB_GadgetType_Web
  #PB_GadgetType_ButtonImage
  #PB_GadgetType_Calendar
  #PB_GadgetType_Date
  #PB_GadgetType_Editor
  #PB_GadgetType_ExplorerList
  #PB_GadgetType_ExplorerTree
  #PB_GadgetType_ExplorerCombo
  #PB_GadgetType_Spin
  #PB_GadgetType_Tree
  #PB_GadgetType_Panel
  #PB_GadgetType_Splitter
  #PB_GadgetType_MDI
  #PB_GadgetType_Scintilla 
  #PB_GadgetType_LastEnum
EndEnumeration

CompilerIf Defined(PB_GadgetVT, #PB_Structure) = #False
Structure PB_GadgetVT 
  GadgetType.l   
  SizeOf.l        
  GadgetCallback.l
  FreeGadget.l
  GetGadgetState.l
  SetGadgetState.l
  GetGadgetText.l
  SetGadgetText.l
  AddGadgetItem2.l
  AddGadgetItem3.l
  RemoveGadgetItem.l
  ClearGadgetItemList.l
  ResizeGadget.l
  CountGadgetItems.l
  GetGadgetItemState.l
  SetGadgetItemState.l
  GetGadgetItemText.l
  SetGadgetItemText.l
  OpenGadgetList2.l
  GadgetX.l
  GadgetY.l
  GadgetWidth.l
  GadgetHeight.l
  HideGadget.l
  AddGadgetColumn.l
  RemoveGadgetColumn.l
  GetGadgetAttribute.l
  SetGadgetAttribute.l
  GetGadgetItemAttribute2.l
  SetGadgetItemAttribute2.l
  SetGadgetColor.l
  GetGadgetColor.l
  SetGadgetItemColor2.l
  GetGadgetItemColor2.l
  SetGadgetItemData.l
  GetGadgetItemData.l
EndStructure
CompilerEndIf

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

;GetGadgetParent                                                    
;                                                                   
;                  Rueckgabe : Parent Handle                        
;                                                                   
Procedure GetGadgetParent() 
  !EXTRN _PB_Object_GetThreadMemory@4
  !EXTRN _PB_Gadget_Globals
  !MOV   Eax,[_PB_Gadget_Globals]
  !push  eax
  !call  _PB_Object_GetThreadMemory@4
  !MOV   Eax,[Eax]
  ProcedureReturn
  CreateGadgetList(0)
EndProcedure 

Structure Gadget_Info
  OldCallback.l
  DestroyProc.l
  PBID.l
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


;RegisterGadget                                                     
;                hwnd.l              ; Handle des Controls          
;                ID.l                ; PB_ID                        
;                DestroyProc.l=0     ; OPTIONAL Proc zum aufraeumen 
;                *vt.PB_GadgetVT = 0 ; OPTIONAL Gadget VT           
;                                                                   
;                Rueckgabe  :  wenn ID = -1 / PB_Any =  PB_ID       
;                              snst Handle des Controls             
Procedure RegisterGadget(hwnd.l, ID.l, DestroyProc.l = 0, *vttemp.PB_GadgetVT = 0)
  Protected PB_Object_GetOrAllocateID.PB_Object_GetOrAllocateID
  Protected PB_Gadget_RegisterGadget.PB_Gadget_RegisterGadget
  Protected PB_Gadget_Objects.l
  Protected *Gadget.PB_Gadget, *Gadget_Info.Gadget_Info
  Protected OldCallback.l
  Protected *vt.PB_GadgetVT
 
  If ((hwnd = 0) Or (id < #PB_Any))
    ProcedureReturn 0
  EndIf
 
  *vt = AllocateMemory(SizeOf(PB_GadgetVT))
  If *vttemp <> 0
    CopyMemory(*vttemp,*vt,SizeOf(PB_GadgetVT))
  EndIf
 
  CompilerIf #PB_Compiler_Unicode
    !EXTRN  _PB_Gadget_RegisterGadget_UNICODE@16
    !MOV   [p.v_PB_Gadget_RegisterGadget] ,dword _PB_Gadget_RegisterGadget_UNICODE@16
  CompilerElse
    !EXTRN _PB_Gadget_RegisterGadget@16
    !MOV   [p.v_PB_Gadget_RegisterGadget] ,dword _PB_Gadget_RegisterGadget@16
  CompilerEndIf
 
  !EXTRN _PB_Object_GetOrAllocateID@8 
  !EXTRN _PB_Gadget_Objects
  !MOV   [p.v_PB_Object_GetOrAllocateID],dword _PB_Object_GetOrAllocateID@8
  !MOV   eax,[_PB_Gadget_Objects]
  !MOV   [p.v_PB_Gadget_Objects],eax
 
  *Gadget = PB_Object_GetOrAllocateID(PB_Gadget_Objects, ID)
  hwnd    = PB_Gadget_RegisterGadget(ID, *Gadget,hwnd,*vt)
 
  If DestroyProc
    *Gadget_Info = AllocateMemory(SizeOf(Gadget_Info))
    *Gadget_Info\DestroyProc = DestroyProc
    *Gadget_Info\OldCallback = SetWindowLong_(*Gadget\Gadget, #GWL_WNDPROC, @RegGadget_Callback()) 
    If id = #PB_Any
      *Gadget_Info\PBID = hwnd
    Else
      *Gadget_Info\PBID = ID
    EndIf   
    SetProp_(*Gadget\Gadget, "GadgetInfo", *Gadget_Info) 
  EndIf
 
  ProcedureReturn hwnd
EndProcedure 
; CreateGadget
;   Id.l        ; Gadget, kann auch #PB_Any sein!
;   ClassName.s ; Windows-Klassenname (muss Windows bekannt sein)
;   Text.s      ; ggf. Text/Überschrift
;   Style.l     ; Stil
;   X.l, Y.l    ; linke, obere Ecke des Gadgets auf dem Fenster
;   DX.l, DY.l  ; Größe des Gadgets
;   Optional:
;     ExStyle.l       ; erweiterter Stil
;     DestroyProc.l   ; Procedure-Adresse, einer Procedure zum Aufräumen
;     *vt.PB_GadgetVT ; Pointer zu einer gefüllten Structurevariable mit GadgetFunktionen!
;
; Rückgabe: hWnd oder ID (bei #PB_Any)
Procedure CreateGadget(Id.l, ClassName.s, Text.s, Style.l, X.l, Y.l, DX.l, DY.l, ExStyle.l = 0, DestroyProc.l = 0, *vt.PB_GadgetVT = 0)
  Protected hwnd.l 
  Protected Parent.l    = GetGadgetParent()
  Protected hInstance.l = GetModuleHandle_(0) 
  
  hwnd = CreateWindowEx_(ExStyle, ClassName, Text, Style, X, Y, DX, DY, 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
einfaches Beispiel:

Code: Alles auswählen

; Testprogramm für CreateGadget ;)

XIncludeFile "CreateGadget.pbi"

If LoadLibrary_("Scintilla.dll") = #False : MessageRequester("", "Scintilla.dll nicht gefunden") : End : EndIf

Procedure MySciEdit(Gadget, x, y, width, height)
  ProcedureReturn CreateGadget(Gadget, "Scintilla", "", #WS_CHILD | #WS_VISIBLE, x, y, width, height, #WS_EX_CLIENTEDGE)
EndProcedure

Procedure MyStatic(Gadget, x, y, width, height, Text.s)
  ProcedureReturn CreateGadget(Gadget, "Static", Text, #WS_CHILD|#WS_VISIBLE|#SS_CENTER|#SS_SUNKEN, x, y, width, height)
EndProcedure

Procedure MyButton(Gadget, x, y, width, height, Text.s)
  ProcedureReturn CreateGadget(Gadget, "Button", Text, #WS_CHILD | #WS_VISIBLE, x, y, width, height)
EndProcedure

If OpenWindow(0, #PB_Ignore, 0, 250, 480, "Test")
  CreateGadgetList(WindowID(0))

  MySciEdit(0, 0, 0, 250, 400)
  MyButton(1, 10, 440, 50, 25, "Button 1")
  GadgetToolTip(1, "Button 1")
  MyButton(2, 70, 440, 50, 25, "Button 2")
  GadgetToolTip(2, "Button 2")
  btn3 = MyButton(#PB_Any, 130, 440, 50, 25, "Button 3")
  GadgetToolTip(btn3, "Button 3")
  MyButton(4, 190, 440, 50, 25, "")
  GadgetToolTip(4, "Button 4")
  MyStatic(5, 10, 410, 50, 20, "Label 1")
  MyStatic(6, 70, 410, 50, 20, "Label 2")
  MyStatic(7, 130, 410, 50, 20, "Label 3")
  MyStatic(8, 190, 410, 50, 20, "Label 4")

  SetGadgetText(0, "Feel the ..Pure.. Power")
  SetGadgetText(4, "Button 4")

EndIf

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          Debug "Button 1"
          If GetGadgetText(1) = "Button 1"
            SetGadgetText(1, "PushMe")
          Else
            SetGadgetText(1, "Button 1")
          EndIf
        Case 2
          Debug "Button 2"
          Debug GetGadgetText(0)
        Case btn3
          Debug "Button 3"
        Case 4
          Debug "Button 4"
      EndSelect
  EndSelect
ForEver
Desweiteren haben wir ein Paket mit Beispielen erstellt, in dem insgesamt 4 verschiedenen Gadgets erstellt werden.

Download

Vorschau:
Bild

Verfasst: 25.04.2006 14:25
von freedimension
Ui, die Säulen sind ja mal hübsch :allright:

Verfasst: 25.04.2006 17:14
von ts-soft
freedimension hat geschrieben:Ui, die Säulen sind ja mal hübsch :allright:
Naja, es geht mehr darum, das erzeugte Controls, nativ gemalt, per API oder
aus einer DLL, als Gadget registriert werden können :D

Verfasst: 25.04.2006 17:21
von Leonhard
Danke, damit kann ich ja endlich ohne den Firlefanz von SendMessage_(...) arbeiten...

Verfasst: 25.04.2006 17:21
von Kaeru Gaman
also wär das ne basis für sozusagen "free skinning"?

also, oberfläche als wärs ein screen aber ohne screen wär (mit weiterentwicklung) evtl. möglich?

Verfasst: 25.04.2006 17:50
von ts-soft
Screen wird wohl nicht gehen, es muß schon ein Control registriert werden,
kann natürlich auf nem Static gezeichnet sein, oder ähnlich.

Verfasst: 25.04.2006 18:02
von Kaeru Gaman
äh.. ja.. sorry.. war mißverständlich..

ging um die sachen, die man sonst der einfachheit halber glei mit in den screen macht,
wie hauptmenu und buttons und so.. die anderen game-controls halt..

das ist zur zeit noch einfacher, als sich nen wolf zu skinnen...

Verfasst: 25.04.2006 19:16
von ts-soft
Kleines Update

Examples enhält jetzt auch MyPaintBoxGadget (OriginalAutor: El_Choni)
von den Tailbite Examples.

Verfasst: 25.04.2006 19:40
von Leonhard
Wie kann ich ein Attribut erstellen???

Verfasst: 25.04.2006 19:56
von IB-Software
Hallo,

also bei mir stürzt PureBasic bereits beim Kompilieren ab. Und zwar wegen der letzten Variablen in den folgenden Zeilen:
Procedure RegisterGadget(hwnd.l, ID.l, DestroyProc.l = 0, *vttemp.PB_GadgetVT = 0)

und

Procedure CreateGadget(Id.l, ClassName.s, Text.s, Style.l, X.l, Y.l, DX.l, DY.l, ExStyle.l = 0, DestroyProc.l = 0, *vt.PB_GadgetVT = 0)
Es liegt dabei scheinbar an der Verwendung von mehr als einem optionalen Parameter in der Procedure.
Ich arbeite mit PB 4 Beta11 und habe die neuesten Updates von www.purebasic.com/beta/ installiert.

Ingo
Alle Zeiten sind UTC+02:00
Seite 1 von 4

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de