1000分求翻译成delphi程序 巨牛进(300)

呵呵..这个问题还比较有意思,翻译我倒可以翻,只是怎么测试翻过来的程序是否正确呢?

来自：foyo2000, 时间：2009-5-9 13:25:30, ID：3957578呵呵..这个问题还比较有意思,翻译我倒可以翻,只是怎么测试翻过来的程序是否正确呢? //---------------------谢谢foyo2000, 留个QQ或者EMAIL好吗?或者加我QQ:55423726 email: 55423726@qq.com

{$I-}procedure ascii2bin(headName,dataName,outName:string;startjd,stopjd:real);var fp1, fp2, fp3:file;
begin
if (stopjd<startjd) then
{ showmessage('错误:终JD小于始JD;
exit;
end;
// print-->showmessage if fileexists(outName) then
if messagebox('TS','目标文件 '+outname+'已存在,是否覆盖?',mb_yesno)<>idyes) then
exit;
assignfile(fp1,headName);
assignfile(fp2,dataname);
assignfile(fp3,outname);
reset(fp1);
if ioresult<>0 then
begin
printf("错误: 无法打开header文件 "+ headName);
exit;
end;
reset(fp2);
if ioresult<>0 then
begin
printf("错误: 无法打开 data 文件 "+dataName);
close(fp1);
exit end;
rewrite(fp3);
if ioresult<>0 then
begin
printf("错误: 无法创建输出文件： "+outName );
close(fp1);
close(fp2);
exit;
end;
My GOD,太多了，呵呵，你还是把不懂的说明，我再翻译，不然太多了！

来自：wql, 时间：2009-5-13 9:03:28, ID：3958174{$I-}procedure ascii2bin(headName,dataName,outName:string;startjd,stopjd:real);var fp1, fp2, fp3:file;
begin
if (stopjd<startjd) then
{ showmessage('错误:终JD小于始JD;
exit;
end;
// print-->showmessage if fileexists(outName) then
if messagebox('TS','目标文件 '+outname+'已存在,是否覆盖?',mb_yesno)<>idyes) then
exit;
assignfile(fp1,headName);
assignfile(fp2,dataname);
assignfile(fp3,outname);
reset(fp1);
if ioresult<>0 then
begin
printf("错误: 无法打开header文件 "+ headName);
exit;
end;
reset(fp2);
if ioresult<>0 then
begin
printf("错误: 无法打开 data 文件 "+dataName);
close(fp1);
exit end;
rewrite(fp3);
if ioresult<>0 then
begin
printf("错误: 无法创建输出文件： "+outName );
close(fp1);
close(fp2);
exit;
end;
My GOD,太多了，呵呵，你还是把不懂的说明，我再翻译，不然太多了！ //----------------------------------------------老师老师 留下QQ或者加我 QQ55423726

。。。。。。。。。。。www.hellocpp.net中国人自己的codeproject资料库

兄弟，不用叫老师，把不懂的写出来，我在翻译，但是全部翻译，实在太多呢，呵呵！

楼主不要那么小气,还1000分.我看,该你出1000米了.

先把用到的数据结构转到 Delphi 后再翻译函数。数据结构是算法的基础，虽然为了某种算法，也会调整某种数据结构来适应算法。但在这里，显然下面的全部函数，都是基于这个既定的数据结构的，因此要先把数据结构转出来。这里的数据结构有一个DE_Header，里面主要是整数类型、双精度类型和字符类型的数组。由于整数类型是4字节，双精度类型是8字节，Delphi缺省会按照最大字节占用的类型对齐字节。为避免指针操作过程中语言特性导致的字节位置错误，所以要对这个数据结构转换后。加上packed的限定：type PDe_Header = ^TDe_Header;
TDe_Header = packed record // 文件头结构 nn : integer;
// 每个数据块含有切比雪夫(Chebyshev)系数的个数,它是ascii头文件中的NCOEFF ver : array[0..210]of Char;
// 星历表版本信息串 nCon : integer;
// 常数个数 cCon : array[0..299, 0..6] of Char;
// 常名称 vCon : array[0..299]ofdo
uble;
// 常数值 au :do
uble;
// 天文单位大小 km/1AU emrat :do
uble;
// 地月质量比 clight :do
uble;
// 光速, km/s DEver : integer;
// DE星历表版本号 LEver : integer;
// LE星历表版本号 JD1,JD2:do
uble;
// 始历元,终历元 Ta :do
uble;
// 每数据块对应的时间长度 P1 : array[0..12]of integer;
// 切比雪夫系数数组在文件中的位置索引辅助量(快速定位用的),详见结构图 P2 : array[0..12]of integer;
// 作用同上 P3 : array[0..12]of integer;
// 作用同上 end;
DE_Header = TDe_Header;供测试时参考。

来自：小雨哥, 时间：2009-6-5 14:55:18, ID：3962117先把用到的数据结构转到 Delphi 后再翻译函数。数据结构是算法的基础，虽然为了某种算法，也会调整某种数据结构来适应算法。但在这里，显然下面的全部函数，都是基于这个既定的数据结构的，因此要先把数据结构转出来。这里的数据结构有一个DE_Header，里面主要是整数类型、双精度类型和字符类型的数组。由于整数类型是4字节，双精度类型是8字节，Delphi缺省会按照最大字节占用的类型对齐字节。为避免指针操作过程中语言特性导致的字节位置错误，所以要对这个数据结构转换后。加上packed的限定：type PDe_Header = ^TDe_Header;
TDe_Header = packed record // 文件头结构 nn : integer;
// 每个数据块含有切比雪夫(Chebyshev)系数的个数,它是ascii头文件中的NCOEFF ver : array[0..210]of Char;
// 星历表版本信息串 nCon : integer;
// 常数个数 cCon : array[0..299, 0..6] of Char;
// 常名称 vCon : array[0..299]ofdo
uble;
// 常数值 au :do
uble;
// 天文单位大小 km/1AU emrat :do
uble;
// 地月质量比 clight :do
uble;
// 光速, km/s DEver : integer;
// DE星历表版本号 LEver : integer;
// LE星历表版本号 JD1,JD2:do
uble;
// 始历元,终历元 Ta :do
uble;
// 每数据块对应的时间长度 P1 : array[0..12]of integer;
// 切比雪夫系数数组在文件中的位置索引辅助量(快速定位用的),详见结构图 P2 : array[0..12]of integer;
// 作用同上 P3 : array[0..12]of integer;
// 作用同上 end;
DE_Header = TDe_Header;供测试时参考//---------------------------牛人显身, 讲解深入浅出, 谢谢! 感谢小雨哥老师指点!

我只完成了生成Bin文件这一部分，后面的计算天体部分就由搂主自己完成了。生成Bin文件的地方不一定是按照楼主的代码实现，说真的，这部分c代码写得不太好，对文件的操作用Delphi来做实在是事半功倍。如果要看效果，需要按楼主给的链接去那个网址下载代码里出现的文件unit DEUtils;interfaceuses Windows,Classes,SysUtils;type PDE_Header=^DE_Header;
DE_Header=packed record nn:integer;
ver:array[0..210] of char;
nCon:integer;
cCon:array[0..299,0..6] of char;
vCon:array[0..299] ofdo
uble;
au:double;
emrat:double;
clight:double;
DEver:integer;
LEver:integer;
JD1,JD2:double;
Ta:double;
p1:array[0..12] of integer;
p2:array[0..12] of integer;
p3:array[0..12] of integer;
end;
procedure d2e(pchar;n:integer=1000);//写二进制文件头procedure DE_wBinHeader(AStream:TStream;hE_Header);//读ascii头文件procedure DE_rAscHeader(var FP:Text;var hE_Header;
AStrings:TStrings);//写二进制数据块procedure DE_wBinBlock(AStream:TStream;nn:integer;rdouble);//按顺序读ascii数据块procedure DE_rAscBlock(var FP:Text;hE_Header;rdouble;
AStrings:TStrings);procedure Ascii2Bin(HeadName,DataName,OutName:string;
startJD,StopJDouble;AStrings:TStrings);implementationvar g_StrList:TStringList;procedure d2e(pchar;n:integer=1000);var i:integer;
begin
for i:=0 to n-1do
begin
if p=#0 then
break;
if (p='D') or (p='d') then
p:='e';
end;
end;
procedure SpliteStr(str:string;Delimiter:string=' ');
begin
g_StrList.Clear;
g_StrList.Delimiter:=Delimiter;
g_StrList.DelimitedText:=str;
end;
procedure gotoNextGroup(group:string;var FP:Text;
AStrings:TStrings);var s1:string;
begin
ReadLn(FP);
//读入空行 ReadLn(FP,s1);
if Copy(s1,1,12)<>group then
begin
AStrings.Add(Format('头文件有误:%s未找到.',[group]));
exit;
end;
ReadLn(FP);//读入空行end;
//写二进制文件头procedure DE_wBinHeader(AStream:TStream;hE_Header);
begin
AStream.Seek(0,0);
AStream.WriteBuffer(h,sizeof(h));
end;
//读ascii头文件procedure DE_rAscHeader(var FP:Text;var hE_Header;
AStrings:TStrings);var i,j:integer;
s1,s2:string;
begin
FillChar(h,sizeof(h),0);
ReadLn(FP,s1);
s2:=Copy(s1,7,6);
i:=StrToInt(s2);
s2:=Copy(s1,24,6);
h.nn:=StrToInt(s2);
if i-2*h.nn<>0 then
begin
AStrings.Add('header文件格式错误：KSIZE<>2*NCOEFF');
exit;
end;
gotoNextGroup('GROUP 1010',FP,AStrings);
s2:='';
ReadLn(Fp,s1);
s2:=s2+s1;
ReadLn(FP,s1);
s2:=s2+s1;
ReadLn(FP,s1);
s2:=s2+s1;
StrCopy(h.ver,PChar(s2));
if StrLComp(h.ver,'JPL',3)<>0 then
begin
AStrings.Add('错误：该文件不是JPL ASCII头文件');
exit;
end;
gotoNextGroup('GROUP 1030',FP,AStrings);
ReadLn(FP,s1);
s1:=trim(s1);
SpliteStr(s1);
if g_StrList.Count<>3 then
begin
AStrings.Add('读取 Group 1030资料错误');
exit;
end;
h.JD1:=StrToFloat(g_StrList.Strings[0]);
h.JD2:=StrToFloat(g_StrList.Strings[1]);
h.Ta:=StrToFloat(g_StrList.Strings[2]);
gotoNextGroup('GROUP 1040',FP,AStrings);
ReadLn(FP,s1);
h.nCon:=StrToInt(s1);
i:=0;
while i<h.nCondo
begin
ReadLn(FP,s1);
SpliteStr(s1);
for j:=0 to g_StrList.Count-1do
begin
StrLCopy(@h.cCon[0],PChar(g_StrList.Strings[j]),6);
inc(i);
end;
end;
gotoNextGroup('GROUP 1041', fp,AStrings);
ReadLn(FP,s1);
if StrToInt(s1)<>h.nCon then
begin
AStrings.Add('常数个数与常数值的个数不相等');
exit;
end;
i:=0;
while i<h.nCondo
begin
ReadLn(FP,s1);
SpliteStr(s1);
for j:=0 to g_StrList.Count-1do
begin
s2:=g_StrList.Strings[j];
d2e(PChar(s2));
h.vCon:=StrToFloat(s2);
inc(i);
end;
end;
gotoNextGroup('GROUP 1050', fp,AStrings);
ReadLn(FP,s1);
SpliteStr(s1);
if g_StrList.Count<>13 then
begin
AStrings.Add('P1数目不对');
exit;
end;
for j:=0 to g_StrList.Count-1do
h.p1[j]:=StrToInt(g_StrList.Strings[j]);
ReadLn(FP,s1);
SpliteStr(s1);
if g_StrList.Count<>13 then
begin
AStrings.Add('P2数目不对');
exit;
end;
for j:=0 to g_StrList.Count-1do
h.p2[j]:=StrToInt(g_StrList.Strings[j]);
ReadLn(FP,s1);
SpliteStr(s1);
if g_StrList.Count<>13 then
begin
AStrings.Add('P3数目不对');
exit;
end;
for j:=0 to g_StrList.Count-1do
h.p3[j]:=StrToInt(g_StrList.Strings[j]);
for i:=0 to h.nCon-1do
begin
if StrComp(h.cCon,'AU')=0 then
h.au:=h.vCon else
if StrComp(h.cCon,'EMRAT')=0 then
h.emrat:=h.vCon else
if StrComp(h.cCon,'DENUM')=0 then
h.DEver:=Trunc(h.vCon) else
if StrComp(h.cCon,'CLIGHT')=0 then
h.clight:=h.vCon else
if StrComp(h.cCon,'LENUM')=0 then
h.LEver:=Trunc(h.vCon);
end;
if h.LEver=0 then
h.LEver:=h.DEver;
end;
//写二进制数据块procedure DE_wBinBlock(AStream:TStream;nn:integer;rdouble);
begin
AStream.Seek(0,soFromEnd);
AStream.WriteBuffer(r^,nn*sizeof(Double));
end;
//按顺序读ascii数据块procedure DE_rAscBlock(var FP:Text;hE_Header;rdouble;
AStrings:TStrings);var s1,s2:string;
i,j:Integer;
begin
ReadLn(FP,s1);
SpliteStr(s1);
if g_StrList.Count<>2 then
begin
AStrings.Add('读取块号及系数个数错误');
exit;
end;
i:=StrToInt(g_StrList.Strings[1]);
if i<>h.nn then
begin
AStrings.Add('错误: ascii数据文件块系数与头文件块系数不同');
exit;
end;
i:=0;
while i<h.nndo
begin
ReadLn(FP,s1);
SpliteStr(s1);
for j:=0 to g_StrList.Count-1do
begin
if i=h.nn then
exit;
s2:=g_StrList.Strings[j];
d2e(PChar(s2));
pDouble(Integer(r)+i*sizeof(Double))^:=StrToFloat(s2);
inc(i);
end;
end;
end;
procedure Ascii2Bin(HeadName,DataName,OutName:string;
startJD,StopJDouble;AStrings:TStrings);const c_Info='提示';
c_MB_I=MB_OK+MB_ICONINFORMATION;
c_MB_Q=MB_YESNO+MB_ICONQUESTION;var F:TextFile;
hE_Header;
blockDouble;
i,n:Integer;
JDpouble;
fs:TFileStream;
MS:TMemoryStream;
begin
if StopJD<StartJD then
begin
MessageBox(0,'错误:终JD小于始JD',c_Info,c_MB_I);
exit;
end;
if FileExists(OutName) then
if MessageBox(0,PChar('目标文件已经存在，是否覆盖？'), c_Info,c_MB_Q)=IDNO then
exit;
if not FileExists(HeadName) then
begin
MessageBox(0,'无法打开Head文件',c_Info,c_MB_I);
exit;
end;
if not FileExists(DataName) then
begin
MessageBox(0,'无法打开Data文件',c_Info,c_MB_I);
exit;
end;
fs:=TFileStream.Create(OutName,fmCreate or fmOpenWrite);
try AssignFile(F,HeadName);
Reset(F);
DE_rAscHeader(F,H,AStrings);
CloseFile(F);
GetMem(block,h.nn*sizeof(Double));
try AssignFile(F,DataName);
Reset(F);
i:=1;
n:=0;
JDp:=0;
MS:=TMemoryStream.Create;
try while 1=1do
begin
if EOF(F) then
break;
DE_rAscBlock(F,h,block,AStrings);
if i mod 40=0 then
AStrings.Add(Format('扫描第%d块,已写入%d块.',[i,n+1]));
inc(i);
if PDouble(block)^>StopJD then
break;
if PDouble(Integer(block)+1*sizeof(Double))^<StartJD then
continue;
if n<>0 then
if JDp<>PDouble(Integer(block)+0)^ then
begin
if JDp-H.Ta=PDouble(Integer(block)+0)^ then
continue;
AStrings.Add(Format('错误:数据文件中相邻块(%d与%d块)的时间不连续'+ '(前JD%f 后JD%f),程序终止.', [n,n+1, JDp,PDouble(block)^]));
exit;
end;
DE_wBinBlock(MS,H.nn,block);
if n<>0 then
H.JD1:=PDouble(block)^;
JDp:=PDouble(Integer(block)+1*sizeof(Double))^;
H.JD2:=JDp;
inc;
end;
DE_wBinHeader(fs,h);
MS.Position:=0;
FS.WriteBuffer(MS.memory^,MS.Size);
finally MS.Free;
end;
CloseFile(F);
finally FreeMem(block);
end;
finally fs.Free;
end;
end;
initialization g_StrList:=TStringList.Create;finalization g_StrList.Free;
end.
//测试部分：uses DEUtils;{$R *.dfm}procedure TForm1.btnCreateBinFileClick(Sender: TObject);
begin
Memo1.Clear;
Ascii2Bin('header.405','ascp2000.405','Debug.405', 2400000,2500000,Memo1.Lines);
end;
procedure TForm1.btnReadBinFileClick(Sender: TObject);var fs:TFileStream;
hE_Header;
i,n:integer;
blockDouble;
s:string;
begin
fs:=TFileStream.Create('Debug.405',fmOpenRead);
try fs.ReadBuffer(h,sizeof(h));
n:=(fs.Size-sizeof(h)) div h.nn;
GetMem(block,n*sizeof(Double));
fs.ReadBuffer(block^,n*sizeof(double));
memo1.Clear;
for i:=0 to n-1do
begin
s:=s+Format('%f',[PDouble(Integer(block)+i*sizeof(Double))^])+' ';
if i mod 3=0 then
begin
memo1.Lines.Add(s);
s:='';
end;
end;
FreeMem(block);
finally fs.Free;
end;
end;

谢谢 wangdonghai老师! 请到另外2贴接分!http://www.delphibbs.com/delphibbs/dispq.asp?lid=3955498http://www.delphibbs.com/delphibbs/dispq.asp?lid=3955499特别感谢 小雨哥老师 wql老师 以及感谢所有关注本帖子的所有老师 因为有言在先 谁贴代码分数全部给谁 所以没给您们分了 有点遗憾之余特向您们致谢!感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢

接受答案了.

只完成了一部分，收了300分就够了

wangdonghai 老师还是把剩下的分都拿吧, 十分感谢!