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

Deeem2031 · Beitrag von **Deeem2031** » 01.11.2006 18:13

www.deeem2031.de/PB/CodeArchiv/Maths/IPow.pb
www.deeem2031.de/PB/CodeArchiv/Maths/Check/Sgn.pb
http://www.deeem2031.de/PB/CodeArchiv/M ... p&WrapF.pb
http://www.deeem2031.de/PB/CodeArchiv/M ... eReturn.pb
http://www.deeem2031.de/PB/CodeArchiv/M ... ve_Save.pb
http://www.deeem2031.de/PB/CodeArchiv/M ... complex.pb
http://www.deeem2031.de/PB/CodeArchiv/O ... _Editor.pb

Andre · Beitrag von **Andre** » 01.11.2006 18:35

@Deeem2031: vielen Dank für Deine Mühe!

Alle Updates wurden eingepflegt und der erste Beitrag entsprechend aktualisiert.

KeyPusher · Beitrag von **KeyPusher** » 01.11.2006 18:59

zu http://www.purearea.net/pb/CodeArchiv/I ... t/Ping2.pb

nur in soweit bearbeitet, das es mit PB4.0 funktioniert und das man nun auch mehrere abfragen machen kann, ohne merkwürdige werte zu erhalten. code soweit wie möglich unangetastet gelassen.

Code: Alles auswählen

; English forum: http://purebasic.myforums.net/viewtopic.php?t=7338&highlight=
; Author: TerryHough
; Date: 16. September 2003


;PING2 - Sep 08, 2003 - Terry Hough based on work by 
;  1) PING by Siegfried Rings (known as the 'CodeGuru' ), 
;  2) URLtoIPAddress by PWS32 (from German forum), and 
;  3) LocalHostName by AlphaSnd (Fred) on main forum. 
; 
;PING2 is a Windows GUI version of the DOS based PING available on 
;Windows systems usually located as \WINDOWS\PING.EXE. PING2 add a 
;Windows interface and slightly extends the capabilites, yet remains 
;about 50 percent smaller. 
; 
;Plan to add an Error code interpretation in the future as time permits. 
; 

