Tyhmät kysymykset (II/2009)

Voit pyytää apua ohjelmointiongelmiin täältä.
Locked
Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Tyhmät kysymykset (II/2009)

Post by Awaclus » Sat Aug 29, 2009 5:30 pm

Sika wrote:Kaksi kysymystä:

1. Voiko ohjelmassa pyöriä kahta silmukkaa samaan aikaan, miten?
2. Miten saan käskettyä koneen ottamaan kuvan työpöydästä (printscreen) ohjelman sisällä, ei pelistä vaan koko työpöydästä?
1. Mihin tätä tarvitaan?
2. Ei ole tietoa, mutta luulisi, että jostain lisäkirjastosta löytyy.

EDIT: ARRGH, aina jää nuo seuraavalle sivulle postatut viestit lukematta, kun painelee vaan sitä "uusi viesti" -nappulaa siinä topicin nimen edessä :(
Last edited by Awaclus on Sat Aug 29, 2009 7:12 pm, edited 1 time in total.

Sika

Re: Tyhmät kysymykset (II/2009)

Post by Sika » Sat Aug 29, 2009 6:33 pm

Ei löytynyt SDK eikä FUN.

User avatar
phons
Guru
Posts: 1056
Joined: Wed May 14, 2008 10:11 am

Re: Tyhmät kysymykset (II/2009)

Post by phons » Sat Aug 29, 2009 6:36 pm

2. Miten saan käskettyä koneen ottamaan kuvan työpöydästä (printscreen) ohjelman sisällä, ei pelistä vaan koko työpöydästä?
Hahahahah... Et ehkä saa tätä ikinä aikaiseksi... Ainakaan sillä tavalla millä minä sen tekisin... CBFun kirjastossa on _GetPixel()-funktio jolla saadaan pikseli RUUDULTA, ei pelistä, se tallentaa pikselin samalla tapaa kuin CB:n oma GetPixel, joka hakee pikselin pelistä. ELi otat KOKO RUUDUN _GetPixel:llä, eli käyt FOR-lausekkeessa läpi jokaisen pikselin. En sitten tiedä millä saat koneen reson ulos... No sitten piirtämiseen joka tapahtuu _PutPixel komennolla...
ELikkä sinun kannattaa tehdä yhtä iso kuva kuin koneesi reso. Sitten piirrät sinne jokaisen pikslin _PutPixel-funkkarilla jotka sait _GetPixel.funkkarilla. Sitten tallennat tuon kuvan SaveImage:lla. Helppoa!! :mrgreen:

Edit: Ai ni, se eka kysymys... Repeat:n sisään Repeat... kai se nyt menee jokaisen päähän...
Image

Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Tyhmät kysymykset (II/2009)

Post by Awaclus » Sat Aug 29, 2009 7:10 pm

phons wrote:Edit: Ai ni, se eka kysymys... Repeat:n sisään Repeat... kai se nyt menee jokaisen päähän...
Menee, mutta minä käsitin ainakin niin, että haluttiin kaksi looppia yhtä aikaa, ei sisäkkäin.

Sika

Re: Tyhmät kysymykset (II/2009)

Post by Sika » Sun Aug 30, 2009 11:18 am

Jep kaksi luuppia saman aikaan, ei sikäkkäin :o

User avatar
Jonez
Devoted Member
Posts: 575
Joined: Mon Aug 27, 2007 8:37 pm

Re: Tyhmät kysymykset (II/2009)

Post by Jonez » Sun Aug 30, 2009 11:54 am

Ei onnistu cb:llä eikä ilman kehittyneitä ohjelmointiskillejä. Miksi haluaisit kaksi looppia samaan aikaan? Kaikki mitä voit keksiä voi hoitaa myös eriaikaisilla loopeilla.

Edit. Sano mitä haluat tehdä niin kerromme miten se tehdään.
-Vuoden 2008 aloittelijan ystävä -palkinnon voittaja-
Image <- protestipelikilpailun voittaja.
Space War

Sika

Re: Tyhmät kysymykset (II/2009)

Post by Sika » Sun Aug 30, 2009 12:16 pm

Se olisi vain nopeuttanut ohjelman tekoa, jossa on lataus, jonka aikana pyörisi video. :)
(huom. Lataus ei ole peliä varten, ohjelmaa, joka tekee pitkän latauksen.)

Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Tyhmät kysymykset (II/2009)

Post by Awaclus » Sun Aug 30, 2009 12:17 pm

