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

Discussion in '请您翻译' started by 冰力不足, Aug 13, 2009.

  1. fo

    foyo2000 Member

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

    冰力不足 Member

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

    wql Member

    Apr 1, 2015
    {$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,太多了,呵呵,你还是把不懂的说明,我再翻译,不然太多了!
     
  4. 冰力不足

    冰力不足 Member

    Apr 1, 2015
    来自: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
     
  5. he

    hendriclee Member

    Apr 1, 2015
    。。。。。。。。。。。www.hellocpp.net中国人自己的codeproject资料库
     
  6. wq

    wql Member

    Apr 1, 2015
    兄弟,不用叫老师,把不懂的写出来,我在翻译,但是全部翻译,实在太多呢,呵呵!
     
  7. aK

    aKnightChen Member

    Apr 1, 2015
    楼主不要那么小气,还1000分.我看,该你出1000米了.
     
  8. 小雨哥

    小雨哥 Member

    Apr 1, 2015
    先把用到的数据结构转到 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;供测试时参考。
     
  9. 冰力不足

    冰力不足 Member

    Apr 1, 2015
    来自:小雨哥, 时间: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;供测试时参考//---------------------------牛人显身, 讲解深入浅出, 谢谢! 感谢小雨哥老师指点!
     
  10. wa

    wangdonghai Member

    Apr 1, 2015
    我只完成了生成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(p:pchar;n:integer=1000);//写二进制文件头procedure DE_wBinHeader(AStream:TStream;h:DE_Header);//读ascii头文件procedure DE_rAscHeader(var FP:Text;var h:DE_Header;
    AStrings:TStrings);//写二进制数据块procedure DE_wBinBlock(AStream:TStream;nn:integer;r:pdouble);//按顺序读ascii数据块procedure DE_rAscBlock(var FP:Text;h:DE_Header;r:pdouble;
    AStrings:TStrings);procedure Ascii2Bin(HeadName,DataName,OutName:string;
    startJD,StopJD:Double;AStrings:TStrings);implementationvar g_StrList:TStringList;procedure d2e(p: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;h:DE_Header);
    begin
    AStream.Seek(0,0);
    AStream.WriteBuffer(h,sizeof(h));
    end;
    //读ascii头文件procedure DE_rAscHeader(var FP:Text;var h:DE_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;r:pdouble);
    begin
    AStream.Seek(0,soFromEnd);
    AStream.WriteBuffer(r^,nn*sizeof(Double));
    end;
    //按顺序读ascii数据块procedure DE_rAscBlock(var FP:Text;h:DE_Header;r:pdouble;
    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,StopJD:Double;AStrings:TStrings);const c_Info='提示';
    c_MB_I=MB_OK+MB_ICONINFORMATION;
    c_MB_Q=MB_YESNO+MB_ICONQUESTION;var F:TextFile;
    h:DE_Header;
    block:pDouble;
    i,n:Integer;
    JDp:Double;
    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(n);
    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;
    h:DE_Header;
    i,n:integer;
    block:pDouble;
    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;
     
  11. 冰力不足

    冰力不足 Member

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

    冰力不足 Member

    Apr 1, 2015
  13. wa

    wangdonghai Member

    Apr 1, 2015
    只完成了一部分,收了300分就够了
     
  14. 冰力不足

    冰力不足 Member

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