Global Dim bytes.w(4) 
Global Dim PingResult.w(6) 
Global Dim ttls.b(4) 
; 
Global PacketCount.w 
Global RecdPackets.w 
Global LostPackets.w 
Global LostPercent.f 
Global CheckOut.s 
Global message.s 
Global Command$
Global TheIPAddress.s 
Global MsgLen.b 
Global AvgTrip.f     : AvgTrip = 0 
Global MaxTrip.w     : MaxTrip = 0 
Global MinTrip.w     : MinTrip = 0 
; 
Declare lngNewAddress(strAdd.s) 
Declare Ping(strAdd.s) 
Declare.s GetIPbyName(NameIP.s) 
Declare.w Minimum(a.w,b1.w) 
Declare.w Maximum(a.w,b1.w) 
Declare GoDoIt(CheckStr.s) 
; 
If Not InitNetwork()
    MessageRequester("InitNetwork()", "Can't initialize the network !", #PB_MessageRequester_Ok|#MB_ICONSTOP)     
    End
EndIf
Command$ = "" 
Command$ = LCase(ProgramParameter()) 
If Len(Command$)>0 
  If Asc(Mid(Command$,1,1)) < 48 Or Asc(Mid(Command$,1,1)) > 57 
    url$ = Command$                     ; This is a URL instead of an IP Address, eg. www.google.com 
    IP$ = "" 
  Else 
    IP$ = Command$                      ; This is an IP Address in a string 
    url$ = "" 
  EndIf    
EndIf 

If OpenWindow(0, 1, 1, 600, 409, "PING2", #PB_Window_WindowCentered|#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar) 
  HideWindow(0,1) 
  CreateGadgetList(WindowID(0)) 
  TextGadget(1, 10, 30,160, 20, "Enter a URL", #PB_Text_Right) 
  StringGadget(2, 180, 30, 300, 20, url$) 
  TextGadget(1, 490, 30, 60, 20, "or") 
  TextGadget(1, 10, 60,160, 20, "Enter an IP Address", #PB_Text_Right) 
  IPAddressGadget(4, 180, 60, 150, 20) 
  If Len(IP$) 
    Field1.w = Val(StringField(IP$, 1, ".")) 
    Field2.w = Val(StringField(IP$, 2, ".")) 
    Field3.w = Val(StringField(IP$, 3, ".")) 
    Field4.w = Val(StringField(IP$, 4, ".")) 
    SetGadgetState(4,MakeIPAddress(Field1,Field2,Field3,Field4)) 
  EndIf    
  ButtonGadget(6, 270, 90, 60, 30, "Proceed") 
  SetActiveGadget(2) 
  While WindowEvent():Wend 
EndIf 
  ; ---------------- This is the main processing loop ---------------------- 
  If Len(Command$) 
    GoDoIt(CheckOut) 
    End                                 ; End it if running with a command tail 
  EndIf 

  HideWindow(0,0)    
  Repeat 
    EventID = WaitWindowEvent() 
      
    ; ------------------ Process the gadget events ------------------------- 

    Select EventGadget() 
        Case 6    ; Proceed button chosen 
        GoDoIt(CheckOut) 
        
    EndSelect 
      
    If EventID =  #WM_CLOSE ;  #PB_EventCloseWindow 
      Quit = 1      
    EndIf 

  ; ------------ Insure changes are saved when quit received --------------- 
  If Quit = 1 
  EndIf  

  Until Quit = 1 
  ; -------------------End of the main processing loop --------------------- 

; --------------------------------------------------------------------- 
; End of Main program code 
; --------------------------------------------------------------------- 

; Procedures 
Procedure lngNewAddress(strAdd.s) 
  sDummy.s=strAdd 
  Position = FindString(sDummy, ".",1) 
  If Position>0 
    a1=Val(Left(sDummy,Position-1)) 
    sDummy=Right(sDummy,Len(sDummy)-Position) 
    Position = FindString(sDummy, ".",1) 
    If Position>0 
      A2=Val(Left(sDummy,Position-1)) 
      sDummy=Right(sDummy,Len(sDummy)-Position) 
      Position = FindString(sDummy, ".",1) 
      If Position>0 
        A3=Val(Left(sDummy,Position-1)) 
        sDummy=Right(sDummy,Len(sDummy)-Position) 
        A4=Val(sDummy) 
        dummy.l=0 
        PokeB(@dummy,a1) 
        PokeB(@dummy+1,A2) 
        PokeB(@dummy+2,A3) 
        PokeB(@dummy+3,A4) 
        ProcedureReturn dummy 
      EndIf 
    EndIf 
  EndIf 
EndProcedure 

Procedure Ping(strAdd.s) 
  #PING_TIMEOUT = 1000
  lngHPort.l 
  lngDAddress.l 
  strMessage.s 
  lngResult.l 
  ECHO.ICMP_ECHO_REPLY 
  
  PacketCount=0
  LostPackets=0
  RecdPackets=0
  PingResult(0)=0
  
  strMessage.s = "Echo This Information Back To Me" 
  MsgLen = Len(strMessage) 
  message.s="Pinging "+CheckOut 
  If Asc(Mid(strAdd,1,1)) < 48 Or Asc(Mid(strAdd,1,1)) > 57 
    ; This is a URL instead of an IP Address, eg. www.google.com 
    GetIPbyName(strAdd)                 ; Get the IP Address for the URL 
    If Asc(Mid(TheIPAddress,1,1)) < 58  ; If successful, convert to numeric 
      lngDAddress = lngNewAddress(TheIPAddress) 
      message.s= message + " ["+TheIPAddress+"] with " 
    EndIf    
  Else 
    ; This is an IP Address in a string 
    TheIPAddress = strAdd 
    lngDAddress = lngNewAddress(strAdd) ; Convert to a numeric 
    message.s = message + " with " 
  EndIf    
  If TheIPAddress = "The Network can't be initialized." 
    message = message + Chr(10) + Chr(10) + TheIPAddress 
  ElseIf TheIPAddress = "A non-IP address was returned." 
    message = message + Chr(10) + Chr(10) + TheIPAddress 
  ElseIf TheIPAddress = "Unable to resolve domain name" 
    message = message + Chr(10) + Chr(10) + TheIPAddress 
  Else  
  lngHPort = IcmpCreateFile_() 

  message = message + Str(MsgLen)+" bytes of data:"+Chr(10)+Chr(10) 
  *buffer=AllocateMemory(SizeOf(ICMP_ECHO_REPLY)+MsgLen)
  For i = 1 To 4 
    PacketCount+1 
    lngResult = IcmpSendEcho_(lngHPort, lngDAddress, @strMessage, MsgLen , #Null,*buffer, SizeOf(ICMP_ECHO_REPLY)+MsgLen,#PING_TIMEOUT) 

    If lngResult = 0 
      message=message + "Reply from "+TheIPAddress+":  " 
      message= message + "Error no: "+ StrQ(GetLastError_()) + Chr(10) 
      PingResult(i) = -1 
      LostPackets+1 
    Else 
      CopyMemory(*buffer,@ECHO,SizeOf(ICMP_ECHO_REPLY))
      PingResult(i) = ECHO\RoundTripTime 
      bytes(i) = ECHO\DataSize 
      ttls(i) =  ECHO\Options 
      RemoteIP.s = IPString(ECHO\Address) 
      message=message + "Reply from "+RemoteIP+":  bytes = "+Str(bytes(i))+" time = "+Str(PingResult(i))+"ms TTL = "+StrU(ttls(i),#Byte)+Chr(10) 
      RecdPackets+1 
      SuccessTrip+1 
    EndIf 
    Delay(100) 
  Next 
  FreeMemory(*buffer)
  message=message + Chr(10) + "Ping statistics for "+CheckOut+":"+Chr(10) 
  message=message + "   Packets: Sent = " + Str(PacketCount) 
  message=message + ", Received = " + Str(RecdPackets) 
  message=message + ", Lost = " + Str(LostPackets) 
  If LostPackets = 0 
    LostPercent = 0 
  Else 
    LostPercent = (LostPackets/PacketCount)*100 
  EndIf 
  message=message + " ("+StrF(LostPercent,0)+"% loss)"+Chr(10)+Chr(10) 
  PingResult(5)=255 
  PingResult(6)=0 
  For i = 1 To 4 
    If PingResult(i)> 0 
      PingResult(6) = Maximum(PingResult(6),PingResult(i)) 
      PingResult(5) = Minimum(PingResult(5),PingResult(i)) 
      PingResult(0)+PingResult(i) 
    EndIf 
  Next 
  MinTrip = PingResult(5) 
  MaxTrip = PingResult(6) 
  If RecdPackets 
    AvgTrip = PingResult(0)/RecdPackets 
  Else 
    AvgTrip = PingResult(6) 
  EndIf 
  If AvgTrip > 0 
    message=message + "Approximate round trip times in milli-seconds:"+Chr(10) 
    message=message + "    Minimum = "+Str(MinTrip)+"ms,  Maximum = "+Str(MaxTrip)+",  Average = "+StrF(AvgTrip,2)+"ms" 
  EndIf 
  lngResult = IcmpCloseHandle_(lngHPort) 
  ProcedureReturn PingResult 
EndIf 
EndProcedure 

Procedure.s GetIPbyName(NameIP.s) 
  TheIPAddress.s 
    pHostinfo = gethostbyname_(NameIP) 
    If pHostinfo = 0 
      TheIPAddress = "Unable to resolve domain name" 
     Else 
      CopyMemory (pHostinfo, hostinfo.HOSTENT, SizeOf(HOSTENT)) 
      If hostinfo\h_addrtype <> #AF_INET 
        TheIPAddress = "A non-IP address was returned." 
      Else 
        While PeekL(hostinfo\h_addr_list+AdressNumber*4) 
          ipAddress = PeekL(hostinfo\h_addr_list+AdressNumber*4) 
          TheIPAddress = StrU(PeekB(ipAddress),0)+"."+StrU(PeekB(ipAddress+1),0)+"."+StrU(PeekB(ipAddress+2),0)+"."+StrU(PeekB(ipAddress+3),0) 
          AdressNumber+1 
        Wend 
      EndIf 
    EndIf 
  ProcedureReturn TheIPAddress 
EndProcedure 

Procedure.w Minimum(a.w,b1.w) 
  If a < b1 
    c1.w = a 
  Else 
    c1.w = b1 
  EndIf 
  ProcedureReturn c1 
EndProcedure 

Procedure.w Maximum(a.w,b1.w) 
  If a > b1 
    c1 = a 
  Else 
    c1 = b1 
  EndIf 
  ProcedureReturn c1 
EndProcedure 

Procedure GoDoIt(CheckStr.s) 
  CheckOut = GetGadgetText(2) 
  CheckOut = RemoveString(CheckOut, "http://") 
  CheckOut = RemoveString(CheckOut, "ftp://") 
  If Len(CheckOut)  
    Ping(CheckOut) 
  Else 
    CheckOut.s = GetGadgetText(4) 
    Ping(CheckOut) 
  EndIf    
  MessageRequester("PING2", message, #MB_ICONINFORMATION) 
  ;SetGadgetText(2,"") 
  ;SetGadgetText(4,"") 
  SetActiveGadget(2) 
EndProcedure 

; ExecutableFormat=Windows
; FirstLine=1
; EnableXP
; EOF

Andre · Beitrag von **Andre** » 01.11.2006 20:09

@KeyPusher: danke, hab den aktualisierten Code aufgenommen.

Deeem2031 · Beitrag von **Deeem2031** » 01.11.2006 21:27

Ich glaube http://www.purearea.net/pb/CodeArchiv/R ... osition.pb ist unübersetzbar. Das sieht nämlich so aus, als wenn man da einen Bug ausnutzt, der aber in 4.0 nicht mehr vorhanden ist.

http://www.purearea.net/pb/CodeArchiv/I ... HTTPGet.pb ist nicht praxistauglich weil der Code vorraussetzt das der Server immer die "Content-Length: " Eigenschaft mitsendet, was nicht der Fall ist. Würde also vorschlagen den Code rauszunehmen.

http://www.deeem2031.de/PB/CodeArchiv/R ... quester.pb

KeyPusher · Beitrag von **KeyPusher** » 01.11.2006 22:10

zu http://www.purearea.net/pb/CodeArchiv/I ... HTTPGet.pb

nur in soweit bearbeitet, das es mit PB4.0 funktioniert, aber auch das files ge'download'ed werden können die kein 'content-length' und im extrem fall auch gar keinen header haben.

ansonsten hab ich auch hier wieder, den code soweit wie möglich unangetastet gelassen.

Code: Alles auswählen

; English forum:
; Author: Berikco
; Date: 22. September 2002


; HTTP file download
; 09/22/2002
; By Berikco
; v1.1
;
Global filenaam$

; zum Beispiel:
; http://mesh.dl.sourceforge.net/sourceforge/sevenzip/7z442.exe
server$="mesh.dl.sourceforge.net"
Port = 80
url$="/sourceforge/sevenzip/"
filenaam$="7z442.exe"

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf

#bufferlengte=10240
Global Buffer
Buffer = AllocateMemory(#bufferlengte) 
Global buf$
Global EOL$
EOL$ = Chr(13)+Chr(10)

Global Size
Global oldsize
Global rate
Global ratetel
Global buf$
Global Header
Global startReceive
Global hwnd
Global ConnectionID
Global filesize
Global timeout
Global aniwin
Global h
Global einde
;
h=LoadLibrary_("Shell32.dll") 

Procedure incoming(result)
  b.b=0
  b$=""
  rest=0
  Select Header
  Case 0
    SendMessage_(aniwin,#ACM_OPEN,h,160) 
    i=0
    
    Repeat
      If PeekB(Buffer+i)=13 And PeekB(Buffer+i+1)=10 And PeekB(Buffer+i+2)=13 And PeekB(Buffer+i+3)=10
        b$=Space(i+4)
        CopyMemory(Buffer,@b$,i+4)
        rest=i+4
        Break 
      EndIf
      i+1
    Until i=result
    If i=result
        b$=EOL$
        startReceive=1
    EndIf
    ;
    Repeat
        ;
        If Left(b$,2)=EOL$
            b$=Mid(b$,3,Len(b$)-3)
            If startReceive=1
                If CreateFile(1,filenaam$)
                    WriteData(1,Buffer+rest, result-rest)
                    Header=1
                    Size=result-rest
                    SetGadgetText(4,"Received "+Str(Size)+" of "+Str(filesize)+" bytes")
                Else
                    Header=2
                EndIf     
                Break
            EndIf
        Else
            search=FindString(b$, EOL$ , 1)
            If search>0
                l$=Left(b$,search-1) 
                b$=Mid(b$,search+2,Len(b$))
                pos=FindString(l$,"200 " , 1) 
                If pos
                    startReceive=1  ; ok
                Else
                    pos=FindString(l$,"404 " , 1) 
                    If pos
                        ;error 404 not founf
                    Else
                        pos=FindString(LCase(l$),"content-length:" , 1) 
                        If pos
                            pos=FindString(l$," " , 1) 
                            filesize=Val(Mid(l$,pos+1,Len(l$)))
                        EndIf
                    EndIf
                EndIf
                Debug l$
            Else
                l$=""
                b$=EOL$
                search=1
                startReceive=1
            EndIf
        EndIf ;
    Until search=0
  Case 1
    timeout=0
    WriteData(1,Buffer, result)
    Size+result
    If filesize
        FileSize$=Str(filesize)
        stap=100*Size/filesize
    Else
        FileSize$="??"
        stap=0
    EndIf
    SetGadgetText(4,"Received "+Str(Size)+" of "+Str(filesize)+" bytes")
    SetGadgetState(2, stap)
    If filesize=Size
      Debug "File Received"
      Header=2
      Debug Str(Size)+" of "+Str(filesize)+" bytes"
    EndIf  
  Case 2
    CloseFile(1)
    CloseNetworkConnection(ConnectionID)
    Debug "Connection Closed"
    Header=3
    DestroyWindow_(aniwin)
    einde=1
  EndSelect
EndProcedure
;
Procedure MyWindowCallback(WindowID, message, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents 
  Select WindowID
  Case hwnd
    Select message
    Case #WM_TIMER 
      result=0
      Select wParam
      Case 1 ; timer
        result=ReceiveNetworkData(ConnectionID, Buffer, #bufferlengte)
        If result=0
            filesize=Size
        EndIf
        incoming(result)
      Case 2  ; timeout
        timeout+1
        If timeout>10
          CloseFile(1)
          Header=2
          Debug "Timeout"     
        EndIf
      Case 3
        ratetel+500
        If ratetel>0
          rate=Size/ratetel
        EndIf
        SetGadgetText(3,"Download speed..."+Str(rate)+" KB/s.  Time "+Str(ratetel/1000)+" s.") 
      EndSelect
    EndSelect
  EndSelect
  ProcedureReturn result 
EndProcedure 
;
hwnd=OpenWindow(0,100,450,335,160,"Downloading "+filenaam$+" from "+server$,#PB_Window_SystemMenu)
;
If hwnd
  If CreateGadgetList(WindowID(0))
    ButtonGadget(1, 250, 128,  72, 20, "Cancel")
    ProgressBarGadget(2, 10, 100, 313, 20, 0, 100)
    TextGadget(3, 20, 80,  280, 15, "")
    TextGadget(4, 20, 65,  280, 15, "")
    ;
    aniwin=CreateWindowEx_(0,"SysAnimate32","",#ACS_AUTOPLAY|#ACS_CENTER|#ACS_TRANSPARENT|#WS_CHILD|#WS_VISIBLE|#WS_CLIPCHILDREN|#WS_CLIPSIBLINGS,25,10,280,50, hwnd,0,GetModuleHandle_(0),0)
    ;
    ConnectionID = OpenNetworkConnection(server$, Port)
    ;
    If ConnectionID
      SendNetworkString(ConnectionID, "GET "+url$+filenaam$+" HTTP/1.0"+EOL$)
      SendNetworkString(ConnectionID, "Host: "+server$+EOL$)
      SendNetworkString(ConnectionID, "Accept: */*"+EOL$)
      SendNetworkString(ConnectionID, EOL$)
    ;
    SetWindowCallback(@MyWindowCallback()) 
    ; -------------- timers ----------------
    SetTimer_(hwnd,1,20,0) ; 20 milisecond timer
    SetTimer_(hwnd,2,1000,0) ; 1 sec timer
    SetTimer_(hwnd,3,500,0) ; 500 msec timer    
    ;
    Repeat
      EventID=WaitWindowEvent() 
        Select EventGadget()
        Case 1
            Header=2
        EndSelect
    Until einde=1
    EndIf
  EndIf
EndIf
FreeLibrary_(h)
Delay(4000)
;
End
; ExecutableFormat=
; CursorPosition=4
; FirstLine=1
; EOF

KeyPusher · Beitrag von **KeyPusher** » 01.11.2006 22:36

@Deeem2031: ich denke doch das http://www.purearea.net/pb/CodeArchiv/R ... osition.pb noch übersetzbar ist. bei mir hat's so geklappt. hab das flag #PB_Window_Invisible weggelassen. weil breite und höhe jeweils 0 sind, siehts man dennoch nicht.

versuch mal das hier:

Code: Alles auswählen

; English forum: http://purebasic.myforums.net/viewtopic.php?t=6719
; Author: eddy (updated for PB3.93 by ts-soft)
; Date: 25. June 2003

;- Procedure-Code
Global WINDOW_Requester
; ///////////////////// 
; Set position 
; ///////////////////// 


Procedure SetRequesterPosition(x,y,ParentWin) 
  ;create the invisible window which defines the position of requester 
  If WINDOW_Requester = 0
    WINDOW_Requester =  OpenWindow(#PB_Any,x,y,0,0,"Temp Hidden Window",#PB_Window_BorderLess,WindowID(ParentWin)) 
  EndIf 
  
  If WindowID(WINDOW_Requester)        
    ResizeWindow(WINDOW_Requester,x,y,#PB_Ignore,#PB_Ignore)    
  EndIf 
EndProcedure  


;- Example-Code
GetCursorPos_(@pt.POINT) 
SetRequesterPosition(pt\x,pt\y,ParentWin) 
c = ColorRequester() 

; ExecutableFormat=Windows
; FirstLine=1
; EOF

Deeem2031 · Beitrag von **Deeem2031** » 02.11.2006 00:42

"#Window object not initialized."...
Wichtig ist ja auch nicht, dass der Code einfach nur läuft, sondern das er auch das macht was er ursprünglich machte, und zwar den RequesterPosition zu setzen - und ich seh keine Zusammenhang zwischen OpenWindow()/ResizeWindow() und ColorRequester().

http://www.purearea.net/pb/CodeArchiv/G ... ktypes2.pb hab ich zwar nich für 4.0 übersetzt bekommen, weil mir auch "AdvancedGadgetEvents(#True)" fehlt (wo kommtn das her?) aber mit PB.Net läuft das Bsp

Code: Alles auswählen

; German forum:
; Author: CyberRun8 
; Date: 03. April 2003

;Beispiel von CyberRun8 
;für PureBasic 3.62 
;März 2003 

;-Konstanten setzen 
#Window = 0 

#Gadget1 = 0 
#Gadget2 = 1 
#Gadget3 = 2 

;-Fenster mit Gadgets darstellen 
If OpenWindow(#Window, 100, 150, 240, 90, "AdvancedGadgetEvents", #PB_Window_MinimizeGadget) 
  If CreateGadgetList(WindowID(#Window)) 
    ;AdvancedGadgetEvents(#True) ; <---- 
    ButtonGadget(#Gadget1, 5, 5, 230, 20, "Doppelklick-Button") 
    ButtonGadget(#Gadget2, 5, 35, 230, 20, "Einfachklick-Button") 
    ;AdvancedGadgetEvents(#False); <---- 
    ButtonGadget(#Gadget3, 5, 65, 230, 20, "Gadget ohne Advanced-Funktion") 
  EndIf 
EndIf 

Debug "Focusangabe:" 
;-Schleife 
Repeat 
  EventID.l = WaitWindowEvent() 
  
  If EventID = #PB_Event_Gadget    
    Select EventGadget() 
      Case #Gadget1 
        If EventType() = #PB_EventType_Focus 
          Debug "Focus auf Doppelklick-Button gesetzt"                
        ElseIf EventType() = #PB_EventType_LeftDoubleClick 
          MessageRequester("Info", "Linksdoppelklick", 0) 
        ElseIf EventType() = #PB_EventType_RightDoubleClick 
          MessageRequester("Info", "Rechtsdoppelklick", 0)              
        EndIf 
      Case #Gadget2 
        If EventType() = #PB_EventType_LeftClick          
          MessageRequester("Info", "Linksklick auf Einfachklick-Button", 0) 
        ElseIf EventType() = #PB_EventType_RightClick          
          MessageRequester("Info", "Rechtsklick auf Einfachklick-Button", 0) 
        ElseIf EventType() = #PB_EventType_Focus 
          Debug "Focus auf Einfachklick-Button gesetzt" 
        EndIf 
      Case #Gadget3 
        ;Folgende Abfrage ist ohne Funkton weil für Gadget3 die fortgeschrittene Ereignisangabe 
        ;abgeschaltet wurde. 
        If EventType() = #PB_EventType_Focus 
          Debug "Focus auf Doppelklick-Button gesetzt"                
        ElseIf EventType() = #PB_EventType_LeftDoubleClick 
          MessageRequester("Info", "Linksdoppelklick", 0) 
        ElseIf EventType() = #PB_EventType_RightDoubleClick 
          MessageRequester("Info", "Rechtsdoppelklick", 0)              
        EndIf          
    EndSelect 
  EndIf        
Until EventID = #PB_Event_CloseWindow 
End

http://www.deeem2031.de/PB.Net/ButtonGa ... types2.exe

KeyPusher · Beitrag von **KeyPusher** » 02.11.2006 11:18

@Deeem2031:
der requester wird dort hin gesetzt, wo man mit der maus beim aufruf der procedure ist. das hab ich getestet. wenn du beim testen ein "#Window object not initialized" bekommen hast, könnte das daran liegen, das du vorher kein fenster geöffnet hast und "nur" die procedure so ausprobiert hast wie sie da steht?
und nur weil man selber keinen zusammenhang zwischen verschiedenen dingen sieht, heisst das nicht, das es diesen zusammenhang auch nicht gibt.

warum da ein resize- oder vorher ein movewindow drin ist, hättest du auch so gesehen, wenn du dir den code angeschaut hättest. dann wäre dir aufgefallen, das das fenster WINDOW_Requester nicht wieder geschlossen wird. wenn es dann ein zweites mal gebraucht wird, wird es nur neu positioniert. wenn es also einen zusammenhang gibt, dann nur zwischen dem requester und dem aktuellen fenster (das man nicht sehen kann). und das macht ja auch sinn, das der requester in dem fenster erscheint, in dem ich arbeite oder?

ok. das ganze noch mal mit einem parent-fenster. ich hab aber gedacht, das du dir den code noch mal anschaust und in dem procedure-aufruf das "ParentWin" sehen würdest. aber egal.

Code: Alles auswählen

;English forum: http://purebasic.myforums.net/viewtopic.php?t=6719
; Author: eddy (updated for PB3.93 by ts-soft)
; Date: 25. June 2003

;- Procedure-Code
Global WINDOW_Requester
; /////////////////////
; Set position
; /////////////////////

ParentWin=OpenWindow(#PB_Any,100,100,500,500,"Test Window")

Procedure SetRequesterPosition(x,y,ParentWin)
  ;create the invisible window which defines the position of requester
  If WINDOW_Requester = 0
    WINDOW_Requester =  OpenWindow(#PB_Any,x,y,0,0,"Temp Hidden Window",#PB_Window_BorderLess,WindowID(ParentWin))
  EndIf
 
  If WindowID(WINDOW_Requester)       
    ResizeWindow(WINDOW_Requester,x,y,#PB_Ignore,#PB_Ignore)   
  EndIf
EndProcedure 


;- Example-Code
GetCursorPos_(@pt.POINT)
SetRequesterPosition(pt\x,pt\y,ParentWin)
c = ColorRequester()

; ExecutableFormat=Windows
; FirstLine=1
; EOF

Leonhard · Beitrag von **Leonhard** » 02.11.2006 13:33

Requester - RequesterPositions
http://www.purearea.net/pb/CodeArchiv/R ... osition.pb

Code: Alles auswählen

; English forum: http://purebasic.myforums.net/viewtopic.php?t=6719
; Author: eddy (updated for PB3.93 by ts-soft)
; Date: 25. June 2003

;- Procedure-Code
Global WINDOW_Requester
; ///////////////////// 
; Set position 
; ///////////////////// 

Procedure SetRequesterPosition(x,y, ParentID=#PB_Ignore) 
  ;create the invisible window which defines the position of requester 
  If WINDOW_Requester = 0
    If ParentID=#PB_Ignore
      WINDOW_Requester =  OpenWindow(#PB_Any,x,y,0,0,"Temp Hidden Window",#PB_Window_BorderLess|#PB_Window_Invisible)
    Else
      WINDOW_Requester =  OpenWindow(#PB_Any,x,y,0,0,"Temp Hidden Window",#PB_Window_BorderLess|#PB_Window_Invisible,ParentID) 
    EndIf
  EndIf 
  
  If WindowID(WINDOW_Requester)
    ResizeWindow(WINDOW_Requester,x,y,#PB_Ignore,#PB_Ignore)
  EndIf 
EndProcedure  


;- Example-Code
GetCursorPos_(@pt.POINT)
SetRequesterPosition(pt\x,pt\y)
c = ColorRequester()

; ExecutableFormat=Windows
; FirstLine=1
; EOF