Jonez wrote:Ei onnistu cb:llä eikä ilman kehittyneitä ohjelmointiskillejä. Miksi haluaisit kaksi looppia samaan aikaan? Kaikki mitä voit keksiä voi hoitaa myös eriaikaisilla loopeilla.
...tai laittaa siihen samaan looppiin, jolloinka vaikutus olisi sama, kuin että olisi kaksi looppia yhtä aikaa.

User avatar
otto90x
Advanced Member
Posts: 349
Joined: Mon Aug 27, 2007 9:00 pm
Location: Lapinjärvi, Finland
Contact:

Re: Tyhmät kysymykset (II/2009)

Post by otto90x » Sun Aug 30, 2009 2:00 pm

On mahdollista pyörittää videota samalla kun lataa kuvia taustalla. Se tosin vaatii hieman säätöä ja on paljon hitaampaa kuin kuvien lataaminen suoraan. Tässä hiomaton esimerkki kuvien taustalatauksesta.

Code: Select all

SCREEN 1024,768

If Not FileExists("media\map.idf") Then DataFromImage("media\map.bmp")

mem = MakeMEMBlock(8)

Repeat

    mem = ImageFromData("media\map.idf",mem,5000)
    
    img = PeekInt (mem,0)
    
    DrawImage img,0,0
    
    SetWindow Str(FPS())
    
    DrawScreen

Forever

Function ImageFromData(dDir$,mem=0,speed=100)

    If FileExists(dDir$) Then 
    
        If mem=0 Then 
    
            f = OpenToRead(dDir)
                
                iWidth = ReadShort (f)
                iHeight = ReadShort (f)
                
                img = MakeImage(iWidth,iHeight)
                
                Lock Image(img)
                    
                    For y=0 To iHeight-1
                        For x=0 To iWidth-1
                        
                            pixel = ReadInt (f)
                        
                            PutPixel2 x,y,pixel,Image(img)
                            
                        Next x
                    Next y
                
                Unlock Image(img)
            
            CloseFile f
            
            Return img
        
        ElseIf mem<>0 And MEMBlockSize(mem)=8 Then 
        
            img = PeekInt(mem,0)
            firstpointer = PeekInt(mem,4)
            
            If firstpointer<>-1 Then 
                
                pointer = firstpointer
                
                f = OpenToEdit(dDir)
                    
                    iWidth = ReadShort (f)
                    iHeight = ReadShort (f)
                    
                    If img=0 Then img = MakeImage(iWidth,iHeight)
                
                    SeekFile f,pointer
                    
                    Lock Image(img)
                    
                        y=0
                        x=0
                    
                        While pointer<firstpointer+speed And y<iHeight And x<iWidth
                        
                            pixels = (pointer-4)/4
                        
                            y = pixels/iWidth
                            x = pixels-y*iWidth
                            
                            pixel = ReadInt (f)
                            
                            PutPixel2 x,y,pixel,Image(img)
                            
                            pointer = FileOffset(f)
                        
                        Wend
    
                    Unlock Image(img)
                
                CloseFile f
            
            
                mem = MakeMEMBlock(8)
                
                PokeInt mem,0,img
                PokeInt mem,4,pointer
                
                Return mem
            Else 
                Return mem
            EndIf
            
        EndIf

    Else
        MakeError "File "+iDir$+" not found."
    EndIf


End Function 

Function DataFromImage(iDir$)

    If FileExists(iDir$) Then 

        img = LoadImage(iDir$)
        
        iWidth = ImageWidth(img)
        iHeight = ImageHeight(img)
        
        dDir$ = Left(iDir$,Len(iDir$)-4)+".idf"
        
        f = OpenToWrite(dDir$)
            
            WriteShort f,iWidth
            WriteShort f,iHeight
            
            Lock Image(img)
                
                For y=0 To iHeight-1
                    For x=0 To iWidth-1
                    
                        pixel = GetPixel2(x,y,Image(img)) 
                        
                        WriteInt f,pixel
                        
                    Next x
                Next y
            
            Unlock Image(img)
        
        CloseFile f
        
        Return dDir$

    Else
        MakeError "File "+iDir$+" not found."
    EndIf


End Function 
Otto Martikainen a.k.a. MetalRain, otto90x, kAATOSade.
Runoblogi, vuodatusta ja sekoiluja.

User avatar
11v
Member
Posts: 73
Joined: Wed Jun 10, 2009 10:13 pm

Re: Tyhmät kysymykset (II/2009)

Post by 11v » Wed Sep 02, 2009 10:40 am

