Aktuelle Zeit: 12.07.2020 07:49

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 7 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Module System (PB-Internals)
BeitragVerfasst: 30.03.2019 12:18 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Hier ein bereinigtes Module mit Systemfunktionen was immer wieder mal benötigt wird.

Update v1.02
- Added ImagePB

Update v1.04
- Added MouseOver

Code:
;-TOP

; Comment : Module System
; Author  : mk-soft
; Version : v1.04
; Create  : 30.03.2019
; Update  : 08.06.2019

; Link DE : https://www.purebasic.fr/german/viewtopic.php?f=8&t=31380
; Link EN : https://www.purebasic.fr/english/viewtopic.php?f=12&t=72980

; OS      : All

; *************************************************************************************************

DeclareModule System
  ;- Begin of Declare Module
 
  Declare WindowPB(WindowID)
  Declare GadgetPB(GadgetID)
  Declare ImagePB(ImageID)
 
  Declare GetParentWindowID(Gadget)
  Declare GetPreviousGadget(Gadget, WindowID)
  Declare GetNextGadget(Gadget, WindowID)
 
  Declare GetWindowList(List Windows())
  Declare GetGadgetList(List Gadgets(), WindowID=0)
  Declare GetImageList(List Images())
  Declare GetFontList(List Fonts())
 
  Declare MouseOver()
 
  ;- End of Declare Module
EndDeclareModule

; ---------------------------------------------------------------------------------------

