FreeBasic: Kleinigkeiten

SleepAPI Bearbeiten

 'Declare Sub Sleep Lib "kernel32" (Byval dwMilliseconds As Long)
 
 Declare Sub SleepAPI Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Integer)
 Dim time1 As Single
 Dim time2 As Single
 dim x     as single
 screen 12
 
 for i=1 to 20
     time1 = Timer
     SleepAPI 1156
     time2 = Timer
     ? time2 - time1
 next i
 
 Sleep

Dieser Quellcode wurde von MichaelFrey am 11.06.2006 mit der Freebasic Version 0.16 Beta getestet.


Wie lange läuft der Computer? Bearbeiten

WinAPI Bearbeiten

 Declare Function GetTickCount Lib "kernel32" alias "GetTickCount" () As Long
 ? GetTickCount()
 sleep

Dieser Quellcode wurde von MichaelFrey am 11.06.2006 mit der Freebasic Version 0.16 Beta getestet.


Timer Bearbeiten

 ? timer
 sleep

Dieser Quellcode wurde von MichaelFrey am 11.06.2006 mit der Freebasic Version 0.16 Beta getestet.


INPOUT32.dll Bearbeiten

 dim library as integer
 dim OUT32 as sub ( byval Adresse AS INTEGER, byval Wert AS INTEGER)
 
 library = dylibload( "INPOUT32.dll" )
 Out32 = dylibsymbol( library, "Out32" )
 
 screen 12
 
 if( library = 0 ) then
    print "INPOUT32.dll nicht gefunden."
    end 1
 end if
 
 for i=0 to 255
    out32(888,i)
    sleep 1000
 Next i

URLDownloadToFile Bearbeiten

 Dim URLDownloadToFile as function (_
   ByVal pCaller As Long, _
   ByVal szURL As zString ptr, _
   ByVal szFileName As zString ptr, _
   ByVal dwReserved As Long, _
   ByVal lpfnCB As Long) As Long 
 
 Dim lR As Long
 Dim sURL As String
 Dim sFile As String
 
 library = dylibload( "urlmon.dll" )
 URLDownloadToFile = dylibsymbol( library, "URLDownloadToFileA" )
 
 sURL = "http://de.wikibooks.org"
 
 sFile = "C:\test.htm"
 
 lR = URLDownloadToFile(0, sURL, sFile, 0, 0)
 
 If lR = 0 Then
   Print "Download erfolgreich!"
 Else
   Print "Fehler beim Download!"
 End If
 
 sleep

Fenster verstecken Bearbeiten

Konsolen Fenster Bearbeiten

'' Anmerkung:
'' Lässt sich nicht mit -s gui kompilieren, da sonst gar kein Konsolenfenster mehr existiert
''
'' Lauffähig unter CVS 0.18
''
'' (PMedia)

#include "Windows.bi"

Dim hWndConsole As HWND
Dim FensterName As String

FensterName=Command$(0)

hWndConsole = FindWindow(0, strptr(FensterName))
Sleep 1000
ShowWindow(hWndConsole, SW_HIDE) 'weg ist es
Sleep 1000 'für eine Sekunde
ShowWindow(hWndConsole, SW_SHOW) ' und nun ist es wieder da
Sleep 'und wartet auf einen Tastendruck.

Dieser Quellcode wurde von PMedia am 18.07.2007 mit der Freebasic Version 0.18 CVS getestet.


 #include "Windows.bi"
 
 Dim hWndConsole As HWND
 Dim FensterName$
 
 FensterName$=Command$(0)
 
 hWndConsole = FindWindow(0, strptr(FensterName$))
 Sleep 1000
 ShowWindow(hWndConsole, SW_HIDE) 'weg ist es
 Sleep 1000 'für eine Sekunde
 ShowWindow(hWndConsole, SW_SHOW) ' und nun ist es wieder da
 Sleep 'und wartet auf einen Tastendruck.

Dieser Quellcode wurde von MichaelFrey am 16.06.2006 mit der Freebasic Version 0.16 Beta getestet.


Grafik Fenster Bearbeiten

 #include "Windows.bi"
 
 Dim hWndConsole As HWND
 
 screen 12
 
 WindowTitle "Verschwinde!"
 
 hWndConsole = FindWindow(0, strptr("Verschwinde!"))
 Sleep 1000
 ShowWindow(hWndConsole, SW_HIDE) 'weg ist es
 Sleep 1000 'für eine Sekunde

 WindowTitle "Wieder da"

 ShowWindow(hWndConsole, SW_SHOW) ' und nun ist es wieder da
 Sleep 'und wartet auf einen Tastendruck.

Dieser Quellcode wurde von MichaelFrey am 16.06.2006 mit der Freebasic Version 0.16 Beta getestet.


Jederzeit Beenden Bearbeiten

Dim shared as integer x, y
Dim shared thread As Any ptr
Declare sub ender()
Screen 19

Thread=threadcreate(@ender)
do
 GetMouse x,y
 Locate 1,1
 ?Using "####";x;"####";y
Loop
ThreadWait(Thread)
end

sub ender()
 Do
 Loop until multikey(&H1) ' Escape taste
 End
end Sub

Dieser Quellcode wurde von Rens_van_schie am 31.10.2007 mit der Freebasic Version 0.18.3 getestet.