Mit Purebasic ein BmpBild( 2Farbig) umwandeln für CPC

schneiderfan · 26. November 2009

Habe mit Hilfe des PurebasicForum ein Programm zum Umwandeln von BMPGrafiken erstellt.

Ein BmpBild320x200 2Farbig wird einlesen und als "byte.bin" abgespeichert.

Dieses kann man jetzt im MODE 2 einlesen:
Load"byte.bin",&c000

Kann man auch leicht umwandeln für "FreeBasic".

Code

Global ByteInhalt.c,Staffel.l,Linie.l,ByteStueck.l,EinzelBit.l,zz.l

  InitSprite()
 
  OpenWindow(0,0,0,800,600,"cpctest",#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(0),10,10,700,400,0,0,0)

  OpenConsole()

  ClearScreen(RGB(255,255,0))

  LoadSprite(0, "cpctest.bmp", #PB_Sprite_Texture)
  DisplaySprite(0,0,0)

  Repeat

    Event.l = WindowEvent()   

    If GetAsyncKeyState_(#VK_Q)   
      If CreateFile(0, "byte.bin")  
        PrintN("es gehtlos..")
        StartDrawing(SpriteOutput(0))     
        For Staffel = 0 To 7
          For Linie = 0 To 24
            For ByteStueck = 0 To 79
              ByteInhalt = 0
                For EinzelBit = 0 To 7
                  If Point( ByteStueck * 8 + 7 - Einzelbit , Linie * 8 + Staffel ) 
                    ByteInhalt + ( 1 << Einzelbit )
                  EndIf
                Next
              WriteCharacter(0, ByteInhalt)
            Next
          Next
          ByteInhalt=0
          For zz=0 To 47
            WriteCharacter(0, Byteinhalt)
          Next  
        Next 
      EndIf
      StopDrawing()
      CloseFile(0)  
      PrintN("fertig...")
    EndIf

    FlipBuffers() 

    Until Event = #PB_Event_CloseWindow   


End

Alles anzeigen

schneiderfan · 28. November 2009

BmpBild320x200

Muss heissen : BmpBild640x200

schneiderfan · 28. November 2009

Wer sich für das freie GFA32-Basic interessiert, hier ein Programm um ein Bmp-Bild mit 4Farben einlesen(bzw 3 und Hintergrund) für den CPC im Modus 1.
Die Farben sind Rot(rgb255,0,0), Grün(rgb0,255,0) und Gelb(rgb255,255,0). Man kann zum RGBPoint-testen auch andere Farben nehmen, weil man im CPC die 4 Farben frei bestimmen kann.

Mit dem GFA32-Basic programmier ich am liebsten und meisten. Mit Purebasic weniger.

Code

INIT
Do : Sleep : Until Me Is Nothing


Sub INIT
  Global Int Block, x, y, z, ByteInhalt, Byte_w, col, blue, green, red

  Form F0 = , , , 800, 600 : AutoRedraw = 1 : BackColor = colBtnFace
  Ocx Form F1 = , 10 , 10 , 320, 200 : .Appearance = 0 : .AutoRedraw = 1
  F1.PaintPicture LoadPicture("cpc320.bmp"), 0, 0


Sub Screen_KeyPreview(hwnd%, umsg%, wparam%, lparam%, cancel?)
  $StepOff

  Select wparam%

  Case "q"
    wandle_um
  EndSelect

  DoEvents

Sub wandle_um

  Set Me = F1
  Open "TEST.DAT" for Output As # 1

  For z = 0 To 127 : Out # 1, 0 : Next
  For Block = 0 To 7
    For y = 0 To 24
      For x = 0 To 319 Step 4
        ByteInhalt = 0
        For Byte_w = 0 To 3
          col = RGBPoint(x + Byte_w, y * 8 + Block)
          blue = GetBValue(col)
          green = GetGValue(col)
          red = GetRValue(col)

          If red = 255 And Byte_w = 0
            ByteInhalt = Bset(ByteInhalt, 7)
            ByteInhalt = Bclr(ByteInhalt, 3)
          EndIf
          If green = 255 And Byte_w = 0
            ByteInhalt = Bclr(ByteInhalt, 7)
            ByteInhalt = Bset(ByteInhalt, 3)
          EndIf
          If green = 255 And red = 255 And Byte_w = 0
            ByteInhalt = Bset(ByteInhalt, 7)
            ByteInhalt = Bset(ByteInhalt, 3)
          EndIf

          If red = 255 And Byte_w = 1
            ByteInhalt = Bset(ByteInhalt, 6)
            ByteInhalt = Bclr(ByteInhalt, 2)
          EndIf
          If green = 255 And Byte_w = 1
            ByteInhalt = Bclr(ByteInhalt, 6)
            ByteInhalt = Bset(ByteInhalt, 2)
          EndIf
          If green = 255 And red = 255 And Byte_w = 1
            ByteInhalt = Bset(ByteInhalt, 6)
            ByteInhalt = Bset(ByteInhalt, 2)
          EndIf

          If red = 255 And Byte_w = 2
            ByteInhalt = Bset(ByteInhalt, 5)
            ByteInhalt = Bclr(ByteInhalt, 1)
          EndIf
          If green = 255 And Byte_w = 2
            ByteInhalt = Bclr(ByteInhalt, 5)
            ByteInhalt = Bset(ByteInhalt, 1)
          EndIf
          If green = 255 And red = 255 And Byte_w = 2
            ByteInhalt = Bset(ByteInhalt, 5)
            ByteInhalt =  Bset(ByteInhalt, 1)
          EndIf

          If red = 255 And Byte_w = 3
            ByteInhalt = Bset(ByteInhalt, 4)
            ByteInhalt = Bclr(ByteInhalt, 0)
          EndIf
          If green = 255 And Byte_w = 3
            ByteInhalt = Bclr(ByteInhalt, 4)
            ByteInhalt = Bset(ByteInhalt, 0)
          EndIf
          If green = 255 And red = 255 And Byte_w = 3
            ByteInhalt = Bset(ByteInhalt, 4)
            ByteInhalt = Bset(ByteInhalt, 0)
          EndIf

        Next
        Out # 1, ByteInhalt
      Next
    Next
    For z = 0 To 47 : Out # 1, 0 : Next
  Next

  Set Me = F0
  Pset 10, 300
  Print "fertig"

Alles anzeigen