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