Kun ajan tämän ohjelman taustan pitäisi tulla punaikseksi,
mutta se muuttuuu vasta silloin kun suurentaa tai pienentää ruutua, miksi?
Huomasin tämän ihan vahingossa.

Code: Select all

   SCREEN 250,175,32,cbsizable
   ClsColor 255, 0, 0
   DrawScreen
   WaitKey
Onko tuo Coolbasicin bugi. Vai kuuluko toun menä noin.
Black city peleistä parhain

User avatar
MikkoK
Devoted Member
Posts: 813
Joined: Thu Jun 05, 2008 2:13 pm
Location: City 17

Re: Tyhmät kysymykset (II/2009)

Post by MikkoK » Wed Sep 02, 2009 11:28 am

11v wrote:Kun ajan tämän ohjelman taustan pitäisi tulla punaikseksi,
mutta se muuttuuu vasta silloin kun suurentaa tai pienentää ruutua, miksi?
Huomasin tämän ihan vahingossa.

Code: Select all

   SCREEN 250,175,32,cbsizable
   ClsColor 255, 0, 0
   DrawScreen
   WaitKey
Onko tuo Coolbasicin bugi. Vai kuuluko toun menä noin.

Code: Select all

  SCREEN 250,175,32,cbsizable
   ClsColor 255, 0, 0
   Repeat
   DrawScreen
   Forever 
Näin ainakin alkoi toimimaan. :D En sitten osaa sanoa että miksi noin ei toiminut.

Code: Select all

#aha. @ IRCNet
<Grandi> Voit laittaa jo valmiiks hailaittiin "Amis-Mikko", koska alan kutsua sua sillä nimellä.

User avatar
Jonez
Devoted Member
Posts: 575
Joined: Mon Aug 27, 2007 8:37 pm

Re: Tyhmät kysymykset (II/2009)

Post by Jonez » Wed Sep 02, 2009 1:48 pm

Myös näin toimii:

Code: Select all

SCREEN 250,175,32,cbsizable
ClsColor 255, 0, 0
Cls
DrawScreen
WaitKey
Cls:hän kutsutaan DrawScreenissä, mutta jostain syystä cb ei siitä tässä välitä.
-Vuoden 2008 aloittelijan ystävä -palkinnon voittaja-
Image <- protestipelikilpailun voittaja.
Space War

User avatar
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Tyhmät kysymykset (II/2009)

Post by koodaaja » Wed Sep 02, 2009 4:37 pm

Cls kutsutaan drawscreenissä oletettavasti viimeisenä, muutenhan se tyhjentäisi sinne juuri piirretyn tavaran. Ja siinä vaiheessa uudenvärinen tausta piirretään backbufferiin jota ei siis piirretä ellei ole toista drawscreeniä.

Aloittelija_super

Re: Tyhmät kysymykset (II/2009)

Post by Aloittelija_super » Wed Sep 02, 2009 9:02 pm

Code: Select all

 Global tiedostopääte$
 Global Y
 
 SetWindow "Testi", 0, "Oletko varma?"

  

///////////////////////////////////////////////////////////////////////////77
///////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////7
//////////////////////////////////////////////////////////////////////////////


    Haetaan$ = "C:\Documents and Settings\All Users\Tiedostot\Omat kuvatiedostot"

    Repeat

    Text 0, 0, "Ohjelma etsii tiedostoja ja merkkaa muistiin"
    Text 0, 20, "niiden nimet. "
    Text 0, 60, "Aloita Painamalla Enter"
    
    DrawScreen

    Until KeyHit (28)
    
    
  
///////////////////////////////////////////////////////////////////////////77
///////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////7
//////////////////////////////////////////////////////////////////////////////  
    

    
    ClearText
 
   SetWindow "Odota hetki", 0, "Jos lopetat ohjelman, siitä voi tula pahoja sivu vaukutuksia!"

  

///////////////////////////////////////////////////////////////////////////77
///////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////7
//////////////////////////////////////////////////////////////////////////////


 
   aika = Timer() ' Aloitetaan ajanlasku

  FrameLimit 0

  tiedostopääte = "" ' Tiedostopääte ei ole mitään
  ' Tehdään 'Fuktio' sulkeissa olevaan paikkaan
      f=OpenToWrite("Tiedostot.Found")
  LöydäTiedostot(Haetaan$)
  CloseFile f
 SetWindow "lataus suoritettiin "+(Timer()-aika)+"  milliseukunnissa.", 0, "Founder on ajan tasalla!" ' Kertoo ajan
 CloseInput


////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////


       Alku:
       

    Repeat 'Alku silmmukka
    
    Text 0,0, "Valmis"

    Wait 2500
    Exit
 
    Until EscapeKey ()
    
    End

