Wetek Play & Programlama

[ekremkocak]

WeTek Play için pascal da ilk programımızı yazdık hadi hayırlısı...

[ozkaradag]

Harika bir haber bu.

Kutlarım.

Program derken, neler yaptınız?

Sevgiler...

[ekremkocak]

tşk. şu an sadece pascal da arm-linux için ilk ve geleneksel programlama olan "merhaba dünya.." ama asıl hedefim su dvb-s2 ye bi el atmak olacak...

[ekremkocak]

unit WetekScreen;

interface

uses
Windows, Messages, SysUtils, Variants,Classes, Graphics,Winsock,Dialogs;

const
A_CNXN =$4e584e43;
A_OKAY =$59414b4f;
A_CLSE =$45534c43;
A_WRTE =$45545257;
A_SYNC =$434e5953;
A_OPEN =$4e45504f;

MAX_PAYLOAD = 4096;
A_VERSION =$01000000;

ADB_VERSION_MAJOR =1;
ADB_VERSION_MINOR =0;
ADB_SERVER_VERSION =29;

// TSendMsg TRecvMsg
type
TCommand_Msg =record
command :dword; //* command identifier constant */
arg0 :dword; //* first argument */
arg1 :dword; //* second argument */
data_length :dword; //* length of payload (0 is allowed) */
data_crc32 :dword; //* crc32 of data payload */
magic :dword; //* command ^ 0xffffffff */
end;

type
TFbinfo =record
version:integer;
bpp:Integer;
size:Integer;
width:Integer;
height:Integer;
red_offset:Integer;
red_length:Integer;
blue_offset:Integer;
blue_length:Integer;
green_offset:Integer;
green_length:Integer;
alpha_offset:Integer;
alpha_length:Integer;
end;


type
TWetekScreen = class(TThread)
private
{ Private declarations }
FWSAData: TWSAData;
FSocket: TSocket;
Command_Msg:TCommand_Msg;
okay_Msg:TCommand_Msg;
Fbinfo:TFbinfo;
ScreenBuffer:Array of Byte;
function WriteBuffer(var Buffer; BufferSize: integer): integer;
function ReadBuffer(var Buffer; BufferSize: integer): integer;
function WriteMessage(commandWord;data:String):Integer;
public
constructor Create(Adress: string);
destructor Destroy; override;
procedure Lock;
procedure Unlock;
protected
procedure Execute; override;
end;

var
ThreadLock: TRTLCriticalSection;

implementation
Uses Unit1;


{ TWetekScreen }


function checksum(data:array of byte):Integer;
var
Ret,I,X:Integer;
begin
Ret := 0;
for i := 0 to length(data)-1 do begin
X := data[i];
if (X < 0) then Inc(X,256);
Inc(Ret,x);
end;
Result:= Ret;
end;


function TWetekScreen.WriteMessage(commandWord;data:String):Integer;
var
Msg:String;
SendMsg:TCommand_Msg;
buff:array of byte;
begin
Msg:=Format('%s::',[Data]);
Setlength(buff,length(Msg));
Move(Msg[1], buff[0], Length(Msg));
SendMsg.command:=command;
SendMsg.arg0 := A_VERSION;
SendMsg.arg1 := MAX_PAYLOAD;
SendMsg.data_length:=length(Msg);
SendMsg.data_crc32:=checksum(buff);
SendMsg.magic := SendMsg.command xor $ffffffff;
WriteBuffer(SendMsg,sizeof(TCommand_Msg));
WriteBuffer(Msg[1], Length(Msg));
end;


constructor TWetekScreen.Create(Adress: string);
var
SockAddr: TSockAddr;
buf:array[0..MAX_PAYLOAD] of byte;
begin
inherited Create(True);
FreeOnTerminate := True;
if WSAStartup($101, FWSAData) <> SOCKET_ERROR then
begin
FSocket := Socket(AF_INET, SOCK_STREAM, 0);
FillChar(SockAddr, SizeOf(TSockAddr), 0);
SockAddr.sin_family := AF_INET;
SockAddr.sin_port := htons(5555);
SockAddr.sin_addr.s_addr := inet_addr(PAnsiChar(Adress));
Connect(FSocket, SockAddr, SizeOf(TSockAddr));

