 |
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 |
AndT
Anmeldungsdatum: 02.04.2007 Beiträge: 481
|
Verfasst am: 23.06.2007, 22:12 Titel: Ein kleines simples Malprogramm ;) |
|
|
Ausschlieslich mit der Maus steuerbar
Zeichnet in Echtzeit und erzeugt KEINE CPU auslastung
Was will man mehr?
Code: |
function uml(blah as string) as string
select case blah
case "ä": return chr(132)
case "ö": return chr(148)
case "ü": return chr(129)
end select
uml=blah
end function
Sub start
screen 19,,,1
dim A(1 to 256) as single ' Ich bin zu Faul ;)
dim as integer mx,my,button
dim A2(7) AS DOUBLE
getmouse mx,my,,button
DO
getmouse mx,my,,button
A(6)=button
IF A(6)=1 then A2(7)+=0.095
If A(6)=2 Then A2(7)-=0.095
IF A(6)=4 Then cls
IF A2(7) < 1 THEN A2(7) = 1
IF A2(7) > 256 then A2(7) = 256
Locate 1,1:print "Farbe : ";INT(A2(7));" (Farbe "+uml("ä")+"ndern mit Maustasten. Scrollrad zum l"+uml("ö")+"schen dr"+uml("ü")+"cken."
If A(6) = -1 then else line(mx,my)-(A(1),A(2)),A2(7)
sleep 1
A(1)=mx
A(2)=my
IF INKEY=CHR(27) then exit do
loop
end sub
start
|
Edit:
Alle Bugs sind jetzt raus
Was haltet ihr davon?? |
|
Nach oben |
|
 |
Jojo alter Rang

Anmeldungsdatum: 12.02.2005 Beiträge: 9736 Wohnort: Neben der Festplatte
|
Verfasst am: 23.06.2007, 23:01 Titel: |
|
|
ehrliche kritik:
- naja, sonderlich sauber ist der code ja nicht. du speicherst alle variablen in den nichts sagenden arrays A und A2 - nach ein paar tagen weißt du selbst nicht mehr, was damit gemeint war, und andere erst recht nicht.
- dass man nicht absetzen kann (zumindest habe ich nicth rausgefunden, ob das möglich ist), ist wohl ein sehr großes manko. zeichenprogramme zeichnen idR nur mit druck afu die maustaste.
- man kann nicht speichern oder laden.
Fazit: Netter zeitvertreib / nette programmierübung, aber nichts einsetzbares... _________________ » Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
Nach oben |
|
 |
AndT
Anmeldungsdatum: 02.04.2007 Beiträge: 481
|
Verfasst am: 23.06.2007, 23:25 Titel: |
|
|
So jetzt ist alles drinn was ihr haben wollt
Ich hab den Code neuentwickelt.
Die Farben werden jetzt mit + und - getaucht!
PS:
Laden folgt später.
Dafür hab ich einen Viewer geschrieben.
Eine Völlige neuentwiecklung...
Male1.bas:
Code: |
function uml(blah as string) as string
select case blah
case "ä": return chr(132)
case "ö": return chr(148)
case "ü": return chr(129)
end select
uml=blah
end function
Sub start
open "zeichnung.fbz" for binary as #1
dim as integer my,mx,button ' Diffinationen für die Maus
dim as single Maus_X,Maus_Y,Maus_Taste,AltePos_X,AltePos_Y
dim as double farbe
dim as string Tastatur_Taste
screen 19,,,1
Do
Locate 1,1:Print "Farbe :";CINT(FARBE)
getmouse my,mx,,button ' Maus Status abrufen
Maus_X= mx ' Maus Setup
Maus_Y= my
Maus_Taste= button
' Programmierung für Farbe
Tastatur_Taste=INKEY
IF Farbe < 1 then Farbe=1
If Farbe > 256 then Farbe=256
IF Tastatur_Taste="+" THEN Farbe+=0.5
IF Tastatur_Taste="-" THEN Farbe-=0.5
' Bewegung zeichnen und Speichern
IF Maus_Taste=1 then
LINE(Maus_Y,Maus_X)-(AltePos_Y,AltePos_X),Farbe
Print #1,Maus_Y;Maus_X;Altepos_Y;AltePos_X;Farbe
end if
If Maus_Taste=2 then cls ' ist Maus_Taste 2 dann Lösche Bildschirm
' Der Eigendliche Trick des Ganzen (sorgt für kaum cpu auslastung und nebenbei dafür das es klappt, mit dem Zeichnen)
sleep 1
'Alte Mausposition in AltePos_X und AltePos_Y speichern.
AltePos_X=mx
AltePos_Y=my
' Abbruchfunktion (ESC)
IF Tastatur_Taste=CHR(27) THEN EXIT DO
loop
end sub
start
|
Und der Viewer zum betrachten der Zeichnungen:
Code: |
dim as single Maus_X,Maus_Y,AltePos_X,AltePos_Y,Farbe,VermuteEnde
open "zeichnung.fbz" for input as #1
screen 18
DO
input #1,Maus_X,Maus_Y,AltePos_X,AltePos_Y,Farbe
LINE (Maus_X,Maus_Y)-(AltePos_X,AltePos_Y),Farbe
IF MAUS_X=0 THEN VermuteEnde+=1 else VermuteEnde=0
IF VermuteEnde=3 Then exit do
LOOP
sleep
|
Das Dateisystem ist meine eigene erfindung
Es kann einfach schneller geladen werden.
Ich entwickle es nach euren Wünschen weiter.
Nur zu. Her mit den gefundenen Bugs. |
|
Nach oben |
|
 |