///////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////7
/////////////////////////////////////////////////////////////////////////////7

Function LöydäTiedostot(Polku$) 'Aloittaa funktion
  ChDir "C:\Program Files\CoolBasic"
  Polku$ = Polku$ + "\" 'Laittaa Polun väliin ' /
  ChDir Polku$ 'Etsitään kohteesta 'Polku
  
  StartSearch   ' Aloittaa etsimisen
  file$ = FindFile() ' Kirjoitettu File$ on
  file = FindFile() ' Sama kuin pelkkä file

  Repeat 
       
    file=FindFile()  ' Nyt kummatkin filet ovat tässä, sillä toisella keralla
                     ' Ei tarvitse käyttää tätä '$' merkkiä
  
    If IsDirectory(file)  ' Jos file on kansio sitten
      WriteLine f, file + " " + Replace (Polku$, " ", "%20") + Replace (file$, " ", "%20")   
      EndSearch  ' Lopettaa etsimisen
      
      LöydäTiedostot(Polku$+file) 'Aloittaa uuden funktion, poluksi tulee  Polku + File
      ChDir Polku$ ' Kun se palaa takaisin funktiosta, kohteeksi tulee Polku$
      StartSearch 'Aloittaa etsimisen
  
      Repeat  ' Aloittaaa silmukan '(Silmukka etsiii, kansiot jotka ovat
        joku$ = FindFile() '' jo etsitty) ' Eikä tee niillä mitään.
      Until joku$ = file ' Lopettaa vasta sitten, kun Joku = file
      
      
    ElseIf Right(file,Len(tiedostopääte$)) = tiedostopääte$
     WriteLine f, file + " " + Replace (Polku$, " ", "%20") + Replace (file$, " ", "%20")
    EndIf ' Lopettaa if
     
  Until file = "" ' Lopettaa silmukan jos file = ""
EndSearch  'Lopettaa etsimisen

  Return 0 ' Palautaa arvoja
EndFunction ' Lopettaa Funktion



Miks mavaa? Voisiko korjata! ??

User avatar
11v
Member
Posts: 73
Joined: Wed Jun 10, 2009 10:13 pm

Re: Tyhmät kysymykset (II/2009)

Post by 11v » Wed Sep 02, 2009 9:05 pm

Teitkö koko haku function itse? ;)

Se näyttää aika hyvältä.

Mavi johtuu writeline käskystä koita laittaa se function sisään!
Black city peleistä parhain

Aloittelija_super

Re: Tyhmät kysymykset (II/2009)

Post by Aloittelija_super » Wed Sep 02, 2009 9:07 pm

Mutta sitten se kirjoittaa muistiin vain osan miksi?
[quote=11v]11v sanoi jotain[/quote]

User avatar
Jare
Devoted Member
Posts: 865
Joined: Mon Aug 27, 2007 10:18 pm
Location: Helsinki
Contact:

Re: Tyhmät kysymykset (II/2009)

Post by Jare » Thu Sep 03, 2009 1:19 am

Aloittelija_super, koita laittaa koodin alkuun rivi Global f. Ainakin yksi ongelma ohjelmassasi nimittäin on se, että ensin avaat tiedostoon kirjoittamisen paikalliseen muuttujaan nimeltä f, mutta sitten hypäät funktioon tekemään varsinaiset kirjoituskäskyt. Käytännön efekti tässä on se, että funktiossa f:n arvo on 0, joten se ei osoita enää avaamaasi tiedostoon. Tämä tappaa ohjelman.

Global f tekee f-muuttujasta kuolemattoman, jolloin sen arvo säilyy aina, vaikka menisit funktioon. Lyhytnimisten muuttujien (erityisesti yksikirjaimisten) määrittäminen globaaliksi ei ole mikään sievä tapa ohjelmoida, koska se rajoittaa muuttujien käyttöä todella paljon, mutta tässä tapauksessa se ei tekisi hirveätä poikkeusta ohjelmasi koodiasuun.

Aloittelija_super

Re: Tyhmät kysymykset (II/2009)

Post by Aloittelija_super » Thu Sep 03, 2009 8:53 am

Thanks, very much. Work :D

Aloittelija_super

Re: Tyhmät kysymykset (II/2009)

Post by Aloittelija_super » Thu Sep 03, 2009 9:51 am

Voi *****

Code: Select all

 SCREEN 700,150

 Global Tiedostopääte$
 Global Tiedosto$
 Global Y
 Global f
 
 SetWindow "Founder ajan tasalle", 0, "Oletko varma?"

  