Module System
  ;- Begin of Module
 
  EnableExplicit
 
  ;-- Import internal function
 
  ; Force Import Fonts
  Global __Dummy = LoadFont(#PB_Any, "", 9) : FreeFont(__Dummy)
 
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Import ""
      PB_Object_EnumerateStart( PB_Objects )
      PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
      PB_Object_EnumerateAbort( PB_Objects )
      PB_Object_GetObject( PB_Object , DynamicOrArrayID)
      PB_Window_Objects.i
      PB_Gadget_Objects.i
      PB_Image_Objects.i
      PB_Font_Objects.i
    EndImport
  CompilerElse
    ImportC ""
      PB_Object_EnumerateStart( PB_Objects )
      PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
      PB_Object_EnumerateAbort( PB_Objects )
      PB_Object_GetObject( PB_Object , DynamicOrArrayID)
      PB_Window_Objects.i
      PB_Gadget_Objects.i
      PB_Image_Objects.i
      PB_Font_Objects.i
    EndImport
  CompilerEndIf
 
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
    ; PB Interne Struktur Gadget MacOS
    Structure sdkGadget
      *gadget
      *container
      *vt
      UserData.i
      Window.i
      Type.i
      Flags.i
    EndStructure
  CompilerEndIf
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure WindowPB(WindowID) ; Find pb-id over handle
    Protected result, window
    result = -1
    PB_Object_EnumerateStart(PB_Window_Objects)
    While PB_Object_EnumerateNext(PB_Window_Objects, @window)
      If WindowID = WindowID(window)
        result = window
        Break
      EndIf
    Wend
    PB_Object_EnumerateAbort(PB_Window_Objects)
    ProcedureReturn result
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure GadgetPB(GadgetID) ; Find pb-id over handle
    Protected result, gadget
    result = -1
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @gadget)
      If GadgetID = GadgetID(gadget)
        result = gadget
        Break
      EndIf
    Wend
    PB_Object_EnumerateAbort(PB_Gadget_Objects)
    ProcedureReturn result
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure ImagePB(ImageID) ; Find pb-id over handle
    Protected result, image
    result = -1
    PB_Object_EnumerateStart(PB_Image_Objects)
    While PB_Object_EnumerateNext(PB_Image_Objects, @image)
      If ImageID = ImageID(image)
        result = image
        Break
      EndIf
    Wend
    PB_Object_EnumerateAbort(PB_Image_Objects)
    ProcedureReturn result
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure GetParentWindowID(Gadget)
    Protected GadgetID, WindowID
   
    If IsGadget(Gadget)
      CompilerSelect #PB_Compiler_OS
        CompilerCase #PB_OS_MacOS
          Protected *Gadget.sdkGadget = IsGadget(Gadget)
          WindowID = WindowID(*Gadget\Window)
        CompilerCase #PB_OS_Linux
          GadgetID = GadgetID(Gadget)
          WindowID = gtk_widget_get_toplevel_ (GadgetID)
        CompilerCase #PB_OS_Windows
          GadgetID = GadgetID(Gadget)
          WindowID = GetAncestor_(GadgetID, #GA_ROOT)
      CompilerEndSelect
    EndIf
    ProcedureReturn WindowID
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure GetPreviousGadget(Gadget, WindowID)
    Protected object, prev_id, type
   
    prev_id = -1
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @object)
      type = GadgetType(object)
      If type <> #PB_GadgetType_Text And type <> #PB_GadgetType_Frame
        If GetParentWindowID(object) = WindowID
          If gadget = object
            If prev_id >= 0
              PB_Object_EnumerateAbort(PB_Gadget_Objects)
              Break
            EndIf
          Else
            prev_id = object
          EndIf
        EndIf
      EndIf
    Wend
    ProcedureReturn prev_id
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure GetNextGadget(Gadget, WindowID)
    Protected object, next_id, type
   
    next_id = -1
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @object)
      type = GadgetType(object)
      If type <> #PB_GadgetType_Text And type <> #PB_GadgetType_Frame
        If GetParentWindowID(object) = WindowID
          If next_id < 0
            next_id = object
          EndIf
          If gadget = object
            If PB_Object_EnumerateNext(PB_Gadget_Objects, @object)
              If GetParentWindowID(object) = WindowID
                next_id = object
                PB_Object_EnumerateAbort(PB_Gadget_Objects)
                Break
              EndIf
            EndIf
          EndIf
        EndIf
      EndIf
    Wend
    ProcedureReturn next_id
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure GetWindowList(List Windows())
    Protected object
    ClearList(Windows())
    PB_Object_EnumerateStart(PB_Window_Objects)
    While PB_Object_EnumerateNext(PB_Window_Objects, @object)
      AddElement(Windows())
      Windows() = object
    Wend
    ProcedureReturn ListSize(Windows())
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure GetGadgetList(List Gadgets(), WindowID=0)
    Protected object
    ClearList(Gadgets())
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @object)
      If WindowID = 0 Or GetParentWindowID(object) = WindowID
        AddElement(Gadgets())
        Gadgets() = object
      EndIf
    Wend
    ProcedureReturn ListSize(Gadgets())
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure GetImageList(List Images())
    Protected object
    ClearList(Images())
    PB_Object_EnumerateStart(PB_Image_Objects)
    While PB_Object_EnumerateNext(PB_Image_Objects, @object)
      AddElement(Images())
      Images() = object
    Wend
    ProcedureReturn ListSize(Images())
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure GetFontList(List Fonts())
    Protected object
    ClearList(Fonts())
    PB_Object_EnumerateStart(PB_Font_Objects)
    While PB_Object_EnumerateNext(PB_Font_Objects, @object)
      AddElement(Fonts())
      Fonts() = object
    Wend
    ProcedureReturn ListSize(Fonts())
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure MouseOver() ; Result handle
    Protected handle, window
    window = GetActiveWindow()
    If window < 0
      ProcedureReturn 0
    EndIf
    ; Get handle under mouse
    CompilerSelect #PB_Compiler_OS
      CompilerCase #PB_OS_Windows
        Protected pt.q
        GetCursorPos_(@pt)
        handle = WindowFromPoint_(pt)
        ; handle = WindowFromPoint_(DesktopMouseY() << 32 | DesktopMouseX())
      CompilerCase #PB_OS_MacOS
        Protected win_id, win_cv, pt.NSPoint
        win_id = WindowID(window)
        win_cv = CocoaMessage(0, win_id, "contentView")
        CocoaMessage(@pt, win_id, "mouseLocationOutsideOfEventStream")
        handle = CocoaMessage(0, win_cv, "hitTest:@", @pt)
      CompilerCase #PB_OS_Linux
        Protected desktop_x, desktop_y, *GdkWindow.GdkWindowObject
        *GdkWindow.GdkWindowObject = gdk_window_at_pointer_(@desktop_x,@desktop_y)
        If *GdkWindow
          gdk_window_get_user_data_(*GdkWindow, @handle)
        Else
          handle = 0
        EndIf
    CompilerEndSelect
    ProcedureReturn handle
  EndProcedure
 
  ; ---------------------------------------------------------------------------
 
EndModule

