PureBoard

Code: Alles auswählen

; English forum:http://www.purebasic.fr/english/viewtopic.php?p=35682
; Author: Freak
; Date: 26. August 2003 / 2006
; OS:Windows
; Demo:No

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

Enumeration 1 
  #OLECMDID_OPEN          
  #OLECMDID_NEW        
  #OLECMDID_SAVE          
  #OLECMDID_SAVEAS            
  #OLECMDID_SAVECOPYAS    
  #OLECMDID_PRINT        
  #OLECMDID_PRINTPREVIEW        
  #OLECMDID_PAGESETUP        
  #OLECMDID_SPELL            
  #OLECMDID_PROPERTIES  
  #OLECMDID_CUT          
  #OLECMDID_COPY        
  #OLECMDID_PASTE            
  #OLECMDID_PASTESPECIAL    
  #OLECMDID_UNDO            
  #OLECMDID_REDO          
  #OLECMDID_SELECTALL        
  #OLECMDID_CLEARSELECTION 
  #OLECMDID_ZOOM            
  #OLECMDID_GETZOOMRANGE      
  #OLECMDID_UPDATECOMMANDS  
  #OLECMDID_REFRESH            
  #OLECMDID_STOP              
  #OLECMDID_HIDETOOLBARS      
  #OLECMDID_SETPROGRESSMAX    
  #OLECMDID_SETPROGRESSPOS  
  #OLECMDID_SETPROGRESSTEXT    
  #OLECMDID_SETTITLE          
  #OLECMDID_SETDOWNLOADSTATE  
  #OLECMDID_STOPDOWNLOAD      
EndEnumeration 

Enumeration 0 
  #OLECMDEXECOPT_DODEFAULT      
  #OLECMDEXECOPT_PROMPTUSER        
  #OLECMDEXECOPT_DONTPROMPTUSER    
  #OLECMDEXECOPT_SHOWHELP        
EndEnumeration 

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

; Now the code 

#WebGadget = 1 
#Button = 2 