///////////////////////////////////////////////////////////////////////////77
///////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////7
//////////////////////////////////////////////////////////////////////////////
' "C:\Documents and Settings\All Users\Tiedostot\Omat kuvatiedostot"
   
   
   Repeat
    Locate 0,20
    Haetaan$ = Input("")
    Text 0,0, "Kirjoita mistä haetaan: "
    Text 0,60, "Jatka painamalla Enter"
    DrawScreen
    Until KeyHit (28)
    
    CloseInput
    
    Repeat
    Locate 0,0
    Tiedosto$ = Input("Kirjoita tiedoston pääte: ")
    Text 0, 20, "Huom. Pistettä ei pidä laittaa."
    Text 0, 60, "Aloita Painamalla Enter"
    DrawScreen
    Until KeyHit (28)
    
    Tiedostopääte$ = Tiedosto$
    CloseInput
    

  
///////////////////////////////////////////////////////////////////////////77
///////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////7
//////////////////////////////////////////////////////////////////////////////  
    

    
    ClearText
 
   SetWindow "Odota hetki", 0, "Jos lopetat ohjelman, siitä voi tula pahoja sivu vaukutuksia!"

  

///////////////////////////////////////////////////////////////////////////77
///////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////7
//////////////////////////////////////////////////////////////////////////////


 
   aika = Timer() ' Aloitetaan ajanlasku

  FrameLimit 0

  ' Tehdään 'Fuktio' sulkeissa olevaan paikkaan
   f=OpenToWrite(Tiedostopääte$ + " Tiedostot.Found")
  LöydäTiedostot(Haetaan$)
  CloseFile f
 SetWindow "lataus suoritettiin "+(Timer()-aika)+"  milliseukunnissa.", 0, "Founder on ajan tasalla!" ' Kertoo ajan
 CloseInput


////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////


       Alku:
       

    Repeat 'Alku silmmukka
    
    Text 0,0, "Valmis"

    Wait 5000
    Exit
 
    Until EscapeKey ()
    
    End

///////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////7
/////////////////////////////////////////////////////////////////////////////7

Function LöydäTiedostot(Polku$) 'Aloittaa funktion
  Polku$ = Polku$ + "\" 'Laittaa Polun väliin ' /
  ChDir Polku$ 'Etsitään kohteesta 'Polku
  
  StartSearch   ' Aloittaa etsimisen
  file$ = FindFile() ' Kirjoitettu File$ on
  file = FindFile() ' Sama kuin pelkkä file

  Repeat 
       
    file=FindFile()  ' Nyt kummatkin filet ovat tässä, sillä toisella keralla
                     ' Ei tarvitse käyttää tätä '$' merkkiä
  
    If IsDirectory(file)  ' Jos file on kansio sitten
      EndSearch  ' Lopettaa etsimisen
      
      LöydäTiedostot(Polku$+file) 'Aloittaa uuden funktion, poluksi tulee  Polku + File
      ChDir Polku$ ' Kun se palaa takaisin funktiosta, kohteeksi tulee Polku$
      StartSearch 'Aloittaa etsimisen
  
      Repeat  ' Aloittaaa silmukan '(Silmukka etsiii, kansiot jotka ovat
        joku$ = FindFile() '' jo etsitty) ' Eikä tee niillä mitään.
      Until joku$ = file ' Lopettaa vasta sitten, kun Joku = file
      
    ElseIf Right(Lower(file),Len(Tiedostopääte$)) = Lower (Tiedostopääte$)
     WriteLine f, file + " " + Replace (Polku$, " ", "%20") + Replace (file$, " ", "%20")
    EndIf ' Lopettaa if
     
  Until file = "" ' Lopettaa silmukan jos file = ""
EndSearch  'Lopettaa etsimisen

  Return 0 ' Palautaa arvoja
EndFunction ' Lopettaa Funktion

Miksi Tiedostopääte ei toimi. Eli sen pitäisi kirjoittaa muistiin ainoastaan ne jonka tiedosto pääte on itse valittu.
Vosiko joku auttaa taas.
Miksiiiiiiiiiii!

Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Tyhmät kysymykset (II/2009)

Post by Awaclus » Thu Sep 03, 2009 5:08 pm

Suosittelisin rekisteröitymään foorumeille. Se ei vie kuin pari minuuttia, ja tuplapostaukset ovat aika abysmaalisia verrattuna siihen, että muokkaisit vanhaa postiasi, ja tervetuloa vain foorumeille :)

Locked