ResizeImage nach GrabDrawingImage

[wiesschalt]

Hallo zusammen,

ich möchte eine Bildschirmausgabe an einen Client übertragen.
Dabei wird mit GrabDrawingImage das Bilder erstellt, danach soll es verkleinert werden und in den Buffer, um es zu versenden.

Leider ist ResizeImage immer null. Ich habe auch schon versucht, den Teil ab "If OutImageID" nach StopDrawing aufzurufen. Selbes Ergebnis.

Wo liegt hier der Fehler?

Code: Alles auswählen

Procedure GetOutCalling()
  If *OutImgPuf > 0
    FreeMemory(*OutImgPuf)
  EndIf
  OutImageID = GrabDrawingImage(#PB_Any, 0, 0, ScreenWidth(), ScreenHeight())
  If OutImageID
    Delay(50)
    Debug  "Resize: "+Str(ResizeImage(OutImageID,  490, 276,  #PB_Image_Raw))
    Delay(1)
    *OutImgPuf = EncodeImage(OutImageID, #PB_ImagePlugin_JPEG, 1, 4)
    FreeImage(OutImageID)
  EndIf  
EndProcedure

[dige]

Hast du bspw. mit ShowLibraryViewer() geprüft, ob denn korrekt ein Bild gegrabt wurde?

[wiesschalt]

ft, ob denn korrekt ein Bild gegrabt wurde?

Naja, also das Bild wird erstellt und auch versendet. Leider davor nicht verkleinert. Es ist also ausschließlich ein ResizeImage() Problem.

[Kiffi]

Es ist schwierig, anhand dieses Codefragmentes herauszufinden, wo der Fehler liegt. Es wäre von Vorteil, wenn Du ausführbaren Code zur Verfügung stellen könntest, mit dem man das Problem nachvollziehen kann.

Auch wenn es Dein Problem vielleicht nicht löst, hier zwei Hinweise:

Es ist im Allgemeinen keine gute Idee, den Rückgabewert eines Befehls direkt mit Debug auszugeben, da der Befehl nicht ausgeführt wird, wenn der Code zu einem Executable kompiliert wird.

Also anstelle von:

Code: Alles auswählen

Debug  "Resize: "+Str(ResizeImage(OutImageID,  490, 276,  #PB_Image_Raw))

lieber so:

Code: Alles auswählen

ResizeImageResult = ResizeImage(OutImageID,  490, 276,  #PB_Image_Raw)
Debug  "ResizeImageResult: " + Str(ResizeImageResult)

Des weiteren solltest Du immer EnableExplicit verwenden.

It can help to catch typo bugs.

[dige]

Falls es einen Speicherüberlauf gibt, verwende ich zum debuggen gern: PurifierGranularity(1, 1, 1, 1)
um nach jeder Code-Zeile einen Check zu haben..

[wiesschalt]

Hier ist der Code. Es scheint alles korrekt zu sein. Mir ist nicht klar wieso Resize nicht funktioniert.

Code: Alles auswählen

Global ServPort = 5008
Global   *Buffer = AllocateMemory(1024)
Global  *OutImgPuf
Global ServerThreadID, PKILL, ServID
Global BlackImageID, LogoID, OutImageID, FlipImage
Global F_BigText, F_VBigText
Global RECInStr$

UseJPEGImageDecoder()
UseJPEGImageEncoder()

Procedure WriteTOService(TEXT$, OPTION=0)
  If  PROG_OPSERVICE_LEVEL > 0 And SERVICEFileID > 0
    WriteStringN(SERVICEFileID, FormatDate("%dd.%mm.%yyyy %hh:%ii:%ss", Date())+" :: "+TEXT$)
  EndIf
  
EndProcedure
  
Procedure Fail(TEXT$, OPTION=0)
  Debug TEXT$
  MessageRequester(PROGNAME$+" Error", TEXT$, #PB_MessageRequester_Error)
EndProcedure

Procedure GetOutCalling()
  PurifierGranularity(1, 1, 1, 1)
  If *OutImgPuf > 0
    FreeMemory(*OutImgPuf)
  EndIf
  OutImageID = GrabDrawingImage(#PB_Any, 0, 0, ScreenWidth(), ScreenHeight())
  If OutImageID
    Delay(50)
    ShowLibraryViewer("Image", OutImageID)
    ResizeImageResult = ResizeImage(OutImageID,  490, 276,  #PB_Image_Raw)
    Debug  "ResizeImageResult: " + Str(ResizeImageResult)    
    Delay(1)
    *OutImgPuf = EncodeImage(OutImageID, #PB_ImagePlugin_JPEG, 1, 4)
    FreeImage(OutImageID)
  EndIf  
EndProcedure

Procedure WriteOnScreen(TEXT$, STATE, COLORHEX$, OPTION=0)
  If Fenster = #False
    ;WriteOnScreen(Display$, 1, ColorHex$)
    If StartDrawing(ScreenOutput()) 
      Select STATE
        Case 1 ;-WOS_Simple Text center
          If IsImage(BlackImageID)
            DrawImage(ImageID(BlackImageID),  0, 0, 1920, 1080)
          EndIf
          DrawingFont(FontID(F_VBigText))
          DrawingMode(#PB_2DDrawing_Transparent)
          ;           If ScreenTextcheck(TEXT$, TextWidth(TEXT$), TextHeight(TEXT$), ScreenWidth(), ScreenHeight()) = 0
          ;             Repeat
          ;               
          ;               Delay(1)
          ;             Until ScreenTextcheck(TEXT$, TextWidth(TEXT$), TextHeight(TEXT$), ScreenWidth(), ScreenHeight()
          ;           EndIf
          breite = (ScreenWidth()/2)-(TextWidth(TEXT$)/2)
          hoehe = (ScreenHeight()/2)-(TextHeight(TEXT$)/2)
          DrawText(breite, hoehe, TEXT$, RGB(255,255,255))
          
      EndSelect
      If IsImage(FlipImage)
        FreeImage(FlipImage)
      EndIf
      FlipImage = GrabDrawingImage(#PB_Any, 0, 0, ScreenWidth(), ScreenHeight())
      GetOutCalling()
      StopDrawing()
      
    Else
      fail("Cant on screen!")
    EndIf
    FlipBuffers()
  EndIf
EndProcedure

Procedure ImageOnScreen(ImagePICId, PosBreite=0, PosHoehe=0, OPTION=0)
  If StartDrawing(ScreenOutput()) 
    If IsImage(ImagePICId)
      If OPTION = 1 ;Vollbild
        DrawImage(ImageID(ImagePICId),  PosBreite, PosHoehe, ScreenWidth(), ScreenHeight())
      Else
        DrawImage(ImageID(ImagePICId),  PosBreite, PosHoehe)
      EndIf
    EndIf
    If IsImage(FlipImage)
      FreeImage(FlipImage)
    EndIf
    FlipImage = GrabDrawingImage(#PB_Any, 0, 0, ScreenWidth(), ScreenHeight())
    GetOutCalling()
    StopDrawing()
    FlipBuffers()
  EndIf
EndProcedure

Procedure.i InitNetworkServer()
  ID = CreateNetworkServer(#PB_Any, ServPort, #PB_Network_IPv4 | #PB_Network_TCP)
  If ID
    ProcedureReturn ID
  Else
    Fail("Can't create server on port "+Str(ServPort)+"!")
    End
  EndIf
EndProcedure

Procedure ExitNetworkServer(ServID)
  CloseNetworkServer(ServID)
EndProcedure

Procedure SetTextOut(Display$, ColorHex$="FEFEFE", OPTION=0)
  If Fenster = #True
;---
  Else
    Display$ = ReplaceString(Display$, "\n", Chr(10), #PB_String_CaseSensitive)
    WriteOnScreen(Display$, 1, ColorHex$)
  EndIf
  
EndProcedure

Procedure SetPictureOut(ImagePICId, PosBreite=0, PosHoehe=0, OPTION=0)
  If Fenster = #True
    
  Else
    ImageOnScreen(ImagePICId, PosBreite, PosHoehe, OPTION)
  EndIf
EndProcedure

Procedure.i ServerReceive(ConnID, timeout=200)
  Bytes = 0
  TMPSTR$ = ""
      Bytes = ReceiveNetworkData(ConnID, *Buffer, 1022)
      For x=0 To Bytes
        Char.a = PeekA(*Buffer+x)
        If PROG_OPSERVICE_LEVEL > 2
          WriteTOService("RECEIVE # CHAR: "+Str(Char))
        EndIf
        TMPSTR$ = TMPSTR$ + Chr(Char.a)
        If Char.a = 13
          If PROG_OPSERVICE_LEVEL > 1
            WriteTOService("RECEIVE # STRING: "+TMPSTR$)
          EndIf
          RECInStr$ = TMPSTR$
          TMPSTR$ = ""
          Break
        EndIf
      Next
  ProcedureReturn Bytes
EndProcedure

Procedure ServerSend(ClientID, OutStr$)
  SendBytes = 0
  *SendBuf = AllocateMemory(200)
  If PROG_OPSERVICE_LEVEL > 1
    WriteTOService("SEND # STRING: "+OutStr$)
  EndIf
  PokeS(*SendBuf, OutStr$+Chr(10)+Chr(13), -1, #PB_Ascii)
  SendBytes = SendNetworkData(ClientID, *SendBuf, MemoryStringLength(*SendBuf, #PB_Ascii))
  FreeMemory(*SendBuf)
  ProcedureReturn  SendBytes
EndProcedure

Procedure.i ServerSETCMD(ConnID, Bytes)
  InStr$ = ""
      InStr$ = RECInStr$
      ClientID = ConnID
      If InStr$ <> ""
        CMD = Val(StringField(InStr$, 1, "#"))
        Select CMD
          Case 1 ;PING
            ServerSend(ClientID, "1#PING") ; OutStr$)
            
          Case 2 ;TEXT OUT - 2#0#"This is a Text!"
            OPTION = Val(StringField(InStr$, 2, "#"))
            TEXT$ = StringField(InStr$, 3, "#")
            TEXT$ = Mid(TEXT$, 2, Len(TEXT$)-3)
            ColorHex$ = "0"
            SetTextOut(TEXT$, ColorHex$, OPTION)
            ProcedureReturn #True
            
          Case 200 ;Set Screen in Media Pictures - 200#0 (MainLogo) or 200#1 (Medias......
            OPTION = Val(StringField(InStr$, 2, "#"))
            ALIGN = Val(StringField(InStr$, 3, "#")) ;1 - scal on fullscreen, 2 - on screen center
            If OPTION = 0
              Debug "LOGO"
              SetPictureOut(LogoID, 0, 0, ALIGN)
            Else
              Posbreite = Val(StringField(InStr$, 4, "#"))
              Poshoehe = Val(StringField(InStr$, 5, "#"))
              ;ImageOnScreen(ImagePICId, PosBreite=0, PosHoehe=0, OPTION=0)
            EndIf
            
          Case 254 ;Send current output-display: 254#1
                   ;Ablauf: Controller sendet #1, Server antwortet mit #2#SIZE wenn senden
                   ; bereit ist. Client sendet #3 zum Empfangen und Server sendet.
            OPTION = Val(StringField(InStr$, 2, "#"))
            Select OPTION
              Case 1
                Debug "Call Pic..."
                Debug *OutImgPuf
                If *OutImgPuf
                  ServerSend(ClientID, "254#2#"+Str(MemorySize(*OutImgPuf))) ; OutStr$)
                 Debug "Memory Size: "+Str(MemorySize(*OutImgPuf)) 
                  Delay(1)
                Else
                  ServerSend(ClientID, "254#0") ; OutStr$)
                EndIf
                
              Case 3
                Debug "Ready to send..."
                 Debug *OutImgPuf
                  If *OutImgPuf > 0
                    Debug "Memory Size: "+Str(MemorySize(*OutImgPuf)) 
                    SendNetworkData(ClientID, *OutImgPuf, MemorySize(*OutImgPuf))
                    Delay(1)
                    Debug "SEND OK"
                   ; FreeMemory(*OutImgPuf)
                  Else
                    ServerSend(ClientID, "254#0") ; OutStr$)
                  EndIf
                  
              Default
                ServerSend(ClientID, "0#INCORRECT-CMD!") ; OutStr$)
            EndSelect
            OPTION = 0
            
          Case 255 ;Action : KILL - 255#1
            OPTION = Val(StringField(InStr$, 2, "#"))
            If OPTION = 1
              ProcedureReturn -1
            Else
               ServerSend(ClientID, "0#INCORRECT-CMD!") ; OutStr$)
            EndIf
            
          Default
            ServerSend(ClientID, "0#INCORRECT-CMD!") ; OutStr$)
        EndSelect
      EndIf
    InStr$ = ""
    RECInStr$ = ""

  EndProcedure
  
  Procedure ServerTheard(ConnID)
  Repeat
    ServEvent = NetworkServerEvent(ConnID)
    CID = EventClient()
    Select ServEvent
      Case #PB_NetworkEvent_Data
        TEMPBYT = ServerReceive(CID)
        If TEMPBYT = 0
          Fail("Error to receive client data")
        Else
          ServRec = ServerSETCMD(CID, TEMPBYT) 
          If ServRec > 0
            ServerSend(CID, "OK"+Chr(10)+Chr(13))
          Else
            Select ServRec
              Case -1
                ServerSend(CID, "KILL"+Chr(10)+Chr(13))
                Delay(200)
                Term = #True
                PKILL = 1
            EndSelect
          EndIf
        EndIf
    EndSelect
  Until Term
  
EndProcedure

 ;-2D Screen
  If InitSprite() = 0 Or InitKeyboard() = 0
    Fail("Sprite system can't be initialized")
    End
  EndIf
  If OpenScreen(1920, 1080, 32, PROGNAME$) 
    UseJPEGImageDecoder()
    LogoID = CatchImage(#PB_Any, ?LogoWithBG)
    F_BigText = LoadFont(#PB_Any, "Arial", 52)
    F_VBigText=LoadFont(#PB_Any, "Arial", 102)
    
    BlackImageID = CreateImage(#PB_Any , 1920, 1080, 32, RGB(0,0,0))
    If BlackImageID = 0
      Fail("Error, not blank image")
    EndIf
    ServID = InitNetworkServer()
    
    
    ScreenOutID = ScreenOutput()
    If StartDrawing(ScreenOutID) 
      If  LogoID
        DrawImage(ImageID(LogoID), 0, 0, 1920, 1080)  
      Else
        ;DrawingFont(FontID(F_VBigText))
        DrawingMode(#PB_2DDrawing_Transparent)
        DrawText(5, 5, "Error: Can't load Logo!", RGB(255,255,255))
      EndIf
      StopDrawing()
    EndIf
    FlipBuffers()
    
    
    x=0
    Repeat ;->> Screen >> REPEAT LOOP
      Delay(1)
      ServerTheard(ServID)
      
      

      ;ExamineKeyboard()    
    
    Until PKILL; Or KeyboardPushed(#PB_Key_Escape) 
    ExitNetworkServer(ServID)
  Else
    MessageRequester("Error", "Can't open a 1.920 x 1.080 (FullHD) - 32 bit screen !", 0)
  EndIf


End
  
    DataSection
    LogoWithBG:
      IncludeBinary "logo_back.jpg"
    EndDataSection
    

[Bisonte]

Davon abgesehen, dass uns noch der Client fehlt...

Du startest in einer Dauerschleife OHNE Ausgang einen Thread, der eine Serverkommunikation abarbeiten soll....
Das Programm schmiert natürlich innerhalb von wenigen Sekunden ab.
Ganz zu schweigen davon, dass dort nie wirklich was angezeigt wird... wo du die Debug Ausgaben hernimmst, ist mir ein Rätsel...

Mit welchem Betriebssystem soll das laufen ?

Gegenvorschlag :

Erst ein funktionierendes Programm erstellen, dass ein Bild auf einen Screen (am besten einen WindowedScreen) zeichnet,
mit Abbruchmöglichkeit (z.B. Escape).

Danach kann man sich immer noch um die "Server" Geschichte kümmern.

und... nebenbei bemerkt : Nutze EnableExplicit

[wiesschalt]

Danke für den Post. Aber bei mir unter Ubuntu läuft der Server. Der Theard wird nur erstellt, weil es ursprünglich ein Window APP war. Nun kann der Modus umgeschaltet werden. -Also in einer anderen Version-

Der "Theard ist im Screen Modus nur eine Procedure. Sie wird bei einem Killbefehl verlassen. Das Programm zeigt normalerweise direkt ein Logo an.

[HeX0R]

das heißt übrigens Thread

[wiesschalt]

das heißt übrigens Thread

mein ich doch...