BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]
Const Ordner_Konnte_Nicht_auslesen_Werden=2 Const COrdner=2 Const CDatei=1
Type DateiListeTyp Field Ordner$ Field Dateiname$ Field Erweiterung$ End Type
Type TSchalter Field Bezeichnung$ Field AlternativeBezeichnung$ Field BezeichnungFarbe
Field transparent
Field X,Y Field XZ,YZ Field X2,Y2
Field Image Field Sound
Field Status Field Name$ Field Wert End Type
Type TButton Field Name$ Field Image Field transparent Field ImageMaske Field LadenAbBild
Field Breit,Hoch
Field DateiName$
End Type
Global Schalter.TSchalter Global Button.TButton Global DateiListe.DateiListeTyp
Global SchalterSchrift Global SchalterSchriftName$
Global MausImage Global MausImageNr Global MausDatei$ Global MausBreit Global MausHoch
Global ChannelID_Schalter
Global AktionSchalterWert Global AktionSchalterName$
Global MausUeberSchalterWert Global MausUeberSchalterName$
Inst_Schalter \"Arial\",28,\"pointer.bmp\",11,19
CreateButton \"Abbrechen.bmp\",\"Abbrechen\",160,39
CreateButton \"Loeschen.bmp\",\"Löschen\",160,39
LoadButton \"OK.Button\"
CreateSchalter 100,100,\"Abbrechen\",\"\",\"Abbruch.wav\",\"Abbrechen\",1 CreateSchalter 100,150,\"OK\",\"\",\"OK.wav\",\"OK\",2 CreateSchalter 100,200,\"Löschen\",\"\",\"loeschen.wav\",\"Löschen\",3
CreateSchalter 0,200,\"\",\"Start\",\"OK.wav\",\"Start\",4,farbe(255,255,0)
savebutton \"Abbrechen\" savebutton \"Löschen\"
Timer=CreateTimer(30) ClsColor 0,0,255 HidePointer Repeat Cls UpdateSchalter Select AktionSchalterName$ End Select Reset_Schalter WaitTimer Timer Forever
Function CreateSchalter(X,Y,ButtonName$,Bezeichnung$,SoundDatei$,Namne$,Wert,BezeichnungFarbe=255*255*255,AlternativeBezeichnung$=\"\") If Len(AlternativeBezeichnung$)>0 Then If Len(Bezeichnung$)>0 Then AlternativeBezeichnung$=Bezeichnung$ Else If Len(ButtonName$)>0 Then AlternativeBezeichnung$=ButtonName$ Else Return False End If End If End If
ButtonName$=Upper$(ButtonName$) For Button=Each TButton If ButtonName$=Upper$(Button\Name$) Then NewSchalter X,Y,Button\Image,Bezeichnung$,Button\transparent,LoadSound(SoundDatei$),Namne$,Wert,BezeichnungFarbe,AlternativeBezeichnung$
Return True End If Next SucheDateien SystemProperty$(\"APPDIR\"),\"Button|\" For DateiListe=Each DateiListeTyp InputDatei=ReadFile(DateiListe\Ordner$+DateiListe\Dateiname$+\".\"+DateiListe\Erweiterung$) If InputDatei<>0 Then
ButtonVergleichName$=ReadString(InputDatei) If Upper$(ButtonVergleichName$)=Upper$(ButtonName$) Then CloseFile InputDatei LoadButton DateiListe\Ordner$+DateiListe\Dateiname$+\".\"+DateiListe\Erweiterung$ NewSchalter X,Y,Button\Image,Bezeichnung$,Button\transparent,LoadSound(SoundDatei$),Namne$,Wert,BezeichnungFarbe,AlternativeBezeichnung$ Return True Else CloseFile InputDatei End If End If Next
NewSchalter X,Y,0,Bezeichnung$,False,LoadSound(SoundDatei$),Namne$,Wert,BezeichnungFarbe,AlternativeBezeichnung$ End Function Function NewSchalter(X,Y,Image,Bezeichnung$,transparent,Sound,Namne$,Wert,BezeichnungFarbe=255*255*255,AlternativeBezeichnung$=\"\") If Image=0 And Len(Bezeichnung$)=0 And Len(AlternativeBezeichnung$)=0 Then Return False End If
Schalter=New TSchalter
Schalter\Image=Image Schalter\Sound=Sound
Schalter\Name$=Name$ Schalter\Wert=Wert
Schalter\X=X Schalter\Y=Y
Schalter\Bezeichnung$=Bezeichnung$ Schalter\BezeichnungFarbe=BezeichnungFarbe
If Len(AlternativeBezeichnung$)=0 Then Schalter\AlternativeBezeichnung$=Schalter\Bezeichnung$ Else Schalter\AlternativeBezeichnung$=AlternativeBezeichnung$ End If If Image=0 Then Schalter\X2=StringWidth(Schalter\AlternativeBezeichnung$) Schalter\Y2=StringHeight(Schalter\AlternativeBezeichnung$) Else Schalter\X2=ImageWidth(Image) Schalter\y2=ImageHeight(Image) End If
Schalter\XZ=Schalter\X2-(Schalter\X2/2)+X Schalter\YZ=Schalter\Y2-(Schalter\Y2/2)+Y
Return True End Function
Function Inst_Schalter(Schrift$,SchriftHoch,MausDateiname$,Breit,Hoch) MausImage=LoadAnimImage(MausDateiname$,Breit,Hoch,0,2) If MausImage<>\"\" Then MausDatei$=MausDateiname$ MausBreit =Breit MausHoch =Hoch End If
SchalterSchrift=LoadFont(Schrift$,SchriftHoch) SchalterSchriftName$=Schrift$ SetFont SchalterSchrift End Function
Function SaveButton(Buttonname$,DateiName$=\"\") If Len(DateiName$)=0 Then DateiName$=Buttonname$ End If If Instr(DateiName$,\".\")=0 Then DateiName$=DateiName$+\".Button\" End If
For Button=Each TButton If Upper$(ButtonName$)=Upper$(Button\Name$) Then
OutputDatei=WriteFile(DateiName$) If OutputDatei=0 Then Return False End If
WriteString OutputDatei,Button\Name$ WriteByte OutputDatei,Button\transparent WriteInt OutputDatei,Button\ImageMaske WriteShort OutputDatei,Button\Breit WriteShort OutputDatei,Button\Hoch For BildZahl=0 To 2 Buffer=ImageBuffer(Button\Image,BildZahl) LockBuffer Buffer For X=0 To Button\Breit-1 For Y=0 To Button\Hoch-1 WriteInt OutputDatei,ReadPixelFast(X,Y,Buffer) Next Next UnlockBuffer Buffer Next Return True End If Next Return False End Function
Function LoadButton(DateiName$)
InputDatei=ReadFile(DateiName$)
If InputDatei=0 Then Return False End If
ButtonName$=ReadString(InputDatei) Buttontransparent=ReadByte(InputDatei) ButtonImageMaske=ReadInt(InputDatei) ButtonBreit=ReadShort(InputDatei) ButtonHoch=ReadShort(InputDatei) For Button=Each TButton If Upper$(ButtonName$)=Upper$(Button\Name$) Then Return False End If Next Button=New TButton Button\Name$=ButtonName$ Button\transparent=ButtonImageMaske Button\ImageMaske=ButtonImageMaske Button\Breit=ButtonBreit Button\Hoch=ButtonHoch Button\Dateiname=DateiName$ Button\Image=CreateImage(ButtonBreit,ButtonHoch,3)
For BildZahl=0 To 2 Buffer=ImageBuffer(Button\Image,BildZahl) LockBuffer Buffer For X=0 To Button\Breit-1 For Y=0 To Button\Hoch-1 WritePixelFast X,Y,ReadInt(InputDatei),Buffer Next Next UnlockBuffer Buffer Next MaskImage Button\Image,GetRed(Button\ImageMaske),GetGreen(Button\ImageMaske),GetBlue(Button\ImageMaske) CloseFile InputDatei Return True
End Function
Function CreateButton(DateiName$,Name$,Breit,Hoch,transparent=False,ImageMaske=0,LadenAbBild=0) Image=LoadAnimImage(DateiName$,Breit,Hoch,LadenAbBild,3) If Image=0 Then Return False Button=New TButton Button\Image=Image Button\Name$=Name$ Button\Breit=Breit Button\Hoch=Hoch Button\transparent=transparent Button\LadenAbBild=LadenAbBild Button\DateiName$=DateiName$ Button\ImageMaske=ImageMaske
MaskImage Image,GetRed(ImageMaske),GetGreen(ImageMaske),GetBlue(ImageMaske) Return True End Function
Function DeleteButton(ButtonName$) For Button=Each TButton If Upper$(ButtonName$)=Upper$(Button\Name$) Then For Schalter=Each TSchalter If Button\Image=Schalter\Image Then Delete Button Return True End If Next FreeImage Button\Image Delete Button Return True End If Next Return False End Function
Function UpdateSchalter() MausUeberSchalter DrawSchalter DrawMaus End Function
Function DeleteSchalter2(Name$) For Schalter=Each TSchalter If Upper(Schalter\Name$)=Upper$(Name$) Then
If Schalter\Image<>0 Then FreeImage Schalter\Image If Schalter\Sound<>0 Then FreeImage Schalter\Sound Delete Schalter End If Next End Function
Function DeleteSchalter(Wert) For Schalter=Each TSchalter If Schalter\Wert=Wert Then
If Schalter\Image<>0 Then FreeImage Schalter\Image If Schalter\Sound<>0 Then FreeImage Schalter\Sound Delete Schalter End If Next End Function
Function Reset_Schalter() If ChannelID_Schalter<>0 Then If ChannelPlaying(ChannelID_Schalter)=True Then Return False End If End If
ChannelID_Schalter=0 AktionSchalterWert=0 AktionSchalterName$=\"\" Return True End Function
Function DrawSchalter() For Schalter=Each TSchalter If Schalter\Image<>0 Then If Schalter\transparent=True Then DrawImage Schalter\Image,Schalter\X,Schalter\Y,Schalter\Status Else DrawBlock Schalter\Image,Schalter\X,Schalter\Y,Schalter\Status End If If Len(Schalter\Bezeichnung$)>0 Then ColorI Schalter\BezeichnungFarbe Text Schalter\XZ,Schalter\YZ,Schalter\Bezeichnung$,True,True End If Else ColorI Schalter\BezeichnungFarbe Text Schalter\XZ,Schalter\YZ,Schalter\AlternativeBezeichnung$,True,True End If Next End Function
Function MausUeberSchalter() MausImageNr=0 MausX=MouseX() Mausy=MouseY()
MausUeberSchalterWert=0 MausUeberSchalterName$=\"\"
MausTaste=MouseDown(1)
For Schalter=Each TSchalter If Schalter\Image<>0 Then If Schalter\transparent=True Then If ImagesCollide(MausImage,Mausx,MausY,0,Schalter\Image,Schalter\X,Schalter\Y,0) And AktionSchalterWert=0 Then MausImageNr=1 If MausTaste=True Then Schalter\Status=2 AktionSchalterWert=Schalter\Wert AktionSchalterName$=Schalter\Name$ Else Schalter\Status=1 MausUeberSchalterWert=Schalter\Wert MausUeberSchalterName$=Schalter\Name$ End If Else If AktionSchalterWert<>Schalter\Wert Then Schalter\Status=0 End If End If Else If ImageRectCollide(MausImage,Mausx,MausY,0,Schalter\X,Schalter\Y,Schalter\X2,Schalter\Y2) And AktionSchalterWert=0 Then MausImageNr=1 If MausTaste=True Then Schalter\Status=2
AktionSchalterWert=Schalter\Wert AktionSchalterName$=Schalter\Name$ Else Schalter\Status=1
MausUeberSchalterWert=Schalter\Wert MausUeberSchalterName$=Schalter\Name$
End If Else If AktionSchalterWert<>Schalter\Wert Then Schalter\Status=0 End If End If End If Else
If ImageRectCollide(MausImage,Mausx,MausY,0,Schalter\X,Schalter\Y,Schalter\X2,Schalter\Y2) And AktionSchalterWert=0 Then MausImageNr=1 If MausTaste=True Then Schalter\Status=2
AktionSchalterWert=Schalter\Wert AktionSchalterName$=Schalter\Name$ Else Schalter\Status=1
MausUeberSchalterWert=Schalter\Wert MausUeberSchalterName$=Schalter\Name$
End If Else If AktionSchalterWert<>Schalter\Wert Then Schalter\Status=0 End If End If End If If Schalter<>Null Then If Schalter\Status=2 Then If ChannelID_Schalter=0 Then If Schalter\Sound<>0 Then ChannelID_Schalter=PlaySound(Schalter\Sound) End If End If End If End If Next End Function
Function DrawMaus() DrawImage MausImage,MouseX(),MouseY(),MausImageNr End Function
Function Upper$(S$) Slen=Len(S) If Slen>0 Then For P=1 To Slen ASCII=Asc(Mid$(S$,P,1)) If Ascii>96 And Ascii<123 Then Ascii=Ascii-32 ElseIf Ascii=252 Then Ascii=220 ElseIf Ascii=228 Then Ascii=196 ElseIf Ascii=246 Then Ascii=214 End If R$=R$+Chr$(ASCII) Next Return R$ End If End Function
Function Farbe(r,g,B) Return r*$10000 + g*$100 + b End Function
Function ColorI(I) Color (I And $FF0000)/$10000,(I And $FF00)/$100,I And $FF End Function
Function GetRed(I) Return (I And $FF0000)/$10000 End Function
Function GetGreen(I) Return (I And $FF00)/$100 End Function
Function GetBlue(I) Return I And $FF End Function
Function SucheDateien(Ordner$,Erweiterung$) If Len(Erweiterung$)>0 Then If Right$(Erweiterung$,1)<>\"|\" Then Erweiterung$=Erweiterung$+\"|\" End If End If
If Right$(Ordner$,1)<>\"\\" Then Ordner$=Ordner$+\"\\" End If LangErweiterung=Len(Erweiterung$) OrdnerNr=ReadDir(Ordner$) If OrdnerNr=0 Then Return Ordner_Konnte_Nicht_auslesen_Werden
Datei$=NextFile$(OrdnerNr) While Datei$<>\"\" Select FileType((Ordner$+Datei$)) Case COrdner If Datei$<>\".\" And Datei$<>\"..\" Then SucheDateien Ordner$+Datei$,Erweiterung$ End If Case CDatei DateiErweiterung$=Mid$(Datei$,Instr(Datei$+\".\",\".\")+1) DateiName$=Mid$(Datei$,1,Instr(Datei$+\".\",\".\")-1) If LangErweiterung>0 Then ErweiterungStimmt=False For PosErweiterung=1 To LangErweiterung Select Mid$(Erweiterung$,PosErweiterung,1) Case \"|\" If Upper$(TestErweiterung$)=Upper$(DateiErweiterung$) Then ErweiterungStimmt=True Exit End If TestErweiterung$=\"\" Default TestErweiterung$=TestErweiterung$+Mid$(Erweiterung$,PosErweiterung,1) End Select Next TestErweiterung$=\"\" If TestErweiterung$<>\"\" And Upper$(TestErweiterung$)=Upper$(DateiErweiterung$) Then ErweiterungStimmt=True End If End If If ErweiterungStimmt=True Or LangErweiterung=0 Then DateiListe= New DateiListeTyp DateiListe\Dateiname$=Dateiname$ DateiListe\Ordner$=Ordner$ DateiListe\Erweiterung$=DateiErweiterung$ End If End Select Datei$=NextFile$(OrdnerNr) Wend End Function
BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]
Type TSchalter Field transparent
Field X,Y Field XZ,YZ Field X2,Y2
Field Image Field Sound
Field Status Field Name$ Field Wert End Type
Global Schalter.TSchalter
Global MausImage Global MausImageNr Global MausDatei$ Global MausBreit Global MausHoch
Global ChannelID_Schalter
Global AktionSchalterWert Global AktionSchalterName$
Global MausUeberSchalterWert Global MausUeberSchalterName$
Function NewSchalter(X,Y,Image,transparent,Sound,Namne$,Wert) If Image=0 And Len(Bezeichnung$)=0 And Len(AlternativeBezeichnung$)=0 Then Return False End If
Schalter=New TSchalter
Schalter\Image=Image Schalter\Sound=Sound
Schalter\Name$=Name$ Schalter\Wert=Wert
Schalter\X=X Schalter\Y=Y If Image=0 Then Return Else Schalter\X2=ImageWidth(Image) Schalter\y2=ImageHeight(Image) End If
Schalter\XZ=Schalter\X2-(Schalter\X2/2)+X Schalter\YZ=Schalter\Y2-(Schalter\Y2/2)+Y
Return True End Function
Function Inst_Schalter(MausDateiname$,Breit,Hoch) MausImage=LoadAnimImage(MausDateiname$,Breit,Hoch,0,2) If MausImage<>\"\" Then MausDatei$=MausDateiname$ MausBreit =Breit MausHoch =Hoch End If End Function
Function UpdateSchalter() MausUeberSchalter DrawSchalter DrawMaus End Function
Function DeleteSchalter2(Name$) For Schalter=Each TSchalter If Upper(Schalter\Name$)=Upper$(Name$) Then
If Schalter\Image<>0 Then FreeImage Schalter\Image If Schalter\Sound<>0 Then FreeSound Schalter\Sound Delete Schalter End If Next End Function
Function DeleteSchalter(Wert) For Schalter=Each TSchalter If Schalter\Wert=Wert Then If Schalter\Image<>0 Then FreeImage Schalter\Image If Schalter\Sound<>0 Then FreeSound Schalter\Sound Delete Schalter End If Next End Function
Function Reset_Schalter() If ChannelID_Schalter<>0 Then If ChannelPlaying(ChannelID_Schalter)=True Then Return False End If End If
ChannelID_Schalter=0 AktionSchalterWert=0 AktionSchalterName$=\"\" Return True End Function
Function DrawSchalter() For Schalter=Each TSchalter If Schalter\Image<>0 Then If Schalter\transparent=True Then DrawImage Schalter\Image,Schalter\X,Schalter\Y,Schalter\Status Else DrawBlock Schalter\Image,Schalter\X,Schalter\Y,Schalter\Status End If End If Next End Function
Function MausUeberSchalter() MausImageNr=0 MausX=MouseX() Mausy=MouseY()
MausUeberSchalterWert=0 MausUeberSchalterName$=\"\"
MausTaste=MouseDown(1)
For Schalter=Each TSchalter If Schalter\Image<>0 Then If Schalter\transparent=True Then If ImagesCollide(MausImage,Mausx,MausY,0,Schalter\Image,Schalter\X,Schalter\Y,0) And AktionSchalterWert=0 Then MausImageNr=1 If MausTaste=True Then Schalter\Status=2 AktionSchalterWert=Schalter\Wert AktionSchalterName$=Schalter\Name$ Else Schalter\Status=1 MausUeberSchalterWert=Schalter\Wert MausUeberSchalterName$=Schalter\Name$ End If Else If AktionSchalterWert<>Schalter\Wert Then Schalter\Status=0 End If End If Else If ImageRectCollide(MausImage,Mausx,MausY,0,Schalter\X,Schalter\Y,Schalter\X2,Schalter\Y2) And AktionSchalterWert=0 Then MausImageNr=1 If MausTaste=True Then Schalter\Status=2
AktionSchalterWert=Schalter\Wert AktionSchalterName$=Schalter\Name$ Else Schalter\Status=1
MausUeberSchalterWert=Schalter\Wert MausUeberSchalterName$=Schalter\Name$
End If Else If AktionSchalterWert<>Schalter\Wert Then Schalter\Status=0 End If End If End If Else
If ImageRectCollide(MausImage,Mausx,MausY,0,Schalter\X,Schalter\Y,Schalter\X2,Schalter\Y2) And AktionSchalterWert=0 Then MausImageNr=1 If MausTaste=True Then Schalter\Status=2
AktionSchalterWert=Schalter\Wert AktionSchalterName$=Schalter\Name$ Else Schalter\Status=1
MausUeberSchalterWert=Schalter\Wert MausUeberSchalterName$=Schalter\Name$
End If Else If AktionSchalterWert<>Schalter\Wert Then Schalter\Status=0 End If End If End If If Schalter<>Null Then If Schalter\Status=2 Then If ChannelID_Schalter=0 Then If Schalter\Sound<>0 Then ChannelID_Schalter=PlaySound(Schalter\Sound) End If End If End If End If Next End Function
Function DrawMaus() DrawImage MausImage,MouseX(),MouseY(),MausImageNr End Function
Function Upper$(S$) Slen=Len(S) If Slen>0 Then For P=1 To Slen ASCII=Asc(Mid$(S$,P,1)) If Ascii>96 And Ascii<123 Then Ascii=Ascii-32 ElseIf Ascii=252 Then Ascii=220 ElseIf Ascii=228 Then Ascii=196 ElseIf Ascii=246 Then Ascii=214 End If R$=R$+Chr$(ASCII) Next Return R$ End If End Function
Function Farbe(r,g,B) Return r*$10000 + g*$100 + b End Function
Function ColorI(I) Color (I And $FF0000)/$10000,(I And $FF00)/$100,I And $FF End Function
Function GetRed(I) Return (I And $FF0000)/$10000 End Function
Function GetGreen(I) Return (I And $FF00)/$100 End Function
Function GetBlue(I) Return I And $FF End Function
|