{~ Information on a binary star from Binaries.dbf ~}

unit binaries; {gives information on a chosen binary star}
               {from a dBase file - J.Hollan, '94}
(*  Copyright (C) 1999 Jan Hollan;
  by "program" this unit is further meant.

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)
interface
uses DbBridge,
     Un_Str_M {instead of Unit_Str by Blaise Computing, Inc.} ;

function get_bin(var Desig:string; var RA,Decl :real; var NoR:word):boolean;
                {Desig(nation) of the binary can be either
                       number in the Aitken's catalogue (ADS),
                 or a string (Name, up to [14]) with alphabetic beginning}
function read_bin(var Desig:string; var RA,Decl :real; var NoR:word):boolean;
              {same as above, but lets the file open}
{needs the main data     Binorbit.dbf }
const
Loc_bin_const = 'c:\d\j\d\stars\binaries;c:\d\binaries;c:\d\stars\binaries';
Loc_bin:string[100]=Loc_bin_const;


implementation
var
 j: integer;
ADSn: word;
Nfield,LD: byte;

function read_bin (var Desig:string; var RA,Decl :real; var NoR:word):boolean;

begin
read_bin:=false;
NoR:=1;
RA:=0;
Decl:=0;

If not DbInitSearch(Loc_bin,'binorbit.dbf') then
 begin
  writeln('Binorbit.dbf found nowhere in directories .\;',Loc_Bin,'!');
  exit
 end;

val(Desig,ADSn,j);
if j>0 then     {Name given}
 begin
  Nfield:=DbFieldNum('NAME');
  for j:=1 to length(Desig) do      {replacing _s with blanks}
   if Desig[j]='_' then Desig[j]:=' ';
  {if length(Desig)<14 then          expanding Desig to 14 characters
   for j:=length(Desig) to 13 do
    Desig:=Desig+' '}
 end
else            {ADS number given}
 begin
  Desig:=__JustStr(Desig,' ',5,_right_just_str);
  Nfield:=DbFieldNum('ADS')
 end;

LD:=length(Desig);
while DbRead(NoR,rec) do
 begin
   if Desig=copy(rec[Nfield],1,LD) then
    begin
     val(__CvtStr(rec[DbFieldNum('ALPHA')],_rem_lead_white_str),RA,j);
     val(__CvtStr(rec[DbFieldNum('DELTA')],_rem_lead_white_str),Decl,j);
     read_bin:=true;
     RA:=RA/1E3;
     Decl:=Decl/1E3;
     exit
    end
   else
   inc(NoR)
 end;
end;

function get_bin(var Desig:string; var RA,Decl :real; var NoR:word):boolean;
begin
 get_bin:=read_bin(Desig,Ra,Decl,NoR);
 DbClose;
end;

end.