OpenWindow(0, 0, 0, 800, 600,"WebBrowser" ,#PB_Window_ScreenCentered|#PB_Window_SystemMenu ) 

CreateGadgetList(WindowID(0)) 

  WebGadget(#WebGadget, 10, 40, 780, 550, "www.purebasic.com") 
  ButtonGadget(#Button, 10, 10, 60, 20, "Copy") 

; Fred the genius stored the Interface pointer to IWebBrowser2 in the DATA 
; member of the windowstructure of the WebGadget containerwindow, so we can get 
; that easily:
 
WebObject.IWebBrowser2 = GetWindowLong_(GadgetID(#WebGadget), #GWL_USERDATA) 

Repeat 
  Event = WaitWindowEvent() 
  If Event = #PB_Event_Gadget And EventGadget() = #Button 
    
    ; Now here's the actual copy thing, not that complicated... 
    WebObject\ExecWB(#OLECMDID_COPY, #OLECMDEXECOPT_DONTPROMPTUSER, 0, 0) 
    
    ; little test: 
    MessageRequester("", GetClipboardText(), 0) 
    
  EndIf 
Until Event = #PB_Event_CloseWindow 

End

Code: Alles auswählen

; German forum:
; Author: Danilo
; Date: 02. April 2003

; Zeigt wie man Links-, Rechts-, DoppelLinks- und DoppelRechts-Klicks für das ButtonGadget() abfragt.
; Nützlich z.B. wenn man ein Popup-Menu nach RechtsClick auf einen Button anzeigen will.
; Diese Events wurden in 3.62 im Zusammenhang mit AdvancedGadgetEvents() geändert.
OpenWindow(0,0,0,170,106,"Button Events",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
	CreateGadgetList(WindowID(0))
	ButtonGadget(1,10,10,150,20,"Links-Klick")
	ButtonGadget(2,10,32,150,20,"Rechts-Klick")
	ButtonGadget(3,10,54,150,20,"Doppel-Links-Klick")
	ButtonGadget(4,10,76,150,20,"Doppel-Rechts-Klick")
 
Procedure GetGadget(WindowID.l)
	Protected cursorpos.POINT
	
	GetCursorPos_(@cursorpos)
	MapWindowPoints_(0, WindowID(WindowID), cursorpos, 1)
	ProcedureReturn ChildWindowFromPoint_(WindowID(WindowID), cursorpos\x, cursorpos\y)
	
EndProcedure

Procedure Message(Gadget.l)
	MessageRequester("Button "+Str(Gadget),GetGadgetText(Gadget),0)
EndProcedure

Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			End
		Case #WM_RBUTTONDOWN
			If GetGadget(0) = GadgetID(2)
				Message(2)
			EndIf
		Case #WM_RBUTTONDBLCLK
			If GetGadget(0) = GadgetID(4)
				Message(4)
			EndIf
		Case #WM_LBUTTONDBLCLK
			If GetGadget(0) = GadgetID(3)
				Message(3)
			EndIf
		Case #PB_Event_Gadget
			If EventGadget() = 1 And EventType() = #PB_EventType_LeftClick
				Message(1)
			EndIf
	EndSelect
ForEver

Code: Alles auswählen

; English forum: http://purebasic.myforums.net/viewtopic.php?t=8267&highlight=
; Author: freak
; Date: 09. November 2003

; ArrayMemorySize() shows the real size in memory. 
Procedure.l ArrayMemorySize(*Array) 
  !push dword [p.p_Array] 
  !sub dword [Esp], 20
  !push dword 0 
  !push dword [PB_MemoryBase] 
  !call _HeapSize@12 
  ProcedureReturn 
  HeapSize_(0, 0, 0) ; make sure, _HeapSize@12 is defined 
EndProcedure 

; ArraySize() shows the total number of elements. 
Procedure ArraySize(*Array) 
  ProcedureReturn PeekL(*Array-8) 
EndProcedure 

Dim Array.l(50) 

Debug ArrayMemorySize(@Array())
Debug ArraySize(@Array())


; ExecutableFormat=
; EOF

Code: Alles auswählen

; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=1396&highlight=
; Author: Stefan Moebius
; Date: 18. June 2003


; Beispiel wie man Speicher füllen kann . 
; Example for filling memory

Procedure MemLFill(Adr,AnzBytes,Dword.l) 
!PUSH Edi
!CLD
!MOV Edi,[p.v_Adr+4] 
!MOV Eax,[p.v_Dword+4] 
!MOV Ecx,[p.v_AnzBytes+4] 
!SHR Ecx,2 
!REP STOSD 
!POP Edi
EndProcedure 


Procedure MemWFill(Adr,AnzBytes,Word.w)
!PUSH Edi
!CLD 
!MOV Edi,[p.v_Adr+4]

!MOV AX,[p.v_Word+4]
!SHL Eax,16 
!MOV AX,[p.v_Word+4]

!MOV Ecx,[p.v_AnzBytes+4] 
!MOV Edx, Ecx
!AND Edx, 0x00000003
!SHR Ecx,2

!REP STOSD 
!CMP Edx,0 
!JE EndeW 

!MOV Ecx,Edx 
!SHR Ecx,1 
!REP STOSW 
!EndeW: 
!POP Edi
EndProcedure 


Procedure MemBFill(Adr,AnzBytes,Byt.b) 
!PUSH Edi
!CLD 
!MOV Edi,[p.v_Adr+4]

!MOV AL,[p.v_Byt+4]
!SHL Eax,8 
!MOV AL,[p.v_Byt+4]
!SHL Eax,8 
!MOV AL,[p.v_Byt+4]
!SHL Eax,8 
!MOV AL,[p.v_Byt+4]

!MOV Ecx,[p.v_AnzBytes+4] 
!MOV Edx, Ecx
!AND Edx, 0x00000003
!SHR Ecx,2

!REP STOSD 
!CMP Edx,0 
!JE EndeB 

!MOV Ecx,Edx 
!REP STOSB 
!EndeB: 
!POP Edi
EndProcedure 





;#################################### TEST #################################### 
A$="####" 


MemBFill(@A$,4,$50) 
Debug A$ 
MemWFill(@A$,4,$7170) 
Debug A$ 
MemLFill(@A$,4,$80808080) 
Debug A$ 

Code: Alles auswählen

; English forum: http://purebasic.myforums.net/viewtopic.php?t=7508&highlight=
; Author: jack
; Date: 12. September 2003

Procedure.f atan2(y.f,x.f) 
;atan2 procedure by Paul Dixon 
;http://www.powerbasic.com/support/forums/Forum4/HTML/009180.html 
;adapted to PureBasic by Jack 
! fld dword [p.v_y]     ;load y 
! fld dword [p.v_x]   ;load x 
! fpatan              ;get atan(y/x), put result in ST1. then pop stack to leave result in ST0 
! ftst                ;test ST0 (that's the top of stack) against zero 
! fstsw ax            ;put result of test into AX 
! sahf                ;get the FPU flags into the CPU flags 
! jae @@skip          ; if above or equal then skip the add 2*pi code 
! fldpi               ;get pi 
! fadd st1,st0        ;add pi to result 
! faddp st1,st0       ;and again, for 2pi, then pop the now unneeded pi from st0 
! @@skip: 
ProcedureReturn
EndProcedure 
 

; Example usage
x.f=-0.1 
y.f=-0.1 
z.f=57.29578*atan2(y,x) ;multiply by 57.29578 to get degrees
Debug z.f