FreeBasic: Kleinigkeiten

Aus Wikibooks
Zur Navigation springen Zur Suche springen

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.