Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Ein kleines simples Malprogramm ;)

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
AndT



Anmeldungsdatum: 02.04.2007
Beiträge: 481

BeitragVerfasst am: 23.06.2007, 22:12    Titel: Ein kleines simples Malprogramm ;) Antworten mit Zitat

Ausschlieslich mit der Maus steuerbar zwinkern
Zeichnet in Echtzeit und erzeugt KEINE CPU auslastung zwinkern
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 grinsen

Was haltet ihr davon??
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

BeitragVerfasst am: 23.06.2007, 23:01    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
AndT



Anmeldungsdatum: 02.04.2007
Beiträge: 481

BeitragVerfasst am: 23.06.2007, 23:25    Titel: Antworten mit Zitat

So jetzt ist alles drinn was ihr haben wollt zwinkern

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 zwinkern
Es kann einfach schneller geladen werden.

Ich entwickle es nach euren Wünschen weiter.

Nur zu. Her mit den gefundenen Bugs.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Michael Frey



Anmeldungsdatum: 18.12.2004
Beiträge: 2577
Wohnort: Schweiz

BeitragVerfasst am: 24.06.2007, 08:51    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
AndT



Anmeldungsdatum: 02.04.2007
Beiträge: 481

BeitragVerfasst am: 24.06.2007, 11:07    Titel: Antworten mit Zitat

Die Bugs hab ich schon alle raus.
Und das Scrollrad auch schon drinn.
Es fehlt nur noch der Feinschliff.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Mao



Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1

BeitragVerfasst am: 24.06.2007, 11:41    Titel: Antworten mit Zitat

Einfachere Farbwahl, mehr Zeichenwerkzeuge, verschieden dicke Linien, Ebenen, ... Zunge rausstrecken grinsen
_________________
Eine handvoll Glück reicht nie für zwei.
--
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
csde_rats



Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur

BeitragVerfasst am: 24.06.2007, 12:35    Titel: Antworten mit Zitat

... Transparenz, GIF, PNG, JPG-Unterstütztung




ne aber ma im vollem ernste der fbc.exe: is doch gar nich ma so schlecht lächeln
Nur BMP-Unterstütztung wäre gut.

Es gibt zwar noch einen Bug, aber den sage ich nicht Zunge rausstrecken den verwende ich jetzt für eigene Zwecke durchgeknallt
_________________
If hilfreicher_Beitrag then klick(location.here)

Klick
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

BeitragVerfasst am: 24.06.2007, 12:51    Titel: Antworten mit Zitat

csderats hat Folgendes geschrieben:
Es gibt zwar noch einen Bug, aber den sage ich nicht Zunge rausstrecken den verwende ich jetzt für eigene Zwecke durchgeknallt

jaja, das ist genau DIE einstellung, die software-entwickler so LIEBEN... weil sie so am besten die bugs beheben können! Kopf schütteln

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
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
AndT



Anmeldungsdatum: 02.04.2007
Beiträge: 481

BeitragVerfasst am: 24.06.2007, 13:25    Titel: Antworten mit Zitat

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 lachen ..


Zuletzt bearbeitet von AndT am 24.06.2007, 14:15, insgesamt 2-mal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Mao



Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1

BeitragVerfasst am: 24.06.2007, 13:31    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
AndT



Anmeldungsdatum: 02.04.2007
Beiträge: 481

BeitragVerfasst am: 24.06.2007, 13:40    Titel: Antworten mit Zitat

OK es BLEIBT OpenSorce zwinkern

Ich hab den Code nochmals editiert.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Michael Frey



Anmeldungsdatum: 18.12.2004
Beiträge: 2577
Wohnort: Schweiz

BeitragVerfasst am: 24.06.2007, 17:31    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
csde_rats



Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur

BeitragVerfasst am: 24.06.2007, 17:34    Titel: Antworten mit Zitat

Jojo hat Folgendes geschrieben:
csderats hat Folgendes geschrieben:
Es gibt zwar noch einen Bug, aber den sage ich nicht Zunge rausstrecken den verwende ich jetzt für eigene Zwecke durchgeknallt

jaja, das ist genau DIE einstellung, die software-entwickler so LIEBEN... weil sie so am besten die bugs beheben können! Kopf schütteln


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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Mao



Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1

BeitragVerfasst am: 25.06.2007, 17:11    Titel: Antworten mit Zitat

Toll, bringt einen auch weiter. peinlich
_________________
Eine handvoll Glück reicht nie für zwei.
--
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
AndT



Anmeldungsdatum: 02.04.2007
Beiträge: 481

BeitragVerfasst am: 07.07.2007, 09:49    Titel: Antworten mit Zitat

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 grinsen
Wenn ichs dann hinbekomm auch ein Farbfüller mit Farbverlauf.
Der Dateiexport ist bereits fertig zwinkern
_________________
Bis irgendwann... grinsen
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
csde_rats



Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur

BeitragVerfasst am: 07.07.2007, 12:21    Titel: Antworten mit Zitat

AndT hat Folgendes geschrieben:

Der Dateiexport ist bereits fertig zwinkern

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
AndT



Anmeldungsdatum: 02.04.2007
Beiträge: 481

BeitragVerfasst am: 07.07.2007, 15:23    Titel: Antworten mit Zitat

Danke für den Bug zwinkern
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... grinsen
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Sebastian
Administrator


Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland

BeitragVerfasst am: 07.07.2007, 16:32    Titel: Antworten mit Zitat

AndT hat Folgendes geschrieben:
Danke für den Bug zwinkern

Nanu, dafür hat sich aber wahrscheinlich noch nie jemand bedankt! grinsen

Lied hat Folgendes geschrieben:
Danke für diesen Softwarefehler,
danke für jeden neuen Bug,
danke, dass ich all diese Fehler ins Prog machen kann.

Hammer
_________________

Die gefährlichsten Familienclans | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
AndT



Anmeldungsdatum: 02.04.2007
Beiträge: 481

BeitragVerfasst am: 07.07.2007, 18:29    Titel: Antworten mit Zitat

Warum nicht?
Ist doch mal was neues durchgeknallt.
_________________
Bis irgendwann... grinsen
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
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.

 Impressum :: Datenschutz