Michael Frey

Anmeldungsdatum: 18.12.2004 Beiträge: 2577 Wohnort: Schweiz
|
Verfasst am: 24.06.2007, 08:51 Titel: |
|
|
Du könnstest die Farbe mit dem Scrollrad der Maus verbinden. (also Drehen nicht Drücken)
Wäre nett, wenn man alte Dateien auch wieder zum bearbeiten öffnen könnte.
Wenn du Dateien öffnest, mach sie auch wieder zu:
Tipp hat Folgendes geschrieben: |
loop
close 1
end sub |
Ob dein Dateiformat wirklich kleiner oder schneller ist, ist von der Zeichung abhängig. Wenn du aber schon so ein Format machst, könntest du die darin gespeicherten Infos für eine Rückgängig Funktion verwenden.
Du willst noch von Bugs hören?
Kein Problem, es gibt einige.
Verwende im Viewer den gleichen Screeen wie im Zeichungsprogramm.
Wenn bereits eine alte zeichnung.fbz existiert, entsteht ein Unbrauchbares Bild wenn man Male1.bas startet, zeichnet, beendet und den Viewer startet. _________________ http://de.wikibooks.org/wiki/FreeBasic Jede Hilfe für dieses Buch ist Willkommen!
http://de.wikibooks.org/wiki/FreeBasic:_FAQ FAQ zu Freebasic (im Aufbau, hilfe Willkommen)
Neu mit Syntax Highlight |
|
Nach oben |
|
 |
AndT
Anmeldungsdatum: 02.04.2007 Beiträge: 481
|
Verfasst am: 24.06.2007, 11:07 Titel: |
|
|
Die Bugs hab ich schon alle raus.
Und das Scrollrad auch schon drinn.
Es fehlt nur noch der Feinschliff. |
|
Nach oben |
|
 |
Mao
Anmeldungsdatum: 25.09.2005 Beiträge: 4409 Wohnort: /dev/hda1
|
Verfasst am: 24.06.2007, 11:41 Titel: |
|
|
Einfachere Farbwahl, mehr Zeichenwerkzeuge, verschieden dicke Linien, Ebenen, ...  _________________ Eine handvoll Glück reicht nie für zwei.
--
 |
|
Nach oben |
|
 |
csde_rats

