frmcustom.pas

地税局发票程序源代码,自己开发的一个程序,最近整理资料的时候看到,放在那也是放着,拿出来供大家

unit FrmCustom;

interface

uses
  SysUtils, Controls, Windows, Messages,TlHelp32;

var
  HttpURL: string = 'http://www.yxds.gov.cn/tax/rj/'; //网页地址
//  HttpURL: string = 'http://194.1.1.1/tax/rj/'; //网页地址
//  MoneyCaStr: string = '十亿仟佰十万千百十元角分'; //金额标题
  MoneyCaStr: string = '十亿仟佰十万千百十元角分'; //金额标题
  CurrentFP: string; //处于当前的发票
  AppPath: string; //本程序路径
  DataPath: string; //数据库路径
  NowDate: TDate; //当前日期
  CurrenUser: String;  //当前用户
  IsAdmin: Boolean;    //
  function NtoC(n0: real): string;   //数据转换大小写

implementation

//把数字转为大写人民币

function NtoC(n0: real): string;
  function IIF(b: boolean; s1, s2: string): string;
  begin //本函数在VFP和VB中均为系统内部函数
    if b then IIF := s1 else IIF := s2;
  end;
const c = '零壹贰叁肆伍陆柒捌玖◇分角圆拾佰仟万拾佰仟亿拾佰仟万';
var L, i, n, code: integer;
  Z: boolean;
  s, st, st1: string;
begin
  s := FormatFloat('0.00', n0);
  L := Length(s);
  Z := n0 < 1;
  for i := 1 to L - 3 do
  begin
    Val(Copy(s, L - i - 2, 1), n, code);
    st := IIf((n = 0) and (Z or (i = 9) or (i = 5) or (i = 1)), '', Copy(c, n * 2 + 1, 2))
      + IIf((n = 0) and ((i <> 9) and (i <> 5) and (i <> 1) or Z and (i = 1)), '', Copy(c, (i + 13) * 2 - 1, 2))
      + st;
    Z := (n = 0);
  end;
  Z := False;
  for i := 1 to 2 do
  begin
    Val(Copy(s, L - i + 1, 1), n, code);
    st1 := IIf((n = 0) and ((i = 1) or (i = 2) and (Z or (n0 < 1))), '', Copy(c, n * 2 + 1, 2))
      + IIf((n > 0), Copy(c, (i + 11) * 2 - 1, 2), IIf((i = 2) or Z, '', '整'))
      + st1;
    Z := (n = 0);
  end;
  for i := 1 to Length(st) do if Copy(st, i, 4) = '亿万' then Delete(st, i + 2, 2);
  NtoC := IIf(n0 = 0, '零', st + st1);
end;

end.