ucommfunc.pas

中式财务栏 表格式录入 运行时设置可显示列、列名、列宽

  answer := inttostr(10 - (strtoint(answer) mod 10));  //计算校验码
  result := t_str + copy(answer, 1, 1);
end;

function GetPy(const AHzStr: string): string;
const
  ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 2077),
    (2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000),
    (2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729),
    (3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 0000),
    (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589));
var
  i, j, HzOrd: Integer;
begin
  Result:='';
  i := 1;
  while i <= Length(AHzStr) do
  begin
    if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then
    begin
      HzOrd := (Ord(AHzStr[i]) - 160) * 100 + Ord(AHzStr[i + 1]) - 160;
      for j := 0 to 25 do
      begin
        if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then
        begin
          Result := Result + Char(Byte('A') + j);
          Break;
        end;
      end;
      Inc(i);
    end else Result := Result + AHzStr[i];
    Inc(i);
  end;
end;

function RoundEx (const Value: Double): integer;
var
  x: Real;
begin
  x := Value - Trunc(Value);
  if x >= 0.5 then
    Result := Trunc(Value) + 1
  else Result := Trunc(Value);
end;
    
function RMB(AMoney: Double): String;
const s1: String = '零壹贰叁肆伍陆柒捌玖'; s2: String = '分角元拾佰仟万拾佰仟亿拾佰仟万';
var s, dx: String; i, Len: Integer;
function StrTran(const S, S1, S2: String): String; begin Result := StringReplace(S, S1, S2, [rfReplaceAll]); end;
begin
  if AMoney < 0 then begin dx := '负'; AMoney := -amoney; end;
  s := Format('%.0f', [AMoney]); Len := Length(s);
  for i := 1 to Len do dx := dx + Copy(s1, (Ord(s[i]) - Ord('0'))*2 + 1, 2) + Copy(s2, (Len - i)*2 + 1, 2);
  dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零仟', '零'), '零佰', '零'), '零拾', '零'), '零角', '零'), '零分', '整');
  dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零零', '零'), '零零', '零'), '零亿', '亿'), '零万', '万'), '零元', '元');
  if dx = '整' then Result := '零元整' else Result := StrTran(StrTran(StrTran(dx, '亿万', '亿零'), '零整', '整'), '零零', '零');
end;  

//==============================================================================
// if mark=0 then Tform.show else Tform.showmodal
//==============================================================================

procedure OpenChildForm(FormClass:TFormClass;var Form:TForm;Mark:Integer=0);
begin
  if Mark=0 then
  begin
    if not Assigned(form) then
      Application.CreateForm(FormClass,Form);
    if Form.WindowState=wsminimized then
      Form.WindowState:=wsNormal;
  end else
  begin
    form:=FormClass.Create(nil);
    try
      Form.ShowModal;
    finally
      Form.Free;
    end;
  end;
end;

function ReadIniFile(const FileName, Section, Ident: string;
  Default: integer): integer;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadInteger(Section,Ident,Default);
  FreeAndNil(myIniFile);
end;

function ReadIniFile(const FileName, Section, Ident: string;
  Default: string): string;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadString(Section,Ident,Default);
  FreeAndNil(myIniFile);
end;

function ReadIniFile(const FileName, Section, Ident: string;
  Default: Boolean): Boolean;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadBool(Section,Ident,Default);
  FreeAndNil(myIniFile);
end;

function ReadIniFile(const FileName, Section, Ident: string;
  Default: Double): Double;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadFloat(Section,Ident,Default);
  FreeAndNil(myIniFile);
end;

function ReadIniFile(const FileName, Section, Ident: string;
  Default: TdateTime): TdateTime;
begin
  myIniFile:=TiniFile.Create(FileName);
  result:=myIniFile.ReadDateTime(Section,Ident,Default);
  FreeAndNil(myIniFile);
end;

procedure WriteIniFile(const FileName, Section, Ident: string;
  Value: integer);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteInteger(Section,Ident,Value);
  FreeAndNil(myIniFile);
end;

procedure WriteIniFile(const FileName, Section, Ident: string;
  Value: string);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteString(Section,Ident,Value);
  FreeAndNil(myIniFile);
end;

procedure WriteIniFile(const FileName, Section, Ident: string;
  Value: Boolean);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteBool(Section,Ident,Value);
  FreeAndNil(myIniFile);
end;

procedure WriteIniFile(const FileName, Section, Ident: string;
  Value: Double);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteFloat(Section,Ident,Value);
  FreeAndNil(myIniFile);
end;

procedure WriteIniFile(const FileName, Section, Ident: string;
  Value: TdateTime);
begin
  myIniFile:=TiniFile.Create(FileName);
  myIniFile.WriteDateTime(Section,Ident,Value);
  FreeAndNil(myIniFile);
end;

{ 格式：2007-01-01 }
function GetCurDate: string;
begin
  Result:=getyear(Date)+'-'+strtostrex(getmonth(Date),'front',2)+
    '-'+strtostrex(getday(Date),'front',2);
end;

procedure CheckDate(aDate: string);
begin
  try
    StrToDate(aDate);
  except
    Application.MessageBox('不正确的日期格式',
      '错误', MB_OK + MB_ICONSTOP);
    Exit;
  end;
  if Length(aDate) <> 10 then
  begin
    Application.MessageBox('不正确的日期格式',
      '错误', MB_OK + MB_ICONSTOP);
  end;
end;


//==============================================================================
// 返回特定子串在字符串中的位置
//==============================================================================

function FindStr(ShortStr, LongStrIng: String): Integer;
var
  locality: integer;
begin
   locality := Pos(ShortStr, LongStrIng);  
   if locality = 0 then Result := 0 else Result := locality;
end;

//==============================================================================
// 扩展字符串转字符串函数(默认填充'0')
// Example1: temps2 := StrToStrEx(temps2, 'back', 2); //不足两位的后面补0
// Example2: temps1 := StrToStrEx(temps1, 'front', 4);//不足四位的前面补0
//==============================================================================

function StrToStrEx(Value: string; strflag: string;
  Len: Integer; FillChar: Char = '0'): string;
begin
  result := Value;
  while Length(result) < Len do
  begin
    if strflag = 'front' then
      result := FillChar + Result;
    if strflag = 'back' then
      result := result + fillchar;
  end;
end;

function GetYear(Date: TDate): string;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := IntToStr(y);
end;

function GetMonth(Date: TDate): string;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := IntToStr(m);
end;

function GetDay(ADate: TDate): string;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := IntToStr(d);
end;

function GetAppPath: string;
begin
  Result := ExtractFilePath(Application.ExeName);
end;

function GetINIFile:string;
begin
  Result:=GetAppPath+'db.ini';
end;

function GetMDB:string;
begin
  Result:=GetAppPath+'tmpgrp.mdb';
end;

//==============================================================================
// 不输入任何查询条件即是查询所有
// 遇到数据量大的时候，会让用户等很长时间
// 因此在查询所有的前面友好地提示用户是有必要的
//==============================================================================

procedure IsSelAll(aStr: string);
begin
  if aStr='' then
    if Application.MessageBox('查询所有将花费较长时间，确认继续','询问',
      MB_YESNOCANCEL + MB_ICONQUESTION) <> IDYES then Abort;
end;

end.