Anmeldungsdatum: 07.01.2007 Beiträge: 2292 Wohnort: Zwischen Sessel und Tastatur
|
Verfasst am: 24.06.2007, 12:35 Titel: |
|
|
... Transparenz, GIF, PNG, JPG-Unterstütztung
ne aber ma im vollem ernste der fbc.exe: is doch gar nich ma so schlecht
Nur BMP-Unterstütztung wäre gut.
Es gibt zwar noch einen Bug, aber den sage ich nicht den verwende ich jetzt für eigene Zwecke  _________________ If hilfreicher_Beitrag then klick(location.here)
Klick |
|
Nach oben |
|
 |
Jojo alter Rang

Anmeldungsdatum: 12.02.2005 Beiträge: 9736 Wohnort: Neben der Festplatte
|
Verfasst am: 24.06.2007, 12:51 Titel: |
|
|
csderats hat Folgendes geschrieben: | Es gibt zwar noch einen Bug, aber den sage ich nicht den verwende ich jetzt für eigene Zwecke  |
jaja, das ist genau DIE einstellung, die software-entwickler so LIEBEN... weil sie so am besten die bugs beheben können!
also wenn du das programm noch weiterentwickeln willst:
menüs wären z.B. praktisch. eine leiste mit werkzeugen am bildschirmrand wäre auch schön. werkzeuge, die nützlich sind: Füllen, Kreise, Rechtecke, linien... _________________ » Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
Nach oben |
|
 |
AndT
Anmeldungsdatum: 02.04.2007 Beiträge: 481
|
Verfasst am: 24.06.2007, 13:25 Titel: |
|
|
Naja...
Das hier ist die Letzte version, die ich Opensource mache..
Ab dann gibts keine Source mehr. Heheheh...
Mit den Tasten 1 und 2 kann zwischen Stift unf Farbfüller gewechselt werden.
Das Dateiystem habe ich nochmals erweitert.
Editiert:
male1.bas:
Code: | function uml(blah as string) as string
select case blah
case "ä": return chr(132)
case "ö": return chr(148)
case "ü": return chr(129)
end select
uml=blah
end function
Sub start
kill "zeichnung.fbz" ' um ein überlappen zu verhindern
open "zeichnung.fbz" for output as #1
dim as integer scroll10,my,mx,button ' Diffinationen für die Maus
dim as single Maus_X,Maus_Y,Maus_Taste,AltePos_X,AltePos_Y,Maus_Scroll
dim as double farbe
dim as string Tastatur_Taste, Werkzeug
screen 19,,,1
setmouse 800/2,480/2,1
Werkzeug="stift"
Do
getmouse my,mx,scroll10,button ' Maus Status abrufen
Maus_X= mx ' Maus Setup
Maus_Y= my
Maus_Taste= button
Maus_Scroll= scroll10 ' Scrollrad
If Maus_X=0 Then Maus_X=1 ' Debugging
If Maus_Y=0 Then Maus_Y=1
' Programmierung für Farbe
Farbe=Maus_Scroll
'GUI
Locate 1,1:color 92:Print "Farbe :";FARBE;" ";:color Farbe :Locate 1, 14 :Print CHR$(219)+CHR$(219)+CHR$(219)+CHR$(219)+CHR$(219)+CHR$(219) : color 92:Locate 1,22:Print "Werkzeug: ";Werkzeug;SPACE$(10)
Tastatur_Taste=INKEY ' Tasten überprüfen
If Tastatur_Taste="1" Then IF Werkzeug <> "stift" then Werkzeug = "stift"
If Tastatur_Taste="2" Then IF Werkzeug <> "farbf"+uml("ü")+"ller" then Werkzeug = "farbf"+uml("ü")+"ller"
' Bewegung zeichnen und Speichern
IF Maus_Taste=1 then
print #1,werkzeug, Maus_Y,Maus_X,AltePos_Y,AltePos_X,Farbe
If Werkzeug="stift" then
If Maus_Y <> AltePos_Y Then Line (Maus_Y,Maus_X)-(AltePos_Y,AltePos_X),Farbe :
If Maus_X <> AltePos_X Then Line (Maus_Y,Maus_X)-(AltePos_Y,AltePos_X),Farbe
END IF
If Werkzeug="farbf"+uml("ü")+"ller" Then
Paint(Maus_y,Maus_X),Farbe,Farbe
END IF
end if
'Speichersystem
If Maus_Taste=2 then cls ' ist Maus_Taste 2 dann Lösche Bildschirm
' Der Eigendliche Trick des Ganzen (sorgt für kaum cpu auslastung und nebenbei dafür das es klappt, mit dem Zeichnen)
sleep 1
'Alte Mausposition in AltePos_X und AltePos_Y speichern.
AltePos_X=mx
AltePos_Y=my
' Abbruchfunktion (ESC)
IF Tastatur_Taste=CHR(27) THEN werkzeug="ende":print #1 ,werkzeug : close #1 : EXIT DO
loop
end sub
start |
Code: |
function uml(blah as string) as string
select case blah
case "ä": return chr(132)
case "ö": return chr(148)
case "ü": return chr(129)
end select
uml=blah
end function
dim as single Maus_X,Maus_Y,AltePos_X,AltePos_Y,Farbe,VermuteEnde,Debug
dim as string Werkzeug
Print "Lade.."
open "zeichnung.fbz" for input as #1
screen 19,,,1
Print "Zeichne..."
DO
Input #1,Werkzeug,Maus_Y,Maus_X,AltePos_Y,AltePos_X,Farbe
If Werkzeug="stift" then
Line (Maus_Y,Maus_X)-(AltePos_Y,AltePos_X),Farbe :
END IF
If Werkzeug="farbf"+uml("ü")+"ller" Then
Paint(Maus_y,Maus_X),Farbe,Farbe
END IF
If Werkzeug="ende" then exit do
LOCATE 2,1:Print Maus_X
IF MAUS_X=0 THEN VermuteEnde+=1 else VermuteEnde=0
IF VermuteEnde=2000 Then exit do
IF INKEY$=CHR$(27) then exit do
LOOP
sleep
|
Ich hoffe dass ich alle Bugs gefunden habe ..
Zuletzt bearbeitet von AndT am 24.06.2007, 14:15, insgesamt 2-mal bearbeitet |
|
Nach oben |
|
 |
