 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
 Verfasst am: 18.02.2013, 00:20 Titel: Flimmern |
 |
|
Hi Leute ich hoffe ihr könnt mir mal wieder helfen. Ich hab mir eine .bi angelegt die verschiedene Objekte verwalten soll um es mir so zu vereinfachen ob und auf welches Objekt mit der Maus geklickt wurde. Ich hatte schon ein ähnliches Problem das ich hier gepostet hatte und das ist gelöst.
Hab nun ein vorheriges Projekt mit diesem verbunden und es funzt auch ganz gut doch leider flimmert es zu stark und das sehr unregelmäßig ich hab keine Ahnung wie ich das beheben kann. Ich hoffe es ist nicht zuuu unübersichlich.
Hier als erstes die .bi und danach das Program
| Code: | ' Funktion zur Objektverwaltung
' (anzeigen und zb Mausverhalten auf diese)
'
' BMPs - Buttons - Textfelder
' CreOb (,,,,,,,,,,)
' CreOb (ObjName(0/1/>999), pos_W, pos_H, groesse_W, groesse_H, BG_farbe,
' BG_Grafik_bmp(mussgleiche groesse wie Txtfeld), Text, Textfarbe,
' Textart(0/1), Serie(1-10), Move(0/1))
'
' ObjName ist ehr eine Nummer
' ObjName = 0 - Nummer wird beibehalten und mit selben verknuepft wobei SERIE
' die Reihenfolge festlegt
' ObjName = 1 - Nummer wird neu erstellt - MUSS gewaehlt werden werden das erste mal
' ein Objekt angelegt wird (mit automatischer
' Nummerrierung)
' ObjName > 999 selbstfesgelegter Name
'
' Serie 1-10 ist nur bei selbst festgelegtem ObjNamen anzugeben, sonst 0 angeben
'
' Pos.. = 0 so wird diese per RANDOMIZE TIMER festgelegt
'
' BG_farbe > 0 dann wird Grafik ignoriert
'
' wird ein BG oder eine Graphik angegeben UND auch TEXT so wird dieser mittig
' des BGs angezeigt
'
' Textart = 0 - normaler FB String
' Textart = 1 - kleiner String per autowrite
'
' Move = 1 - Objekt ist mit Maus verschiebbar
'
' weitere Idee:
'
' Aufruf zum loeschen des Objektes
' Rückgabefunktionen zB der Pos zum neu setzen der Pos durch verschieben mit
' der Maus
' ##############################################################################
#Include Once "autowrite.bi"
#Include Once "openBildPSET.bi"
TYPE Objektblock
Nummer AS Integer
pwide AS INTEGER
phigh AS INTEGER
owide AS INTEGER
ohigh AS INTEGER
farbe AS Double
Grafik AS String
Text AS String
TextF AS Double
Textart AS Integer
Serie AS Integer
Move AS Integer
visibility AS String
END TYPE
DIM SHARED Objekt() AS Objektblock
TYPE Objektblock2
Nummer AS Integer
pwide AS INTEGER
phigh AS INTEGER
owide AS INTEGER
ohigh AS INTEGER
farbe AS Double
Grafik AS String
Text AS String
TextF AS Double
Textart AS Integer
Serie AS Integer
Move AS Integer
visibility AS String
END TYPE
DIM SHARED Ob_tmp(10) AS Objektblock2
TYPE Objektblock3
pw_a AS INTEGER
ph_a AS INTEGER
END TYPE
DIM SHARED Ob_koor(2 TO 10) AS Objektblock3
DIM SHARED AS Integer TALAS1 ' (This Arraynumber is the Last Arraynumber with Seriesnumber 1)
DIM SHARED AS Integer i_array, i_counter, i_objekt, info_W, info_H, text_spalte, text_zeile, _
Obj_maus_W, Obj_maus_H, Obj_maus_B, Obj_in_Move, Obj_TO_Move, markiert, _
Obj_maus_Wa, Obj_maus_Ha, Obj_wide_a, Obj_high_a, New_Dim, Kill_num, _
focus_number, Obj_maus_Wext, Obj_maus_Hext
DIM SHARED AS Integer i_serie = 1
DIM Shared AS Integer ObjektName = 0
Randomize Timer
DIM SHARED AS Integer i_test ' fuer testzwecke
' ################################## DECLAREs ##################################
Declare SUB CreOb(Obj_Name AS Integer, Obj_pos_W AS Integer, Obj_pos_H AS Integer, _
Obj_gr_W AS Integer, Obj_gr_H AS Integer, Obj_BG_farbe AS Double, Obj_Grafik AS String, _
Obj_Text AS String, Obj_Textfarbe AS Double, Obj_Textart AS Integer, Obj_Serie AS Integer, Obj_Move AS Integer)
Declare SUB ShowOb(von_num AS Integer, bis_num AS Integer)
Declare SUB ObjMove
Declare SUB Kill_Obj(Obj_num AS Integer)
Declare SUB SetPos(Obj_num AS Integer, new_W AS Integer, new_H AS Integer)
Declare SUB SetText(Obj_num AS Integer, Obj_Serie AS Integer, new_T AS String)
Declare SUB SetMouseFrame(Obj_S AS Integer, framecolor AS Double)
Declare SUB Hide_Obj(Obj_num AS Integer)
Declare SUB Unhide_Obj(Obj_num AS Integer)
Declare SUB testi
Declare Function in_Focus AS Integer
Declare Function click_on_series(obj_num AS Integer, Obj_S AS Integer) AS Integer
Declare Function Objekt_APP AS Integer
Declare Function GetText(obj_num AS Integer, obj_Serie AS Integer) AS String
' Declare Function click_on(Obj_number AS Integer) AS Integer
' ##################################### SUBs ###################################
SUB CreOb(Obj_Name AS Integer, Obj_pos_W AS Integer, Obj_pos_H AS Integer, _
Obj_gr_W AS Integer, Obj_gr_H AS Integer, Obj_BG_farbe AS Double, Obj_Grafik AS String, _
Obj_Text AS String, Obj_Textfarbe AS Double, Obj_Textart AS Integer, Obj_Serie AS Integer, Obj_Move AS Integer)
REDIM PRESERVE Objekt(UBound(Objekt) + 1)
ScreenInfo info_W, info_H
IF Obj_Name = 0 THEN ' Erkennungsnummer beibehalten
Objekt(UBound(objekt)).Nummer = ObjektName
i_serie += 1 ' -hierbei wird Serie autom. erhoeht
Objekt(UBound(objekt)).Serie = i_serie
ELSEIF Obj_Name = 1 THEN ' NEUE Erkennungsnumer
FOR i_objekt = 1 TO 99
ObjektName = i_objekt
FOR i_array = 1 TO UBound(objekt)
IF objekt(i_array).Nummer = i_objekt THEN ObjektName = 0
NEXT i_array
IF ObjektName > 0 THEN EXIT FOR
NEXT i_objekt
Objekt(UBound(objekt)).Nummer = ObjektName
i_serie = 1 ' -Serie ist hierbei 1
Objekt(UBound(objekt)).Serie = i_serie
TALAS1 = UBound(objekt)
ELSEIF Obj_Name > 99 THEN ' Erkennungsnummer wurde selbst definiert
Objekt(UBound(objekt)).Nummer = Obj_Name
Objekt(UBound(objekt)).Serie = Obj_Serie ' -hier wird selbstdefinierte Seriennummer gebraucht
IF Obj_Serie = 1 THEN TALAS1 = UBound(objekt)
ELSE
EXIT SUB
END IF
IF objekt(UBound(objekt)).Serie > 1 THEN
FOR i_array = 1 TO UBound(objekt)
IF objekt(i_array).Nummer = Objekt(UBound(objekt)).Nummer AND objekt(i_array).Serie = 1 THEN
objekt(UBound(objekt)).pwide = objekt(i_array).pwide + Obj_pos_W
objekt(UBound(objekt)).phigh = objekt(i_array).phigh + Obj_pos_H
EXIT FOR
END IF
NEXT i_array
ELSE
IF Obj_pos_W = 0 THEN
objekt(UBound(objekt)).pwide = int(rnd * (info_W - Obj_gr_W)) + 1
ELSE
objekt(UBound(objekt)).pwide = Obj_pos_W
END IF
IF Obj_pos_H = 0 THEN
objekt(UBound(objekt)).phigh = int(rnd * (info_H - Obj_gr_H)) + 1
ELSE
objekt(UBound(objekt)).phigh = Obj_pos_H
END IF
END IF
Objekt(UBound(objekt)).owide = Obj_gr_W
Objekt(UBound(objekt)).ohigh = Obj_gr_H
Objekt(UBound(objekt)).farbe = Obj_BG_farbe
Objekt(UBound(objekt)).Grafik = Obj_Grafik
Objekt(UBound(objekt)).Text = Obj_Text
Objekt(UBound(objekt)).TextF = Obj_Textfarbe
Objekt(UBound(objekt)).Textart = Obj_Textart
Objekt(UBound(objekt)).Move = Obj_Move
Objekt(UBound(objekt)).visibility = "unhide"
End Sub
SUB ShowOb(von_num AS Integer, bis_num AS Integer)
IF von_num < 1 THEN EXIT SUB
IF bis_num < 1 THEN bis_num = von_num
FOR i_array = 1 TO UBound(objekt)
FOR i_objekt = von_num TO bis_num
IF i_objekt = objekt(i_array).Nummer AND Objekt(i_array).visibility = "unhide" THEN
ScreenLock
IF objekt(i_array).farbe <> 0 THEN
Line(objekt(i_array).pwide, objekt(i_array).phigh) - _
STEP(objekt(i_array).owide, objekt(i_array).ohigh), objekt(i_array).farbe, BF
ELSEIF objekt(i_array).farbe = 0 AND objekt(i_array).Grafik <> "" THEN
openbildPSET(objekt(i_array).Grafik, objekt(i_array).owide, objekt(i_array).ohigh, objekt(i_array).pwide, objekt(i_array).phigh)
END IF
IF (objekt(i_array).farbe <> 0 OR objekt(i_array).Grafik <> "") AND _
objekt(i_array).Text <> "" AND objekt(i_array).Textart = 0 THEN
Color objekt(i_array).TextF
Draw String ((objekt(i_array).pwide + (objekt(i_array).owide / 2)) - (LEN(objekt(i_array).Text) * 4), _
(objekt(i_array).phigh + (objekt(i_array).ohigh / 2)) - 4), objekt(i_array).Text
ELSEIF (objekt(i_array).farbe <> 0 OR objekt(i_array).Grafik <> "") AND _
objekt(i_array).Text <> "" AND objekt(i_array).Textart = 1 THEN
autowrite(objekt(i_array).TextF, (objekt(i_array).pwide + (objekt(i_array).owide / 2)) - (LEN(objekt(i_array).Text) * 3) + 1, _
(objekt(i_array).phigh + (objekt(i_array).ohigh / 2)) - 3, objekt(i_array).Text, 0)
ELSEIF objekt(i_array).farbe = 0 AND objekt(i_array).Grafik = "" AND _
objekt(i_array).Text <> "" AND objekt(i_array).Textart = 0 THEN
text_spalte = 0: text_zeile = 0: Color objekt(i_array).TextF
FOR i_counter = 1 TO LEN(objekt(i_array).Text)
Draw String (objekt(i_array).pwide + text_spalte, objekt(i_array).phigh + text_zeile), _
MID(objekt(i_array).Text, i_counter, 1)
text_spalte += 8
IF text_spalte + 8 > objekt(i_array).owide THEN text_spalte = 0: text_zeile += 11
IF text_zeile + 11 > objekt(i_array).ohigh THEN EXIT FOR
NEXT i_counter
ELSEIF objekt(i_array).farbe = 0 AND objekt(i_array).Grafik = "" AND _
objekt(i_array).Text <> "" AND objekt(i_array).Textart = 1 THEN
text_spalte = 0: text_zeile = 0
FOR i_counter = 1 TO LEN(objekt(i_array).Text)
autowrite(objekt(i_array).TextF, objekt(i_array).pwide + text_spalte, objekt(i_array).phigh + text_zeile, _
MID(objekt(i_array).Text, i_counter, 1), 0)
text_spalte += 6
IF text_spalte + 6 > objekt(i_array).owide THEN text_spalte = 0: text_zeile += 9
IF text_zeile + 9 > objekt(i_array).ohigh THEN EXIT FOR
NEXT i_counter
END IF
ScreenUnLock
END IF
NEXT i_objekt
NEXT i_array
END SUB
SUB ObjMove
DIM AS Integer dif_W, dif_H
GetMouse (Obj_maus_W, Obj_maus_H, , Obj_maus_B)
IF Obj_maus_B = 0 THEN
Obj_in_Move = 0: EXIT SUB
ELSEIF (Obj_maus_B = 1) AND (objekt(TALAS1).Move) AND (Objekt(TALAS1).visibility = "unhide") THEN
IF Obj_in_Move = 0 THEN
IF in_Focus = 0 THEN EXIT SUB
Obj_maus_Wa = Obj_maus_Wext
Obj_maus_Ha = Obj_maus_Hext
Obj_wide_a = objekt(TALAS1).pwide
Obj_high_a = objekt(TALAS1).phigh
IF TALAS1 < UBound(objekt) THEN
FOR i_objekt = (TALAS1 + 1) TO UBound(objekt)
ob_koor(objekt(i_objekt).Serie).pw_a = objekt(i_objekt).pwide - objekt(TALAS1).pwide
ob_koor(objekt(i_objekt).Serie).ph_a = objekt(i_objekt).phigh - objekt(TALAS1).phigh
NEXT i_objekt
END IF
Obj_in_Move = 1
END IF
dif_W = Obj_maus_W - Obj_maus_Wa
dif_H = Obj_maus_H - Obj_maus_Ha
IF Obj_wide_a + dif_W < 1 THEN
objekt(TALAS1).pwide = 1
ELSEIF (Obj_wide_a + dif_W) + objekt(TALAS1).owide > info_W THEN
objekt(TALAS1).pwide = info_W - objekt(TALAS1).owide
ELSE
objekt(TALAS1).pwide = Obj_wide_a + dif_W
END IF
IF Obj_high_a + dif_H < 1 THEN
objekt(TALAS1).phigh = 1
ELSEIF (Obj_high_a + dif_H) + objekt(TALAS1).ohigh > info_H THEN
objekt(TALAS1).phigh = info_H - objekt(TALAS1).ohigh
ELSE
objekt(TALAS1).phigh = Obj_high_a + dif_H
END IF
IF TALAS1 < UBound(objekt) THEN
FOR i_objekt = (TALAS1 + 1) TO UBound(objekt)
objekt(i_objekt).pwide = objekt(TALAS1).pwide + ob_koor(objekt(i_objekt).Serie).pw_a
objekt(i_objekt).phigh = objekt(TALAS1).phigh + ob_koor(objekt(i_objekt).Serie).ph_a
NEXT i_objekt
END IF
END IF
END SUB
SUB Kill_Obj(obj_num AS Integer)
IF Obj_num < 1 THEN EXIT SUB
Obj_TO_Move = 0
FOR i_array = 1 TO UBound(objekt)
IF objekt(i_array).Nummer = Obj_num THEN
Obj_TO_Move += 1
objekt(i_array).Nummer = 0
END IF
NEXT i_array
' Lueckenaufschluss
FOR i_objekt = 1 TO Obj_TO_Move
FOR i_counter = 1 TO (UBound(objekt) - 1)
IF objekt(i_counter).Nummer = 0 THEN
objekt(i_counter).Nummer = objekt(i_counter + 1).Nummer
objekt(i_counter + 1).Nummer = 0
objekt(i_counter).pwide = objekt(i_counter + 1).pwide
objekt(i_counter).phigh = objekt(i_counter + 1).phigh
objekt(i_counter).owide = objekt(i_counter + 1).owide
objekt(i_counter).ohigh = objekt(i_counter + 1).ohigh
objekt(i_counter).farbe = objekt(i_counter + 1).farbe
objekt(i_counter).Grafik = objekt(i_counter + 1).Grafik
objekt(i_counter).Text = objekt(i_counter + 1).Text
objekt(i_counter).Textf = objekt(i_counter + 1).TextF
objekt(i_counter).Textart = objekt(i_counter + 1).Textart
objekt(i_counter).Serie = objekt(i_counter + 1).Serie
objekt(i_counter).Move = objekt(i_counter + 1).Move
Objekt(i_counter).visibility = Objekt(i_counter + 1).visibility
END IF
NEXT i_counter
NEXT i_objekt
New_Dim = UBound(objekt) - Obj_TO_Move
Redim Preserve objekt(New_Dim)
i_array = UBound(objekt)
DO
SLEEP 1
IF objekt(i_array).Serie = 1 THEN TALAS1 = i_array: EXIT DO
i_array -= 1
LOOP Until i_array < 1
END SUB
SUB SetPos(Obj_num AS Integer, new_W AS Integer, new_H AS Integer)
DIM AS Integer dif_W, dif_H
ScreenInfo info_W, info_H
FOR i_array = 1 TO UBound(objekt)
IF objekt(i_array).Nummer = obj_num THEN
IF objekt(i_array).Serie = 1 THEN
IF new_W < 1 THEN
dif_W = objekt(i_array).pwide - 1
objekt(i_array).pwide = 1
ELSEIF new_W + objekt(i_array).owide > info_W THEN
dif_W = objekt(i_array).pwide - (info_W - objekt(i_array).owide)
objekt(i_array).pwide = info_W - objekt(i_array).owide
ELSE
dif_W = objekt(i_array).pwide - new_W
objekt(i_array).pwide = new_W
END IF
IF new_H < 1 THEN
dif_H = objekt(i_array).phigh - 1
objekt(i_array).phigh = 1
ELSEIF new_H + objekt(i_array).ohigh > info_H THEN
dif_H = objekt(i_array).phigh - (info_H - objekt(i_array).ohigh)
objekt(i_array).phigh = info_H - objekt(i_array).ohigh
ELSE
dif_H = objekt(i_array).phigh - new_H
objekt(i_array).phigh = new_H
END IF
ELSE
objekt(i_array).pwide -= dif_W
objekt(i_array).phigh -= dif_H
END IF
END IF
NEXT i_array
END SUB
SUB SetText(Obj_num AS Integer, Obj_Serie AS Integer, new_T AS String)
FOR i_array = 1 TO UBound(objekt)
IF objekt(i_array).Nummer = Obj_num AND objekt(i_array).Serie = Obj_Serie THEN
objekt(i_array).Text = new_T
EXIT FOR
END IF
NEXT i_array
END SUB
SUB SetMouseFrame(Obj_S AS Integer, framecolor AS Double)
FOR i_array = 1 TO UBound(objekt)
IF (objekt(i_array).Serie = Obj_S) AND (Objekt(i_array).visibility = "unhide") AND _
(Obj_maus_W >= objekt(i_array).pwide) AND _
(Obj_maus_W <= (Objekt(i_array).pwide + objekt(i_array).owide)) AND _
(Obj_maus_H >= objekt(i_array).phigh) AND _
(Obj_maus_H <= (objekt(i_array).phigh + objekt(i_array).ohigh)) THEN
Line (Objekt(i_array).pwide, objekt(i_array).phigh) - STEP(objekt(i_array).owide, objekt(i_array).ohigh), framecolor, B
EXIT FOR
END IF
NEXT i_array
END SUB
SUB Hide_Obj(Obj_num AS Integer)
FOR i_array = 1 TO UBound(objekt)
IF Objekt(i_array).Nummer = Obj_Num THEN
Objekt(i_array).visibility = "hide"
END IF
NEXT i_array
END SUB
SUB Unhide_Obj(Obj_num AS Integer)
FOR i_array = 1 TO UBound(objekt)
IF Objekt(i_array).Nummer = Obj_Num THEN
Objekt(i_array).visibility = "unhide"
END IF
NEXT i_array
END SUB
SUB testi
Color &h00aa00
locate 1
FOR i_test = 1 TO UBound(objekt)
ScreenLock
? "N " & objekt(i_test).Nummer & " S " & objekt(i_test).Serie
ScreenUnLock
NEXT i_test
Locate 1
FOR i_test = 1 TO 10
ScreenLock
Locate , 15: ? "N " & ob_tmp(i_test).Nummer & " S " & ob_tmp(i_test).Serie
ScreenUnLock
NEXT i_test
? "TALAS1 " & TALAS1
END SUB
' ################################## FUNCTIONs #################################
Function in_Focus AS Integer
GetMouse (Obj_maus_W, Obj_maus_H, , Obj_maus_B)
IF (Objekt(TALAS1).visibility = "unhide") AND (Obj_maus_W >= objekt(TALAS1).pwide) AND _
(Obj_maus_W <= (Objekt(TALAS1).pwide + objekt(TALAS1).owide)) AND _
(Obj_maus_H >= objekt(TALAS1).phigh) AND _
(Obj_maus_H <= (objekt(TALAS1).phigh + objekt(TALAS1).ohigh)) THEN
focus_number = objekt(TALAS1).Nummer
in_Focus = 1
ELSE
in_Focus = 0
END IF
END Function
Function click_on_series(obj_num AS Integer, Obj_S AS Integer) AS Integer
FOR i_array = 1 TO UBound(objekt)
IF objekt(i_array).Nummer = obj_num AND objekt(i_array).Serie = obj_S THEN
IF (Obj_maus_W >= objekt(i_array).pwide) AND _
(Obj_maus_W <= (Objekt(i_array).pwide + objekt(i_array).owide)) AND _
(Obj_maus_H >= objekt(i_array).phigh) AND _
(Obj_maus_H <= (objekt(i_array).phigh + objekt(i_array).ohigh)) THEN
click_on_series = 1: EXIT Function
ELSE
click_on_series = 0: EXIT Function
END IF
END IF
NEXT i_array
END Function
Function Objekt_APP AS Integer
' Maus bewegt ein Objekt dann kein Klick
IF Obj_in_Move THEN ObjMove: EXIT Function
GetMouse (Obj_maus_W, Obj_maus_H, , Obj_maus_B)
' uebernehme mauskoor. fuer bewegung
Obj_maus_Wext = Obj_maus_W: Obj_maus_Hext = Obj_maus_H
' Pruefe ob Obj. unter Mausz. das oberste Obj.
' und ob die LINKE Maustaste gedrückt wurde
IF (in_Focus) AND (Obj_maus_B = 1) THEN
SLeep 150
GetMouse (Obj_maus_W, Obj_maus_H, , Obj_maus_B)
IF Obj_maus_B = 0 THEN
Objekt_APP = objekt(TALAS1).Nummer: EXIT Function
ELSE
ObjMove: EXIT Function
END IF
ELSEIF (Obj_maus_B = 1) AND (in_Focus = 0) THEN
i_array = (TALAS1 - 1)
DO
Sleep 1
' geklicktes Objekt in tmp-array verschieben
IF (Obj_maus_W >= objekt(i_array).pwide) AND _
(Obj_maus_W <= (Objekt(i_array).pwide + objekt(i_array).owide)) AND _
(Obj_maus_H >= objekt(i_array).phigh) AND _
(Obj_maus_H <= (objekt(i_array).phigh + objekt(i_array).ohigh)) AND _
objekt(i_array).Serie = 1 THEN
markiert = objekt(i_array).Nummer
Obj_TO_Move = 0
FOR i_counter = 1 TO UBound(objekt)
IF objekt(i_counter).Nummer = markiert THEN
Obj_TO_Move += 1
Ob_tmp(objekt(i_counter).Serie).Nummer = objekt(i_counter).Nummer
objekt(i_counter).Nummer = 0
Ob_tmp(objekt(i_counter).Serie).pwide = objekt(i_counter).pwide
Ob_tmp(objekt(i_counter).Serie).phigh = objekt(i_counter).phigh
Ob_tmp(objekt(i_counter).Serie).owide = objekt(i_counter).owide
Ob_tmp(objekt(i_counter).Serie).ohigh = objekt(i_counter).ohigh
Ob_tmp(objekt(i_counter).Serie).farbe = objekt(i_counter).farbe
Ob_tmp(objekt(i_counter).Serie).Grafik = objekt(i_counter).Grafik
Ob_tmp(objekt(i_counter).Serie).Text = objekt(i_counter).Text
Ob_tmp(objekt(i_counter).Serie).Textf = objekt(i_counter).TextF
Ob_tmp(objekt(i_counter).Serie).Textart = objekt(i_counter).Textart
Ob_tmp(objekt(i_counter).Serie).Serie = objekt(i_counter).Serie
Ob_tmp(objekt(i_counter).Serie).Move = objekt(i_counter).Move
Ob_tmp(objekt(i_counter).Serie).visibility = Objekt(i_counter).visibility
END IF
NEXT i_counter
' Lueckenaufschluss
FOR i_objekt = 1 TO Obj_TO_Move
FOR i_counter = 1 TO (UBound(objekt) - 1)
IF objekt(i_counter).Nummer = 0 THEN
objekt(i_counter).Nummer = objekt(i_counter + 1).Nummer
objekt(i_counter + 1).Nummer = 0
objekt(i_counter).pwide = objekt(i_counter + 1).pwide
objekt(i_counter).phigh = objekt(i_counter + 1).phigh
objekt(i_counter).owide = objekt(i_counter + 1).owide
objekt(i_counter).ohigh = objekt(i_counter + 1).ohigh
objekt(i_counter).farbe = objekt(i_counter + 1).farbe
objekt(i_counter).Grafik = objekt(i_counter + 1).Grafik
objekt(i_counter).Text = objekt(i_counter + 1).Text
objekt(i_counter).Textf = objekt(i_counter + 1).TextF
objekt(i_counter).Textart = objekt(i_counter + 1).Textart
objekt(i_counter).Serie = objekt(i_counter + 1).Serie
objekt(i_counter).Move = objekt(i_counter + 1).Move
Objekt(i_counter).visibility = Objekt(i_counter + 1).visibility
END IF
NEXT i_counter
NEXT i_objekt
' tmp wieder zurueck (ans Ende) 8 + 3 = 11 - 10 = 1
FOR i_objekt = (UBound(objekt) - Obj_TO_Move) + 1 TO UBound(objekt)
objekt(i_objekt).Nummer = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).Nummer
objekt(i_objekt).pwide = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).pwide
objekt(i_objekt).phigh = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).phigh
objekt(i_objekt).owide = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).owide
objekt(i_objekt).ohigh = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).ohigh
objekt(i_objekt).farbe = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).farbe
objekt(i_objekt).Grafik = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).Grafik
objekt(i_objekt).Text = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).Text
objekt(i_objekt).Textf = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).TextF
objekt(i_objekt).Textart = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).Textart
objekt(i_objekt).Serie = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).Serie
objekt(i_objekt).Move = ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).Move
Objekt(i_objekt).visibility = Ob_tmp((i_objekt + Obj_TO_Move) - UBound(objekt)).visibility
IF (i_objekt + Obj_TO_Move) - UBound(objekt) = 1 THEN TALAS1 = i_objekt
NEXT i_objekt
IF objekt(UBound(objekt)).Nummer < 100 THEN
Objekt_APP = 0: EXIT Function
ELSE
Objekt_APP = objekt(TALAS1).Nummer: EXIT Function
END IF
END IF
i_array -= 1
LOOP Until i_array < 1
END IF
END Function
Function GetText(obj_num AS Integer, obj_Serie AS Integer) AS String
FOR i_array = 1 TO UBound(objekt)
IF objekt(i_array).Serie = obj_serie AND objekt(i_array).Nummer = obj_num THEN
GetText = objekt(i_array).Text
EXIT Function
END IF
NEXT i_array
GetText = ""
END Function
|
| Code: | 'DIMs für TSNE
DIM SHARED AS STRING ServerAdresse
DIM SHARED AS INTEGER iVerbindung
'Function
DIM SHARED AS STRING TxtArray (11)
DIM SHARED AS INTEGER MaxTxtLen
'Optionen
DIM SHARED AS STRING FarbRam
TYPE Farbenblock
BG1 AS DOUBLE
BG2 AS DOUBLE
G1 AS DOUBLE
G2 AS DOUBLE
END TYPE
DIM SHARED Farben AS Farbenblock
'Programm
DIM SHARED MX_incomming AS ANY Ptr
DIM SHARED MX_ID AS ANY Ptr
DIM SHARED MX_LostID AS ANY Ptr
DIM SHARED AS INTEGER i, ze, Auswahl, HauptMenu, hoechsteID, newID, newmailVon
DIM SHARED AS INTEGER i2, i3, ueberschneidung, wideEnd, highEnd, LostID
DIM SHARED AS STRING Eingabe, Txt, Txt2, newmail, openpmmwindow
DIM SHARED AS STRING *15 PMPartner
newmail = "": Txt = ""
TYPE Partner
Titel AS STRING * 15
ID AS integer
Status AS integer
END TYPE
DIM SHARED PcOnline() AS Partner
TYPE newmailblock
Leecher AS STRING * 15
Datum AS STRING * 10
Zeit AS STRING * 5
Mail AS STRING * 192
END TYPE
DIM SHARED PMM AS newmailblock
TYPE newmailin
Seeder AS STRING * 15
Datum AS STRING * 10
Zeit AS STRING * 5
Mail AS STRING * 192
IST AS STRING * 1
END TYPE
DIM SHARED PMMin AS newmailin
TYPE newmailoeffnen
Seeder AS STRING * 15
Datum AS STRING * 10
Zeit AS STRING * 5
Mail AS STRING * 192
IST AS STRING * 1
wide AS INTEGER
high AS INTEGER
END TYPE
DIM SHARED PMMshow(10) AS newmailoeffnen
'Desktop/Bildschirm
DIM SHARED AS INTEGER w, h, depth, wh, Oapp, PMMzaehler
'Maus
DIM SHARED AS INTEGER wmaus,hmaus,mrad,mbuttons,mclib,mrad2,mradoffset
DECLARE SUB NewmailSub
DECLARE SUB PcListeSub
DECLARE SUB clearscr()
DECLARE SUB ENDE
DECLARE FUNCTION TxtF (Txt AS STRING, MaxTxtLen as Integer, Txt2 AS STRING) AS STRING
'[Txt = Rückgabe][MaxTxtLen = Länge der Eingabe][Txt2 = Text an den angeschlossen wird]
#include ONCE "vbcompat.bi"
#include ONCE "autowrite.bi"
#INCLUDE ONCE "fbgfx.bi"
#Include Once "windows.bi"
#include once "objekte.bi"
#INCLUDE ONCE "openbildPSET.bi"
#include once "tsneplay_v3.bi"
ScreenControl FB.GET_DESKTOP_SIZE, w, h 'Desktopauflösung auslesen
SCREENRES w -1 , h - 1, 32,, FB.GFX_SHAPED_WINDOW or FB.GFX_ALWAYS_ON_TOP
Color ,&hFF00FF: CLS
Dim As HWND hWnd
ScreenControl FB.GET_WINDOW_HANDLE, Cast(Integer, hWnd)
ShowWindow(hWnd, SW_HIDE)
SetWindowLong (hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW)
ShowWindow(hWnd, SW_SHOW)
RANDOMIZE TIMER
'###################### anlegen einer PC Liste #################################
Close
IF NOT FileExists ("PcListe.dat") THEN
PcListeSub
END IF 'NOT FileExists ("PcListe.dat")
'######################### Optionen u. Verbindungen laden ######################
OPEN EXEPATH + "\PcListe.dat" FOR RANDOM AS #1 LEN=LEN(PMPartner)
For i = 1 TO 10
GET #1, i, PMPartner
TxtArray(i) = PMPartner
Next i
CLOSE
TxtArray(0) = "an alle"
IF FileExists("Option.Txt") AND FileExists("FarbSet.Dat") THEN
OPEN EXEPATH + "\Option.Txt" FOR Input AS #1
LINE INPUT #1, FarbRam
CLOSE
OPEN EXEPATH + "\FarbSet.dat" FOR RANDOM AS #1 LEN=LEN(Farben)
GET #1, VAL(FarbRam), Farben
CLOSE
ELSE
Farben.BG1 = &h00beff
Farben.BG2 = &hffff55
Farben.G1 = &hffffff
Farben.G2 = &hff7d00
END IF
MX_incomming = MutexCreate()
MX_ID = MutexCreate()
MX_LostID = MutexCreate()
' ***** Netzwerkverbindung *****
CLS
dim shared RV as TSNEPlay_GURUCode
sub TSNEPlay_ConnectionState(byval von as uinteger, byval state as TSNEPlay_State_Enum)
' Rückmeldung für einen Spieler über seinen Status
end sub
sub TSNEPlay_Player_Connected(byval id as uinteger, IPA as string, nick as string)
' Spieler wurde verbunden
'print nick & id & " hat die Verbindung hergestellt"
MutexLock(MX_ID)
newID = id
MutexUnLock(MX_ID)
end sub
sub TSNEPlay_Player_Disconnected(byval id as uinteger)
' Spieler wurde getrennt
'print id & " hat die Verbindung abgebrochen"
MutexLock(MX_LostID)
LostID = id
MutexUnLock(MX_LostID)
end sub
sub TSNEPlay_Message(byval von as uinteger, byval zu as uinteger, byval nachricht as string, _
byval typ as TSNEPlay_MessageType_Enum)
'Ein Spieler hat uns / allen eine Nachricht geschickt
MutexLock(MX_incomming)
newmail = nachricht
newmailVon = von
MutexUnLock(MX_incomming)
end sub
sub TSNEPlay_Move(byval von as uinteger, byval zu as uinteger, byval typ as double, _
byval x as double, byval y as double, byval r as uinteger)
' Spielzug
end sub
sub TSNEPlay_Data(von as uinteger, zu as uinteger, daten as string)
' Meldung vom Programmierer
end sub
' Aufbau der Verbindung
Dim TConnected as Integer = 0
'verbindung herstellen
FOR iVerbindung = 1 TO 10
IF LEN(TxtArray(iVerbindung)) > 0 THEN
ServerAdresse = TxtArray(iVerbindung)
? "Verbinde mit " & ServerAdresse
RV = TSNEPlay_ConnectToServer(ServerAdresse, 1234, "Client", "geheimesPasswort", _
@TSNEPlay_ConnectionState, @TSNEPlay_Player_Connected, @TSNEPlay_Player_Disconnected, _
@TSNEPlay_Message, @TSNEPlay_Move, @TSNEPlay_Data) ' Port ist UShort
If RV = TSNEPlay_NoError Then
Dim XTot as Double = Timer() + 6
Do Until InKey() = Chr(27)
Locate 1, 40: ? "Bereit in " & XTot - TIMER()
Select Case TSNEPlay_Connection_GetState()
Case TSNEPlay_State_Disconnected: Exit Do
Case TSNEPlay_State_Ready: TConnected = 1
End Select
Sleep 1, 1
If XTot < Timer() Then Exit Do
Loop
If TSNEPlay_Connection_GetState() = TSNEPlay_State_Ready Then TConnected = 1:EXIT FOR
End If
END IF 'LEN(TxtArray(iVerbindung) > 0
NEXT iVerbindung
If TConnected = 0 Then
Print "Konnte verbindung nicht herstellen! Etabliere Server!"
RV = TSNEPlay_CreateServer(10, 1234, "Server", "geheimesPasswort", @TSNEPlay_ConnectionState, _
@TSNEPlay_Player_Connected, @TSNEPlay_Player_Disconnected, @TSNEPlay_Message, @TSNEPlay_Move, _
@TSNEPlay_Data, 0) ',0 weist der funktion zu, das "nicht hinzufügen eines lokalen clienten" zu ignorieren
If RV <> TSNEPlay_NoError Then Print "[ERROR] "; TSNEPlay_Desc_GetGuruCode(RV): sleep:End -1
End If
' Daten an den Server schicken
' z.B. TSNEPlay_SendMSG(0, "" & eingabe)
' ############################# Programm Start #################################
cls
CONST pmbutton = 100, mail = 101, games = 102, pc = 103, config = 104, logout = 105, _
SendeMail = 106
CreOb(pmbutton, w / 2 - 30, 1, 60, 9, Farben.BG1, "", "postmail", Farben.G2, 1, 1, 0)
CreOb(mail, (w/2)-64+8, (h/2)-16+8, 16, 16, 0, "mail", "", 0, 0, 1, 0)
CreOb(games, (w/2)-64+32, (h/2)-16+8, 16, 16, 0, "games", "", 0, 0, 1, 0)
CreOb(pc, (w/2)-64+56, (h/2)-16+8, 16, 16, 0, "pc", "", 0, 0, 1, 0)
CreOb(config, (w/2)-64+80, (h/2)-16+8, 16, 16, 0, "config", "", 0, 0, 1, 0)
CreOb(logout, (w/2)-64+104, (h/2)-16+8, 16, 16, 0, "logout", "", 0, 0, 1, 0)
Hide_Obj(mail): Hide_Obj(games): Hide_Obj(pc): Hide_Obj(config): Hide_Obj(logout)
CreOb(SendeMail, w/ 2- (164/ 2), h/ 2- (134/ 2), 163, 133, 0, "PM1", "", 0, 0, 1, 0)
CreOb(SendeMail, 10, 3, 150, 9, 0, "", "Zeit + Datum", Farben.G2, 1, 2, 0)
CreOb(SendeMail, 10, 23, 143, 87, 0, "", "", Farben.G2, 1, 3, 0)
CreOb(SendeMail, 10, 113, 48, 9, 0, "", "pmm an ", Farben.G2, 1, 4, 0)
CreOb(SendeMail, 58, 113, 100, 9, 0, "", "Absender", Farben.G2, 1, 5, 0)
Hide_Obj(SendeMail)
DO
sleep 5
ClearScr
ShowOb(1, 99)
ShowOb(100, 0)
IF HauptMenu = 1 THEN
ScreenLock
Line ((w/2)-64, (h/2)-16) - STEP(128, 32),&hAAAAAA ,BF
ScreenUnLock
END IF
ShowOb(101, 106)
SetMouseFrame(5, &h000000)
Oapp = Objekt_APP
Select Case Oapp
Case 1 TO 99
' ********** Nachrichten **********
IF click_on_series(Oapp, 5) THEN
SetText(SendeMail, 2, format (now,"hh:mm") & " " & format (now,"dd-mm-yyyy"))
SetText(SendeMail, 3, "")
SetText(SendeMail, 5, GetText(Oapp, 5))
Unhide_Obj(SendeMail)
newmailSub
Kill_Obj(Oapp)
ELSE
Kill_Obj(Oapp)
ClearScr
END IF
Case pmbutton
' ********** Hauptbutton **********
IF openpmmwindow = "" AND HauptMenu = 0 THEN
HauptMenu = 1
Unhide_Obj(mail): Unhide_Obj(games): Unhide_Obj(pc):Unhide_Obj(config): Unhide_Obj(logout)
ELSEIF openpmmwindow = "" AND HauptMenu = 1 THEN
clearscr
HauptMenu = 0
Hide_Obj(mail): Hide_Obj(games): Hide_Obj(pc): Hide_Obj(config): Hide_Obj(logout)
END IF
Case pc
' ********** PC button **********
Hide_Obj(mail): Hide_Obj(games): Hide_Obj(pc): Hide_Obj(config): Hide_Obj(logout)
PcListeSub
Case logout
' ********** Ende button **********
ENDE
Case mail
' ********** Mail button **********
Sleep 200
HauptMenu = 0
Hide_Obj(mail): Hide_Obj(games): Hide_Obj(pc): Hide_Obj(config): Hide_Obj(logout)
clearscr
ScreenLock
Line ((w/2)-100, (h/2)-125) - STEP(200, 265),Farben.BG1 ,BF
autowrite (Farben.G2, (w/2)-100+10, (h/2)-125+5, "online liste", 1)
autowrite (Farben.G2, (w/2)-100+10, (h/2)-125+25, "empfänger wählen", 0)
ze = (h/2)-125+45
FOR i = 0 TO 10
Line ((w/2)-60, ze - 2) - STEP(120, 10),&hFFFFFF ,BF: autowrite (&h000000, (w/2)-60+2, ze, STR(i) & ". " + TxtArray(i), 0)
ze += 20
NEXT i
ScreenUnLock
DO
SLEEP 1
GETMOUSE (wmaus,hmaus,mrad,mbuttons,mclib)
ze = (h/2)-125+45 'erste Position der Textfelder
FOR i = 0 TO 10
IF mbuttons = 2 THEN EXIT DO
'+++ klick auf 1 von 10 verbindungen +++
IF mbuttons = 1 AND wmaus > (w/2)-60 AND wmaus < (w/2)-60+120 AND _
hmaus > ze - 2 AND hmaus < ze - 2 + 10 AND openpmmwindow = "" THEN
SetText(SendeMail, 2, format (now,"hh:mm") & " " & format (now,"dd-mm-yyyy"))
SetText(SendeMail, 5, TxtArray(i))
Unhide_Obj(SendeMail)
NewmailSub
EXIT DO
END IF ''+++ klick auf 1 von 10 verbindungen +++
ze += 20
NEXT i
LOOP Until InKey = CHR(27)
ClearScr
End Select
' ********** Nachrichten verwalten **********
' *** einkommende Namensanfrage (PC Name) ***
MutexLock(MX_incomming)
IF newmail = "#name" THEN
TSNEPlay_SendMSG(newmailVon, "##" + ENVIRON("computername"))
newmail = "": newmailVon = 0
END IF
' *** einkommender Name (PC Name) ***
IF MID(newmail,1 ,2) = "##" THEN
PcOnline(newmailVon).Titel = MID(newmail, 3, LEN(newmail) - 2)
PcOnline(newmailVon).ID = newmailVon
PcOnline(newmailVon).Status = 1
newmail = "": newmailVon = 0
END IF
' *** Sonstige Nachrichten ***
IF newmail <> "" THEN
FOR i = 1 TO Ubound(PcOnline)
IF PcOnline(i).ID = newmailVon THEN
OPEN ExePath & "\Empfang.dat" FOR RANDOM AS #1 LEN=LEN(PMMin)
FOR i2 = 1 TO 1000
GET #1, i2, PMMin
IF NOT PMMin.Ist = "X" THEN
PMMin.Seeder = PcOnline(i).Titel
PMMin.Datum = MID(newmail, 1, 10)
PMMin.Zeit = MID(newmail, 11, 5)
PMMin.Mail = MID(newmail, 16, LEN(newmail)-15)
PMMin.IST = "X"
PUT #1, i2, PMMin
CLOSE
newmail = "": newmailVon = 0
EXIT FOR ' i2 = 1 TO 1000
END IF 'NOT PMMin.Ist = "X" THEN
NEXT i2
END IF 'PcOnline(i).ID = newmailVon THEN
NEXT i
END IF 'newmail <> ""
MutexUnLock(MX_incomming)
' ********** Nachrichten anzeigen **********
' +++ Nachricht aus Speicher in Anzeige Array +++
OPEN ExePath & "\Empfang.dat" FOR RANDOM AS #1 LEN=LEN(PMMin)
FOR i = 1 TO 1000
GET #1, i, PMMin
IF PMMin.IST = "X" THEN
IF PMMzaehler < 10 THEN
CreOb(1, 0, 0, 163, 133, 0, "PM1", "", 0, 0, 1, 1)
CreOb(0, 10, 3, 150, 9, 0, "", PMMin.Zeit+" "+PMMin.Datum, Farben.G2, 1, 0, 0)
CreOb(0, 10, 23, 143, 87, 0, "", PMMin.Mail, Farben.G2, 1, 0, 0)
CreOb(0, 10, 113, 48, 9, 0, "", "pmm von ", Farben.G2, 1, 0, 0)
CreOb(0, 58, 113, LEN(PMMin.Seeder) * 6, 9, 0, "", PMMin.Seeder, Farben.G2, 1, 0, 0)
PMMin.IST = ""
PMMin.Mail = ""
PUT #1, i, PMMin
PMMzaehler += 1
ELSE
EXIT FOR
END IF 'PMMzaehler < 10
END IF 'PMMin.IST = "X"
NEXT i '= 1 TO 1000
CLOSE
' ********** Frage nach NAME der angemeldeten ID **********
MutexLock(MX_ID)
IF newID > hoechsteID THEN
REDIM PRESERVE PcOnline(newID) AS Partner
hoechsteID = newID
TSNEPlay_SendMSG(newID, "#name")
newID = 0
END IF
IF newID <> 0 THEN
TSNEPlay_SendMSG(newID, "#name")
newID = 0
END IF
MutexUnLock(MX_ID)
' ********** loeschen der abgemeldeten ID **********
MutexLock(MX_LostID)
IF LostID <> 0 THEN
FOR i = 1 TO Ubound(PcOnline)
IF LostID = PcOnline(i).ID THEN
PcOnline(i).Titel = ""
PcOnline(i).ID = 0
PcOnline(i).Status = 0
LostID = 0
END IF
NEXT i
END IF
MutexUnLock(MX_LostID)
loop
ENDE
'################################ SUBs #########################################
SUB clearscr()
ScreenLock
CLS
ScreenUnLock
ShowOb(100, 0)
END SUB
SUB PcListeSub
SLEEP 250
HauptMenu = 0
Auswahl = 1
Do
Sleep 1
GETMOUSE (wmaus,hmaus,mrad,mbuttons,mclib)
ScreenLock
Line ((w/2)-100, (h/2)-125) - STEP(200, 250),&hAAAAAA ,BF
autowrite (&hAAA000, (w/2)-100+10, (h/2)-125+25, "Verbindung eintragen (Pc Name)", 0)
ze = (h/2)-125+45
FOR i = 1 TO 10
Line ((w/2)-60, ze - 2) - STEP(120, 10),&hFFFFFF ,BF
autowrite (&h000000, (w/2)-60+2, ze, STR(i) & ". " + TxtArray(i), 0)
IF Auswahl = i THEN Line ((w/2)-60, ze - 2) - STEP(120, 10),&hAA0000 ,b
ze += 20
NEXT i
ScreenUnLock
IF mbuttons = 2 THEN EXIT DO
'+++ klick auf 1 von 10 verbindungen +++
IF mbuttons = 1 THEN
ze = (h/2)-125+45
FOR i = 1 TO 10
IF wmaus > (w/2)-60 AND wmaus < (w/2)-60+120 AND _
hmaus > ze - 2 AND hmaus < ze - 2 + 10 THEN
Auswahl = i
SLEEP 250
END IF ''+++ klick auf 1 von 10 verbindungen +++
ze += 20
NEXT i
END IF
Eingabe = InKey
SELECT CASE RIGHT(Eingabe, 1)
CASE CHR(80) 'runter
Auswahl += 1
IF Auswahl > 10 THEN Auswahl = 1
Eingabe = ""
CASE CHR(72) 'rauf
Auswahl -= 1
IF Auswahl < 1 THEN Auswahl = 10
Eingabe = ""
CASE CHR(71), CHR(73) 'Pos1/Bild rauf
Auswahl = 1
Eingabe = ""
CASE CHR(79), CHR(81) 'Ende/Bild runter
Auswahl = 10
Eingabe = ""
CASE CHR(75), CHR(77), CHR(82), CHR(83) 'li./re./einf./entf.
Eingabe = ""
END SELECT
IF Eingabe = CHR(27) THEN ClearScr: EXIT SUB
IF Eingabe <> "" THEN TxtArray(Auswahl) = TxtF(Txt, 15, TxtArray(Auswahl)) 'Function Txt += Eingabe
Loop until Eingabe = chr(13)
clearscr
IF Txt <> "" THEN
OPEN EXEPATH + "\PcListe.dat" FOR RANDOM AS #1 LEN=LEN(PMPartner)
For i = 1 TO 10
PMPartner = TxtArray(i): PUT #1, i, PMPartner
Next i
Close
END IF 'Txt <> ""
END SUB
SUB NewmailSub
ClearScr
DO
Sleep 10
ShowOb(SendeMail, 0)
Eingabe = InKey
IF Eingabe <> "" THEN SetText(SendeMail, 3, TxtF(Txt, 192, GetText(SendeMail, 3))) 'Function Txt += Eingabe
IF Eingabe = CHR(27) THEN Hide_Obj(SendeMail): EXIT DO
IF Eingabe = CHR(13) AND GetText(SendeMail, 3) <> "" THEN
FOR i2 = 1 TO UBound(PcOnline)
IF LCase(GetText(SendeMail, 5)) = LCase(RTRIM(PcOnline(i2).Titel)) OR _
LCase(GetText(SendeMail, 5)) = "an alle" THEN
TSNEPlay_SendMSG(PcOnline(i2).ID, MID(GetText(SendeMail, 2), 7, 10) + _
MID(GetText(SendeMail, 2), 1, 5) + GetText(SendeMail, 3))
EXIT DO
END IF 'LCase(PMM.Leecher) =
NEXT i2
END IF 'Eingabe = CHR(13) AND PMM.Mail <> ""
LOOP
Hide_Obj(SendeMail)
ClearScr
END SUB
SUB ENDE
CLOSE
MutexDestroy(MX_incomming)
MutexDestroy(MX_ID)
MutexDestroy(MX_LostID)
End 0
END SUB
'############################ Funktionen #######################################
FUNCTION TxtF (Txt AS STRING, MaxTxtLen AS Integer, Txt2 AS STRING) AS STRING
IF LEN(Eingabe) = 1 THEN
SELECT CASE ASC(Eingabe)
CASE IS = 8 'backspace
IF LEN(Txt2) = 0 THEN EXIT SELECT
Txt = MID(Txt2, 1, LEN(Txt2) - 1)
CASE IS = 13 'enter
CASE IS = 27 'ESC
CASE 48 TO 57 'zahlen 0-9
IF LEN(Txt2) = MaxTxtLen THEN EXIT SELECT
Txt = Txt2 + Eingabe
CASE 65 TO 90 'A-Z
IF LEN(Txt2) = MaxTxtLen THEN EXIT SELECT
Txt = Txt2 + Eingabe
CASE 97 TO 122 'a-z
IF LEN(Txt2) = MaxTxtLen THEN EXIT SELECT
Txt = Txt2 + Eingabe
CASE ELSE 'sonderzeichen (.,-/....)
IF LEN(Txt2) = MaxTxtLen THEN EXIT SELECT
IF ASC(Eingabe) = 129 THEN Eingabe = "ü"
IF ASC(Eingabe) = 154 THEN Eingabe = "Ü"
IF ASC(Eingabe) = 132 THEN Eingabe = "ä"
IF ASC(Eingabe) = 142 THEN Eingabe = "Ä"
IF ASC(Eingabe) = 148 THEN Eingabe = "ö"
IF ASC(Eingabe) = 153 THEN Eingabe = "Ö"
IF ASC(Eingabe) = 225 THEN Eingabe = "ß"
IF Eingabe = "," THEN Eingabe = "."
Txt = Txt2 + Eingabe
END SELECT
END IF 'LEN(keytxt)
Return Txt
END Function
|
|
|
| Nach oben |
|
 |
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4704
Wohnort: ~/
|
| Verfasst am: 18.02.2013, 00:51 Titel: |
|
|
Bei so langen Quelltexten wäre es sinnvoller, NoPaste zu verwenden.
Flackern kommt für gewöhnlich daher, dass zwischen dem Löschen und dem Neuzeichnen der Objekte kein Screenlock durchgeführt wird. Während eines einzelnen Grafikbefehls den Screen zu sperren, macht nicht viel Sinn. SCREENLOCK/SCREENUNOCK dient viel mehr dazu, das zwischen mehreren Grafikanweisungen keine Bildschirmaktualisierung stattfindet, sondern erst am Ende dieser Anweisungen.
Was du machst ist in etwa folgendes:
| Code: |
' Hier besteht schon ein komplettes Bild auf dem Bildschirm
SCREENLOCK
CLS
SCREENUNLOCK ' jetzt sieht man kurz den leeren Screen -> Flimmern!
Zeichenbefehle_fuer_neues_Bild |
Was du machen solltest ist folgendes:
| Code: | ' Hier besteht schon ein komplettes Bild auf dem Bildschirm
SCREENLOCK
CLS
Zeichenbefehle_fuer_neues_Bild
SCREENUNLOOK |
So wird zwischen Bild1 und Bild2 das Löschen des Bildschirms nicht sichtbar.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 18.02.2013, 01:00 Titel: |
|
|
ok vielen dank für die schnelle hilfe. werd es mir gleich morgen anschauen muss jetzt leider zur arbeit.
EDIT/ Jetzt ist es viel viel besser, Danke |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