WriteMessage(A_CNXN,'host');
ReadBuffer(Command_Msg,sizeof(TCommand_Msg));
ReadBuffer(buf[0],Command_Msg.data_length);
Form1.Memo1.Lines.Add(Format('Command_Msg %.4x',[Command_Msg.command]));
end;

end;

destructor TWetekScreen.Destroy;
begin
CloseSocket(FSocket);
WSACleanup;
inherited;
end;

function TWetekScreen.WriteBuffer(var Buffer; BufferSize: integer): integer;
begin
Result := send(FSocket, Buffer, BufferSize, 0);
end;


function TWetekScreen.ReadBuffer(var Buffer; BufferSize: integer): integer;
begin
Result := recv(FSocket, Buffer, BufferSize, 0);
end;

procedure TWetekScreen.Execute;
var
buf:array[0..MAX_PAYLOAD] of byte;
Count,Index,x,y,n,r:integer;
Bitmap: TBitmap;
begin

While (not Terminated) do
begin
Setlength(ScreenBuffer,0);
WriteMessage(A_OPEN,'framebuffer');

ReadBuffer(okay_Msg,sizeof(TCommand_Msg));
r:=okay_Msg.arg0;
okay_Msg.arg0:=okay_Msg.arg1;
okay_Msg.arg1:=r;
ReadBuffer(Command_Msg,sizeof(TCommand_Msg));
fillchar(fbinfo,sizeof(Tfbinfo),0);
ReadBuffer(fbinfo,sizeof(Tfbinfo));
WriteBuffer(okay_Msg,sizeof(TCommand_Msg));
Setlength(ScreenBuffer,fbinfo.size);
Index:=0;

Lock;
try

While (Command_Msg.command<>A_CLSE) do
begin
ReadBuffer(Command_Msg,sizeof(TCommand_Msg));
if (Command_Msg.command=A_CLSE) then
begin
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf32bit;
Bitmap.Width := fbinfo.width;
Bitmap.Height := fbinfo.height;
Count:=0;
with Bitmap do begin
for y := 0 to Height - 1 do
for x := 0 to Width- 1 do
begin
Count:=(y * Width + x)* (fbinfo.bpp div 8);
Bitmap.Canvas.Pixels[x,y]:=rgb(ScreenBuffer[Count] ,ScreenBuffer[Count+1] ,ScreenBuffer[Count+2]);
end;
end;
Form1.Image1.Picture.Bitmap := Bitmap;
Form1.Memo1.Lines.Add(Format('width = %d height = %d size = %d bpp %d',[fbinfo.width,fbinfo.height,fbinfo.size,fbinfo.bpp]));

finally
Bitmap.Free;
end;
Index:=0;
Break;
end
else
begin
if (Command_Msg.command=A_WRTE) then
begin
ReadBuffer(buf[0],Command_Msg.data_length);
move(buf[0],ScreenBuffer[Index],Command_Msg.data_length);
inc(Index,Command_Msg.data_length);
n:= WriteBuffer(okay_Msg,sizeof(TCommand_Msg));
if (n<0) then break;
end;
end;
end;

finally
Unlock;
end;

end;
end;


procedure TWetekScreen.Lock;
begin
EnterCriticalSection(ThreadLock);
end;

procedure TWetekScreen.Unlock;
begin
LeaveCriticalSection(ThreadLock);
end;


initialization
InitializeCriticalSection(ThreadLock);

finalization
DeleteCriticalSection(ThreadLock);

end.

[ekremkocak]

Delphi ciler için wetek ekran resmini alma codu
with TWetekScreen.Create('192.168.1.35') do
begin
Priority := tpHighest;
Resume;
end;