Mao
Anmeldungsdatum: 25.09.2005 Beiträge: 4409 Wohnort: /dev/hda1
|
Verfasst am: 24.06.2007, 13:31 Titel: |
|
|
Ich mein, ich will niemandem meine OpenSource-Meinung aufzwingen, aber...
Warum bist du der Meiung, dass zukünftige Versionen kein Source mehr beiliegen soll?
Glaubst du, dass das dann etwas so einmaliges ist, dass man damit Millionen verdienen kann?
Ich will dich nicht umstimme, mich interessieren nur deine Beweggründe... _________________ Eine handvoll Glück reicht nie für zwei.
--
 |
|
Nach oben |
|
 |
AndT
Anmeldungsdatum: 02.04.2007 Beiträge: 481
|
Verfasst am: 24.06.2007, 13:40 Titel: |
|
|
OK es BLEIBT OpenSorce
Ich hab den Code nochmals editiert. |
|
Nach oben |
|
 |
Michael Frey

Anmeldungsdatum: 18.12.2004 Beiträge: 2577 Wohnort: Schweiz
|
Verfasst am: 24.06.2007, 17:31 Titel: |
|
|
Auf die Gefahr hin mich zu Wiederhollen:
Schliesse Datein die öffnest auch wieder.
Zitat: | dim as single Maus_X,Maus_Y,Maus_Taste,AltePos_X,AltePos_Y,Maus_Scroll |
Wie so ausgerechnet Single? GETMOUSE liefert nur ganz Zahlen also Integer.
Code: | ' Programmierung für Farbe
Farbe=sgn(scroll10)*(Maus_Scroll mod 16) |
Verhindert das die Benutzer Sinnfreie Farben einstellen können (- und grösser 15)
Zitat: | If Maus_Taste=2 then cls ' ist Maus_Taste 2 dann Lösche Bildschirm |
Witzig, denn das Bild ist ja noch immer in der Datei vorhanden.
Es gibt also sozusagen doppelt belichtete Bilder.
Zitat: | Paint(Maus_y,Maus_X),Farbe,Farbe |
Wäre nicht
Zitat: | Paint(Maus_y,Maus_X),Farbe |
Sinnvoller?
Zitat: | IF VermuteEnde=2000 Then exit do |
Sieh dir besser mal die Funktion EOF() an. _________________ http://de.wikibooks.org/wiki/FreeBasic Jede Hilfe für dieses Buch ist Willkommen!
http://de.wikibooks.org/wiki/FreeBasic:_FAQ FAQ zu Freebasic (im Aufbau, hilfe Willkommen)
Neu mit Syntax Highlight |
|
Nach oben |
|
 |
