rdcode گفت:سلام
آيا كسي مي دونه از چه سايتي ميشه فايلهاي pcd تهيه كرد؟
Procedure YCbCr2RGB(Y,Cb,Cr:integer; Var r,g,b:integer);
Const C=256;
c11:real= 0.0054980*C;
c12:real= 0.0000000*C;
c13:real= 0.0051681*C;
c21:real= 0.0054980*C;
c22:real=-0.0015446*C;
c23:real=-0.0026325*C;
c31:real= 0.0054980*C;
c32:real= 0.0079533*C;
c33:real= 0.0000000*C;
Begin
r:=round(c11*Y +c12*(Cb-156) +c13*(Cr-137));
g:=round(c21*Y +c22*(Cb-156) +c23*(Cr-137));
b:=round(c31*Y +c32*(Cb-156) +c33*(Cr-137));
If r<0 Then r:=0;
If g<0 Then g:=0;
If b<0 Then b:=0;
If r>255 Then r:=255;
If g>255 Then g:=255;
If b>255 Then b:=255;
End;
Procedure LoadPCD(FileName:string);
Type buf=Array[0..MaxLineLen-1] Of byte;
buf3=Array[0..3*MaxLineLen-1] Of byte;
Var ofs:longint;
infile:file;
y,x,xx:word;
Y1,Y2,CbCr:buf;
Line:buf3;
r,g,b:integer;
Function VerticalOrientation:boolean;
Var buf:Array[0..127] Of byte;
Begin
reset(invoer,1);
BlockRead(invoer,buf,128);
VerticalOrientation:=(buf[72] And 63)<>8;
End;
Begin
assign(infile,FileName);
reset(infile,1);
bpp:=24;
Case PCDsize Of
1: Begin
W:=192;
H:=128;
seek(invoer,$2000);
End;
2: Begin
W:=384;
H:=256;
seek(invoer,$B800);
End;
3: Begin
W:=768;
H:=512;
seek(invoer,$30000);
End;
End;
ofs:=0;
For y:=0 To (h Div 2)-1 Do
Begin
BlockRead(infile,Y1,w);
BlockRead(infile,Y2,w);
BlockRead(infile,CbCr,w);
xx:=0;
For x:=0 To w-1 Do
Begin
YCbCr2RGB(Y1[x],CbCr[x Div 2],CbCr[(w Div 2)+(x Div 2)],r,g,b);
Line[xx]:=b;
Line[xx+1]:=g;
Line[xx+2]:=r;
inc(xx,3);
End;
{ save your line here ! }
inc(ofs,w*3);
xx:=0;
For x:=0 To w-1 Do
Begin
YCbCr2RGB(Y2[x],CbCr[x Div 2],CbCr[(w Div 2)+(x Div 2)],r,g,b);
Line[xx]:=b;
Line[xx+1]:=g;
Line[xx+2]:=r;
inc(xx,3);
End;
{ save your line here ! }
inc(ofs,w*3);
End;
close(infile);
End;
End;