CodeArchiv für PB v4 - aktueller Status & Mithelfer gesu

edel · Beitrag von **edel** » 05.02.2007 11:12

Hab Urlaub

http://www.purearea.net/temp/CodeArchiv ... andling.pb

Das war mir zu umstaendlich, habe es deswegen schnell selber geschrieben

Code: Alles auswählen

  
  
  ;- MDI Example 4.02
  
  Enumeration
    #MAIN_WINDOW
  EndEnumeration
  
  Enumeration
    #MDI_MAIN
  EndEnumeration
  
  Enumeration
    #MAIN_MENU
  EndEnumeration
  
  Enumeration
    #MENU_NEW
    #MENU_OPEN
    #MENU_SAVE
    #MENU_SAVEAS
    #MENU_CLOSE
    #MENU_CLOSEALL
    #MENU_EXIT
    
    #MENU_CASCADE
    #MENU_TILEH
    #MENU_TILEV
    #MENU_ARRANGE
    #MENU_NEXT
    #MENU_PREV
    #MENU_NORMAL
    #MENU_NORMALALL
    #MENU_MAXIMIZE
    #MENU_MAXIMIZEALL
    #MENU_MINIMIZE
    #MENU_MINIMIZEALL
    
    #MENU_RESIZE_DEMO 
    
    #MENU_WINDOW_POS
  EndEnumeration
  
  define.l hwnd,event,window
  Newlist MDI_WINDOW_LIST.l()
  
  ;-
  
  Procedure NewMdiChild()
    shared MDI_WINDOW_LIST.l()
    
    AddElement(MDI_WINDOW_LIST())
    MDI_WINDOW_LIST() = AddGadgetItem(#MDI_MAIN,#pb_any,"MDI - Childwindow")
    
    ProcedureReturn MDI_WINDOW_LIST()
  EndProcedure
  
  Procedure CloseMdiChild(Child=-1)
    shared MDI_WINDOW_LIST.l()
    
    if Child = -1 ; alle schliessen
      
      ForEach MDI_WINDOW_LIST()
        Child = MDI_WINDOW_LIST()
        CloseWindow(Child) 
      Next
      
      ClearList(MDI_WINDOW_LIST())
      
    else
      
      ForEach MDI_WINDOW_LIST()
        if Child = MDI_WINDOW_LIST()
          CloseWindow(Child)
          DeleteElement(MDI_WINDOW_LIST())
          break
        EndIf
      Next
      
    EndIf
    
  EndProcedure
  
  ;-
  
  hwnd = OpenWindow(#MAIN_WINDOW,#PB_Ignore,#PB_Ignore,640,480,"MDI-Test")
  
  if CreateMenu(#MAIN_MENU,hwnd)
    
    MenuTitle("File")
    MenuItem(#MENU_NEW        , "New"       +Chr(9)+"Ctrl+N")
    MenuItem(#MENU_OPEN       , "Open"      +Chr(9)+"Ctrl+O")
    MenuItem(#MENU_SAVE       , "Save"      +Chr(9)+"Ctrl+S")
    MenuItem(#MENU_SAVEAS     , "Save as"                   )
    MenuBar() 
    MenuItem(#MENU_CLOSE      , "Close"     +Chr(9)+"Ctrl+W")
    MenuItem(#MENU_CLOSEALL   , "Close all"                 )
    MenuBar() 
    MenuItem(#MENU_EXIT       , "Exit"      +Chr(9)+"Alt+F4")
    
    MenuTitle("Windows") 
    MenuItem(#MENU_CASCADE    , "Cascade")
    MenuItem(#MENU_TILEH      , "Tile horizontally")
    MenuItem(#MENU_TILEV      , "Tile vertically")
    MenuItem(#MENU_ARRANGE    , "Arrange")
    MenuBar() 
    MenuItem(#MENU_NEXT       , "Next")
    MenuItem(#MENU_PREV       , "Previous") 
    MenuBar() 
    MenuItem(#MENU_NORMAL     , "Restore")
    MenuItem(#MENU_NORMALALL  , "Restore all")
    MenuItem(#MENU_MAXIMIZE   , "Maximize")
    MenuItem(#MENU_MAXIMIZEALL, "Maximize all")
    MenuItem(#MENU_MINIMIZE   , "Minimize")
    MenuItem(#MENU_MINIMIZEALL, "Minimize all")
    MenuBar() 
    MenuItem(#MENU_RESIZE_DEMO, "Resize Demo")
    
    AddKeyboardShortcut(#MAIN_WINDOW,#PB_Shortcut_Control|#PB_Shortcut_N,#MENU_NEW)
    AddKeyboardShortcut(#MAIN_WINDOW,#PB_Shortcut_Control|#PB_Shortcut_O,#MENU_OPEN)
    AddKeyboardShortcut(#MAIN_WINDOW,#PB_Shortcut_Control|#PB_Shortcut_S,#MENU_SAVE)
    AddKeyboardShortcut(#MAIN_WINDOW,#PB_Shortcut_Control|#PB_Shortcut_W,#MENU_CLOSE)
    
  endif
  
  CreateGadgetList(hwnd)
  MDIGadget(#MDI_MAIN,#PB_Ignore,#PB_Ignore,640,480-MenuHeight(),1,#MENU_WINDOW_POS)
  
  NewMdiChild() 
  
  ;-
  
  Repeat
    event  = WaitWindowEvent()
    window = EventWindow()
    
    If window = #MAIN_WINDOW ; events fuer das Hauptfenster
      
      if event = #PB_Event_CloseWindow
        end
      EndIf
      
      if event = #PB_Event_Menu
        
        select EventMenu()
          case #MENU_NEW       
            NewMdiChild() 
          case #MENU_OPEN      
            debug "not implemented"
          case #MENU_SAVE      
            debug "not implemented"
          case #MENU_SAVEAS     
            debug "not implemented"
          case #MENU_CLOSE
            window = GetGadgetState(#MDI_MAIN) 
            CloseMdiChild(window)
          case #MENU_CLOSEALL   
            CloseMdiChild(-1)
          case #MENU_EXIT      
            end
          case #MENU_CASCADE
            SetGadgetState(#MDI_MAIN,#PB_MDI_Cascade)
          case #MENU_TILEH
            SetGadgetState(#MDI_MAIN,#PB_MDI_TileHorizontally)
          case #MENU_TILEV
            SetGadgetState(#MDI_MAIN,#PB_MDI_TileVertically)
          case #MENU_ARRANGE
            SetGadgetState(#MDI_MAIN,#PB_MDI_Arrange)
          case #MENU_NEXT
            SetGadgetState(#MDI_MAIN,#PB_MDI_Next)
          case #MENU_PREV
            SetGadgetState(#MDI_MAIN,#PB_MDI_Previous)
          case #MENU_NORMAL
            window = GetGadgetState(#MDI_MAIN) 
            SetWindowState(window,#PB_Window_Normal)
          case #MENU_NORMALALL
            ForEach MDI_WINDOW_LIST()
              window = MDI_WINDOW_LIST()
              SetWindowState(window,#PB_Window_Normal)
            Next
          case #MENU_MAXIMIZE
            window = GetGadgetState(#MDI_MAIN) 
            SetWindowState(window,#PB_Window_Maximize)
          case #MENU_MAXIMIZEALL
            ForEach MDI_WINDOW_LIST()
              window = MDI_WINDOW_LIST()
              SetWindowState(window,#PB_Window_Maximize)
            Next
          case #MENU_MINIMIZE
            window = GetGadgetState(#MDI_MAIN) 
            SetWindowState(window,#PB_Window_Minimize)
          case #MENU_MINIMIZEALL
            ForEach MDI_WINDOW_LIST()
              window = MDI_WINDOW_LIST()
              SetWindowState(window,#PB_Window_Minimize)
            Next
          case #MENU_RESIZE_DEMO
            window = GetGadgetState(#MDI_MAIN) 
            if iswindow(window)
              ResizeWindow(window,#PB_Ignore,#PB_Ignore,random(400)+100,random(400)+100)
            EndIf
        EndSelect
        
      EndIf
      
    else ; andere Fenster
      
      select event
        case #WM_SYSCOMMAND ; wenn das fenster ueber das eigene Menu geschlossen wird.
          if EventwParam() = #SC_CLOSE
            CloseMdiChild(window)
          EndIf
        case #PB_Event_CloseWindow
          CloseMdiChild(window)
      EndSelect 
      
    EndIf
    
    
  ForEver

Andre · Beitrag von **Andre** » 06.02.2007 00:12

@edel: vielen herzlichen Dank, das ist ja mal eine schnelle & prima Hilfe

3D_Balken-Blitz.pb ist tatsächlich ein BlitzBasic-Code, den ich mal angefangen hatte zu konvertieren. Wer also Lust hat und sich mit dem Syntax gut genug auskennt....

Fast_Len.pb - könnten hier evtl. mal noch paar mehr Leute den Code auf Geschwindigkeit testen? Bisher stets 1:1 (einmal schnell / einmal langsamer)...

Mit den neuesten Ergänzungen von mir und den fertig überarbeiteten Codes haben wir momentan 1701 Codes im PB v4-kompatiblen CodeArchiv erreicht.

nco2k · Beitrag von **nco2k** » 06.02.2007 01:58

@Andre
> Default-Button Example by nco2k
höhö ich fühl mich ja geehrt.

da AdvancedGadgetEvents() nicht mehr vorhanden ist, würde ich eine art gadget callback für die jeweiligen buttons verwenden, so in etwa:

Code: Alles auswählen

;/ Default-Button Example by nco2k 

#Button_A = 0 
#Button_B = 1 
#Button_Exit = 2 

#Shortcut_Escape = 0 
#Shortcut_Return = 1 

Global ButtonACallback.l 
Global ButtonBCallback.l 
Global ButtonExitCallback.l 
Global DefaultButton.l 

Procedure ButtonACallbackProc(hWnd, uMsg, wParam, lParam) 
  If uMsg = #WM_SETFOCUS 
    SendMessage_(GadgetID(#Button_A), #BM_SETSTYLE, #BS_DEFPUSHBUTTON, #True) 
    SendMessage_(GadgetID(#Button_B), #BM_SETSTYLE, 0, #True) 
    SendMessage_(GadgetID(#Button_Exit), #BM_SETSTYLE, 0, #True) 
    DefaultButton = #Button_A 
  EndIf 
  ProcedureReturn CallWindowProc_(ButtonACallback, hWnd, uMsg, wParam, lParam) 
EndProcedure 

Procedure ButtonBCallbackProc(hWnd, uMsg, wParam, lParam) 
  If uMsg = #WM_SETFOCUS 
    SendMessage_(GadgetID(#Button_A), #BM_SETSTYLE, 0, #True) 
    SendMessage_(GadgetID(#Button_B), #BM_SETSTYLE, #BS_DEFPUSHBUTTON, #True) 
    SendMessage_(GadgetID(#Button_Exit), #BM_SETSTYLE, 0, #True) 
    DefaultButton = #Button_B 
  EndIf 
  ProcedureReturn CallWindowProc_(ButtonBCallback, hWnd, uMsg, wParam, lParam) 
EndProcedure 

Procedure ButtonExitCallbackProc(hWnd, uMsg, wParam, lParam) 
  If uMsg = #WM_SETFOCUS 
    SendMessage_(GadgetID(#Button_A), #BM_SETSTYLE, 0, #True) 
    SendMessage_(GadgetID(#Button_B), #BM_SETSTYLE, 0, #True) 
    SendMessage_(GadgetID(#Button_Exit), #BM_SETSTYLE, #BS_DEFPUSHBUTTON, #True) 
    DefaultButton = #Button_Exit 
  EndIf 
  ProcedureReturn CallWindowProc_(ButtonExitCallback, hWnd, uMsg, wParam, lParam) 
EndProcedure 

Procedure WindowCallbackProc(hWnd, Msg, wParam, lParam) 
  If Msg = #WM_ACTIVATE 
    If hWnd = WindowID(0) 
      If (wParam & $FFFF) = #WA_INACTIVE 
        SendMessage_(GadgetID(#Button_A), #BM_SETSTYLE, 0, #True) 
        SendMessage_(GadgetID(#Button_B), #BM_SETSTYLE, 0, #True) 
        SendMessage_(GadgetID(#Button_Exit), #BM_SETSTYLE, 0, #True) 
      ElseIf IsGadget(DefaultButton) And GadgetType(DefaultButton) = #PB_GadgetType_Button 
        SendMessage_(GadgetID(DefaultButton), #BM_SETSTYLE, #BS_DEFPUSHBUTTON, #True) 
      EndIf 
    EndIf 
  EndIf 
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure 

If OpenWindow(0, 0, 0, 320, 95, "Default-Button Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
  If CreateGadgetList(WindowID(0)) 
    ButtonGadget(#Button_A, 110, 5, 100, 25, "A") 
    ButtonACallback = SetWindowLong_(GadgetID(#Button_A), #GWL_WNDPROC, @ButtonACallbackProc()) 
    ButtonGadget(#Button_B, 110, 35, 100, 25, "B", #PB_Button_Default) 
    SetActiveGadget(#Button_B) 
    ButtonBCallback = SetWindowLong_(GadgetID(#Button_B), #GWL_WNDPROC, @ButtonBCallbackProc()) 
    DefaultButton = #Button_B 
    ButtonGadget(#Button_Exit, 110, 65, 100, 25, "Exit") 
    ButtonExitCallback = SetWindowLong_(GadgetID(#Button_Exit), #GWL_WNDPROC, @ButtonExitCallbackProc()) 
  EndIf 
  AddKeyboardShortcut(0, #PB_Shortcut_Escape, #Shortcut_Escape) 
  AddKeyboardShortcut(0, #PB_Shortcut_Return, #Shortcut_Return) 
  SetWindowCallback(@WindowCallbackProc(), 0) 
EndIf 

Repeat 
  Select WaitWindowEvent() 
    Case #PB_Event_Menu 
      Select EventMenu() 
        Case #Shortcut_Escape 
          End 
        Case #Shortcut_Return 
          If DefaultButton = #Button_A 
            Debug "A" 
          ElseIf DefaultButton = #Button_B 
            Debug "B" 
          ElseIf DefaultButton = #Button_Exit 
            End 
          EndIf 
      EndSelect 
    Case #PB_Event_Gadget 
      Select EventGadget() 
        Case #PB_Event_Gadget 
          Case #Button_A 
            Debug "A" 
          Case #Button_B 
            Debug "B" 
          Case #Button_Exit 
            End 
      EndSelect 
    Case #PB_Event_CloseWindow 
      End 
  EndSelect 
ForEver 

End

edit: hab noch EventType() aus der schleife genommen, da es nun überflüssig ist.

edit2: man könnte die schleife auch so umschreiben, dass die menu events auf die gadget events umgemünzt werden:

Code: Alles auswählen

Repeat 
  WinEvent = WaitWindowEvent()
  Select WinEvent
    Case #PB_Event_Menu, #PB_Event_Gadget
      GadgetEvent = -1
      Select WinEvent
        Case #PB_Event_Menu
          MenuEvent = EventMenu()
          Select MenuEvent
            Case #Shortcut_Escape
              GadgetEvent = #Button_Exit
            Case #Shortcut_Return
              GadgetEvent = DefaultButton
          EndSelect
        Case #PB_Event_Gadget
          GadgetEvent = EventGadget()
      EndSelect
      If GadgetEvent >= 0
        Select GadgetEvent
          Case #Button_A
            Debug "A"
          Case #Button_B
            Debug "B"
          Case #Button_Exit
            End
        EndSelect
      EndIf
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver

c ya,
nco2k

edel · Beitrag von **edel** » 06.02.2007 03:57

Andre hat geschrieben:Fast_Len.pb - könnten hier evtl. mal noch paar mehr Leute den Code auf Geschwindigkeit testen? Bisher stets 1:1 (einmal schnell / einmal langsamer)...
[...]

Es wurden je 10000000 Aufrufe gestartet
Hellhound66 : 391 ms.
WinAPI brauchte : 656 ms.
PB brauchte : 610 ms.

Vista , AMD 2.2GHZ
Die Werte schwanken zwar , Hells Funktion ist bei mir aber immer schneller.

http://www.purearea.net/temp/CodeArchiv ... ast_Len.pb

Andre · Beitrag von **Andre** » 07.02.2007 00:07

@nco2k: danke, habe den überarbeiteten Code aufgenommen.

Gibts noch ein paar weitere Speed-Tester für den Fast_Len.pb Code?

DrShrek · Beitrag von **DrShrek** » 07.02.2007 08:54

Andre hat geschrieben:@nco2k: danke, habe den überarbeiteten Code aufgenommen.

Gibts noch ein paar weitere Speed-Tester für den Fast_Len.pb Code?

Sorry, aber so macht der 'Fast_Len.pb Code' Test keinen Sinn!
Es muss schon auch der Rückgabewert zugewiesen werden!
Und dann schneidet bei mir der PB Code besser bzw ist gleich schnell ab!

Erst wenn der String noch länger ist...ist der Fast_Len Code schneller.

Code: Alles auswählen

; http://www.purebasic-lounge.de
; Author: Hellhound66
; Date: 06. October 2006
; OS: Windows
; Demo: Yes


; Frage: Original PB command schneller, macht dann dieser Code überhaupt Sinn fürs Archiv?

DisableDebugger
Prototype HellLen(UserString.s)
Global HellLen.HellLen

Goto __JUMPOVER
__HellLen:
!PUSH Edi
!PUSH Ecx
!MOV Edi,[Esp+12]
!XOR Ecx,Ecx
!XOR Ebx,Ebx
!__OUTERLOOP:
!MOV Eax,dword[Edi]
!TEST Eax,255
!JZ __FINISHED
!INC Ecx
!TEST Eax,65280
!JZ __FINISHED
!INC Ecx
!SHR Eax,16
!TEST Eax,255
!JZ __FINISHED
!INC Ecx
!TEST Eax,65280
!JZ __FINISHED
!INC Ecx
!ADD Edi,4
!JMP __OUTERLOOP
!__FINISHED:
!MOV Eax,Ecx
!POP Ecx
!POP Edi
!RET 4
__JUMPOVER:

HellLen = ?__HellLen

Delay(100)
string.s = "Ich bin ein fieser Teststring"
TestZeit.l  = ElapsedMilliseconds()
For i=1 To 10000000
  t1.l = HellLen(string)
Next
Zeit1 = ElapsedMilliseconds()-TestZeit

TestZeit.l  = ElapsedMilliseconds()
For i=1 To 10000000
  t2.l = lstrlen_(string)
Next
Zeit2 = ElapsedMilliseconds()-TestZeit

TestZeit.l  = ElapsedMilliseconds()
For i=1 To 10000000
  t3.l = Len(string)
Next
Zeit3 = ElapsedMilliseconds()-TestZeit


MessageRequester("Ergebnis","Es wurden je 10000000 Aufrufe gestartet"+#CRLF$+"Hellhound66 : "+Str(Zeit1)+" ms."+#CRLF$+"WinAPI brauchte : "+Str(Zeit2)+" ms."+#CRLF$+"PB brauchte : "+Str(Zeit3)+" ms."+#CRLF$,#PB_MessageRequester_Ok)
; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = -

edel · Beitrag von **edel** » 07.02.2007 09:41

Natuerlich macht das Sinn, man will ja nur die Geschwindkeit der Funktion
wissen und nicht welche Register danach rumgeschoben werden, denn das
gehoert nicht mehr zur Funktion.

Aber auch damit ist es immer noch schneller :

Hellhound66 : 562 ms.
WinAPI brauchte : 781 ms.
PB brauchte : 719 ms.

DrShrek · Beitrag von **DrShrek** » 07.02.2007 10:21

edel hat geschrieben:Natuerlich macht das Sinn, man will ja nur die Geschwindkeit der Funktion
wissen und nicht welche Register danach rumgeschoben werden, denn das
gehoert nicht mehr zur Funktion.

Aber auch damit ist es immer noch schneller :

Hellhound66 : 562 ms.
WinAPI brauchte : 781 ms.
PB brauchte : 719 ms.

@edel,
Sorry, hier muss ich Dir wiedersprechen.
Es gibt keine praktische Anwendung von len() ohne auch den Rückgabeparameter zu nutzen.

Theoretische Messung bringen hier garnichts.
Denn dann würde ich vorschlagen, das Hellhound das zurückgeben der Stringlänge ganz weglassen kann

Meine Ergebnisse:
Hellhound66 : 422 ms.
WinAPI brauchte : 546 ms.
PB brauchte : 407 ms.

Helle · Beitrag von **Helle** » 07.02.2007 13:55

Habe es eben mal auf AMD und Intel getestet (mit Ausgabewert, mehrere Durchläufe):
AMD Athlon64 3200+; 2,2GHz; W2k:
- Hellhound66: 297ms
- WinAPI: 453ms
- PB: 515ms
Ausser Konkurenz meine damalige SSE-Version: 140ms

Intel Pentium D; 3,2GHz; XP:
- Hellhound66: 510ms
- WinAPI: 562ms
- PB: 453ms
Ausser Konkurenz meine damalige SSE-Version: 220ms

Intel Pentium 4; 1,7GHz; W2k:
- Hellhound66: 640ms
- WinAPI: 1.235ms
- PB: 578ms
Ausser Konkurenz meine damalige SSE-Version: 234ms

Intel Pentium T2400 (Notebook, Netzbetrieb); 1,83GHz; XP:
- Hellhound66: 547ms
- WinAPI: 500ms
- PB: 531ms
Ausser Konkurenz meine damalige SSE-Version: 235ms

Die unterschiedlichen Testergebnisse liegen also wie erwartet am jeweils verwendeten Prozi.
Es lebe AMD und SSE

!

Gruss
Helle

Edit: Habe wegen WinAPI noch die Betriebssysteme nachgetragen

Gisela · Beitrag von **Gisela** » 07.02.2007 23:36

erst mal will ich ein großes Lob loslassen für diese Codearchiv. Ist ja eine einzige Fundgrube. Habe dann im Verzeichnis ..\Windows_System dann auch gleich etwas gefunden, was ich grad suche. Lief leider nicht unter 4.02. Waren aber nur zwei kleine Änderungen.

Hier die unter 4.02 lauffähige Version. Autor stand nicht dabei.

ChangeMouseCursor.pb

Code: Alles auswählen

; German forum:
; Author:
; Date:

;
; Fenster mit Gadgets oeffnen
;
hWnd = OpenWindow(1,10,10,400,200,"", #PB_Window_SystemMenu)
CreateGadgetList(hWnd)
   Button1   = ButtonGadget(1,210,10,100,25,"WAIT")
   Button2   = ButtonGadget(2,210,40,100,25,"HELP")
   ListView  = ListViewGadget(3,10,10,200,150)
;
; Standard-Cursor in allen Fenster-Klassen auf 0 setzen
; Ohne dies kann es zum cursor-flickern kommen
;
SetClassLong_(hWnd,#GCL_HCURSOR,0)
SetClassLong_(Button1,#GCL_HCURSOR,0)
SetClassLong_(Button2,#GCL_HCURSOR,0)
SetClassLong_(ListView,#GCL_HCURSOR,0)
;
; Cursor laden
;
#IDC_HELP = 32651
cur0 = LoadCursor_(0, #IDC_CROSS)
cur1 = LoadCursor_(0, #IDC_WAIT)
cur2 = LoadCursor_(0, #IDC_HELP)
cur3 = LoadCursor_(0, #IDC_NO)
;
; Hauptschleife
;
Repeat
  Event = WaitWindowEvent()
  Gosub changecursor
  ;Select Event
  ;EndSelect
Until Event = #PB_Event_CloseWindow
;
; Ende
;
DestroyCursor_(cur0)
DestroyCursor_(cur1)
DestroyCursor_(cur2)
DestroyCursor_(cur3)
End
;
; SUB zum wechseln des MouseCursors
;
changecursor:
  GetCursorPos_(cursorpos.POINT)
  MapWindowPoints_(0, hWnd, cursorpos, 1)
    Select ChildWindowFromPoint_(hWnd, cursorpos\x, cursorpos\y)
      Case Button1   : SetCursor_(cur1)  ; Cursor ueber Button 1
      Case Button2   : SetCursor_(cur2)  ; Cursor ueber Button 2
      Case ListView  : SetCursor_(cur3)  ; Cursor ueber ListView
      Case hWnd      : SetCursor_(cur0)  ; Default, fuer das Hauptfenster
    EndSelect
Return