csde_rats

Anmeldungsdatum: 07.01.2007 Beiträge: 2292 Wohnort: Zwischen Sessel und Tastatur
|
Verfasst am: 24.06.2007, 17:34 Titel: |
|
|
Jojo hat Folgendes geschrieben: | csderats hat Folgendes geschrieben: | Es gibt zwar noch einen Bug, aber den sage ich nicht den verwende ich jetzt für eigene Zwecke  |
jaja, das ist genau DIE einstellung, die software-entwickler so LIEBEN... weil sie so am besten die bugs beheben können! |
es ist eigtl. kein bug, aber würde man ihn "beheben" könnte man eine ganz bestimmte art von bildern nicht mehr zeichnen.. _________________ If hilfreicher_Beitrag then klick(location.here)
Klick |
|
Nach oben |
|
 |
Mao
Anmeldungsdatum: 25.09.2005 Beiträge: 4409 Wohnort: /dev/hda1
|
Verfasst am: 25.06.2007, 17:11 Titel: |
|
|
Toll, bringt einen auch weiter.  _________________ Eine handvoll Glück reicht nie für zwei.
--
 |
|
Nach oben |
|
 |
AndT
Anmeldungsdatum: 02.04.2007 Beiträge: 481
|
Verfasst am: 07.07.2007, 09:49 Titel: |
|
|
Als nächstes kommt jetzt eine GUI, Rückgängigfunktion, 32bit-Farben und der Export in alle gängigen Formate z.B BMP, JPG ,PNG usw..
Jede Datei kann geladen und bearbeitet werden
Wenn ichs dann hinbekomm auch ein Farbfüller mit Farbverlauf.
Der Dateiexport ist bereits fertig  _________________ Bis irgendwann...  |
|
Nach oben |
|
 |
csde_rats

Anmeldungsdatum: 07.01.2007 Beiträge: 2292 Wohnort: Zwischen Sessel und Tastatur
|
Verfasst am: 07.07.2007, 12:21 Titel: |
|
|
AndT hat Folgendes geschrieben: |
Der Dateiexport ist bereits fertig  |
Naja.
Mit FreeImage und ohne openGL ist das jetzt nicht sooo schwer...
bug:
wenn man mit der Maus rechts unten das Fenster verläst, und auf der anderen seite wieder heringeht, zieht sich eine gerade linie von links oben auf die beiden Punkte. _________________ If hilfreicher_Beitrag then klick(location.here)
Klick |
|
Nach oben |
|
 |
AndT
Anmeldungsdatum: 02.04.2007 Beiträge: 481
|
Verfasst am: 07.07.2007, 15:23 Titel: |
|
|
Danke für den Bug
Den hab ich übrigens schon Raus
EASY
Code: | 'Alte Mausposition in AltePos_X und AltePos_Y speichern.
IF Farbe > -1 then
AltePos_X=mx
AltePos_Y=my
end if |
_________________ Bis irgendwann...  |
|
Nach oben |
|
 |
Sebastian Administrator

Anmeldungsdatum: 10.09.2004 Beiträge: 5969 Wohnort: Deutschland
|
|
Nach oben |
|
 |
AndT
Anmeldungsdatum: 02.04.2007 Beiträge: 481
|
Verfasst am: 07.07.2007, 18:29 Titel: |
|
|
Warum nicht?
Ist doch mal was neues . _________________ Bis irgendwann...  |
|
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.
|
|