;- Example
CompilerIf #PB_Compiler_IsMainFile
 
  UseModule System
 
  Procedure CheckMouseOver()
    Static last_handle = 0
    Static last_gadget = -1
   
    Protected handle, gadget
   
    handle = MouseOver()
    If handle <> last_handle
      last_handle = handle
      If last_gadget >= 0
        Debug "Mouse leave gadget " + last_gadget
        last_gadget = -1
      EndIf
      If handle
        gadget = GadgetPB(handle)
        If gadget >= 0
          Debug "Mouse enter gadget " + gadget
          last_gadget = gadget
        EndIf
      EndIf
    EndIf
  EndProcedure
 
  If OpenWindow(1, 0, 0, 222, 280, "ButtonGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    ButtonGadget(0, 10, 10, 200, 20, "Standard Button")
    ButtonGadget(1, 10, 40, 200, 20, "Left Button", #PB_Button_Left)
    ButtonGadget(2, 10, 70, 200, 20, "Right Button", #PB_Button_Right)
    ButtonGadget(3, 10,100, 200, 60, "Multiline Button  (längerer Text wird automatisch umgebrochen)", #PB_Button_MultiLine)
    ButtonGadget(4, 10,170, 200, 20, "Toggle Button", #PB_Button_Toggle)
    ButtonImageGadget(5, 10, 200, 200, 60, LoadImage(2, #PB_Compiler_Home + "examples/sources/Data/PureBasic.bmp"))
   
    handle = WindowID(1)
    Debug "Window = " + WindowPB(handle)
   
    NewList Gadgets()
    Debug "Count of Gadgegts = " + GetGadgetList(Gadgets())
    ForEach Gadgets()
      Debug "Text of Gadget " + Gadgets() + " = " + GetGadgetText(Gadgets())
    Next
   
    handle = GetParentWindowID(3)
    Debug "Parent window handle from gadget 3 = " + GetParentWindowID(3)
    Debug "PB WindowID from handle " + handle + " = " + WindowPB(handle)
   
    handle = GetGadgetAttribute(5, #PB_Button_Image)
    Debug "Image handle from gadget 5 = " + handle
    Debug "PB ImageID from handle " + handle + " = " + ImagePB(handle)
   
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Default
          CheckMouseOver()
      EndSelect
    ForEver
   
  EndIf
CompilerEndIf

_________________
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf My Webspace


Zuletzt geändert von mk-soft am 09.06.2019 23:02, insgesamt 4-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Module System (PB-Internals)
BeitragVerfasst: 08.04.2019 12:57 
Offline
Admin
Benutzeravatar

Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Danke für die Zusammenfassung. :allright:

_________________
BildBildBildBild BildBild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Module System (PB-Internals)
BeitragVerfasst: 08.06.2019 11:52 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Update v1.03
- Added MouseOver

:wink:

_________________
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf My Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Module System (PB-Internals)
BeitragVerfasst: 07.09.2019 14:34 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
Gibt es auch eine Möglichkeit, mit GetFontList() neben der Font-Nummer auch irgendwie den Namen, den Style und die Größe zu ermitteln?

Ich habe also eine FontID bzw. FontNummer, möchte aber genau diesen Font in einer anderen Größe laden, was ohne Kenntnis von dessen Namen und Style leider nicht geht.

Leider kenne ich mich mit den Internas von PB selber absolut nicht aus.

_________________
Download der Module
Download der Programme

Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Module System (PB-Internals)
BeitragVerfasst: 07.09.2019 22:02 
Offline
Benutzeravatar

Registriert: 01.04.2007 20:18
Thorsten1867 hat geschrieben:
Gibt es auch eine Möglichkeit, mit GetFontList() neben der Font-Nummer auch irgendwie den Namen, den Style und die Größe zu ermitteln?
Ich habe also eine FontID bzw. FontNummer, möchte aber genau diesen Font in einer anderen Größe laden, was ohne Kenntnis von dessen Namen und Style leider nicht geht.


Dafür müsste der Programmierer selbst sorgen.
Die Liste von GetFontList() beinhaltet auch nur die vom User erstellten Fonts (LoadFont() / CatchFont()).
Genauso wie die Gadgetliste nur die selbst erstellten Gadgets beinhaltet.
Von daher müsste der User das selbst organisieren.

_________________
PureBasic 5.72 LTS (Windows x86/x64) | Windows10 Pro x64 | Z370 Extreme4 | i7 8770k | 32GB RAM | iChill GeForce RTX 2080 Super | HAF XF Evo​​


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Module System (PB-Internals)
BeitragVerfasst: 07.09.2019 23:05 
Offline
Benutzeravatar

Registriert: 27.02.2006 22:30
Wohnort: Neumünster
Thorsten1867 hat geschrieben:
Gibt es auch eine Möglichkeit, mit GetFontList() neben der Font-Nummer auch irgendwie den Namen, den Style und die Größe zu ermitteln?

Ich habe also eine FontID bzw. FontNummer, möchte aber genau diesen Font in einer anderen Größe laden, was ohne Kenntnis von dessen Namen und Style leider nicht geht.

Leider kenne ich mich mit den Internas von PB selber absolut nicht aus.


Hat man die Fontid kann man die Daten abfragen, wie immer mit Windows teilweise nicht ganz einfach

z.B.
GetTextFaceA, Fontname
GetTextMetrics, Styles etc
LOGFONTA structure ,

hier im Forum gibt es bestimmt einige Beispiele

_________________
Purebasic 5.60 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Module System (PB-Internals)
BeitragVerfasst: 07.09.2019 23:45 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
Schade, dann muss ich es so lassen wie bisher, da es für alle OS funktionieren muss.

_________________
Download der Module
Download der Programme

Bild


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 7 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 6 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye