unit_common.pas

航空人身保险信息管理系统使用SQL和DELHPI开发

function VehicleNoEngToChn(VehicleNoEng: string): string;
var
  i, VehicleNolength: integer;
begin
   VehicleNoEng:=Trim(VehicleNoEng);
  VehicleNolength := length(VehicleNoEng);
   //  农机车

  if (COPY(VehicleNoEng, 1, 2) = '发') or (COPY(VehicleNoEng, 1, 2) = '架') then
  begin
    result := vehiclenoeng;
    EXIT;
  end;

  if (LOWERCASE(VehicleNoEng[VehicleNolength]) = 'd') and
    (VehicleNolength > 10) then
  begin
    result := copy(vehiclenoeng, 1, 2) + 'NJ' + copy(vehiclenoeng, 5, 2) + '.' + copy(vehiclenoeng, 7, 5);

  end
  else //非农机车
  begin
    result := copy(vehiclenoeng, 1, 2) + VehicleNoEng[3] + '.';
    for i := 4 to VehicleNolength - 2 do
    begin
      result := result + VehicleNoEng[i];
    end;
    if (copy(VehicleNoEng, (VehicleNolength - 1), 2) = '警') or
      (copy(VehicleNoEng, (VehicleNolength - 1), 2) = '挂') or
      (copy(VehicleNoEng, (VehicleNolength - 1), 2) = '临') then
      result := result + copy(VehicleNoEng, (VehicleNolength - 1), 2)
    else if IsNumeric(VehicleNoEng[VehicleNolength]) then
      result := result + VehicleNoEng[VehicleNolength - 1] + VehicleNoEng[VehicleNolength]
    else result := result + VehicleNoEng[VehicleNolength - 1];
  end;
end;

//汉字转换

function ArabToChn(ArabStr: string): string;
var
  i, j, flag: integer;
begin
  //flag为零表示是小数点左边的数字，1表示右边的数字
  result := '';
  flag := 0;
  j := 0;
  for i := 1 to length(ArabStr) do
  begin
    if flag = 1 then j := j + 1;
    case ArabStr[i] of
      '1': result := result + ' 壹 ';
      '2': result := result + ' 贰 ';
      '3': result := result + ' 叁 ';
      '4': result := result + ' 肆 ';
      '5': result := result + ' 伍 ';
      '6': result := result + ' 陆 ';
      '7': result := result + ' 柒 ';
      '8': result := result + ' 捌 ';
      '9': result := result + ' 玖 ';
      '0': result := result + ' 零 ';
      '.': flag := 1;
    end;
  end;

  // 如果没有小数点或者小数点后不到两位则在后面补0
  if ((flag = 0) or (j <> 2)) then
  begin
    for i := 2 downto j + 1 do
    begin
      result := result + ' 零 ';
    end;
  end;
  if length(result) <> 28 then
    for i := 1 to (28 - length(result)) div (4) do
    begin
      result := ' 零 ' + result;
    end;

end;

//计算包缴月数

function NewTollMonth(VehicleNo: string; TollYear: string): Integer;
var TmpStr: string;
begin
  TmpStr := Dtm.DataSetResultStr('Select SumMonth From ConTractNew Where VehicleNo=' + QuotedStr(VehicleNo) + ' and remark=1 and ConTractTerm=' + QuotedStr(copy(TollYear, 1, 4)));

  if TmpStr = '' then
  begin

    Result := 12;
  end
  else
  begin
    Result := StrToInt(TmpStr);
  end;
end;

function TollMonth(Vehicletype: integer; bookinyear: string): integer;
var
  tollyear: integer;
  year: integer;

begin
  year := strtoint(trim(copy(bookinyear, 1, 4)));
  if year < 1000 then year := 2000;
  tollyear := YearOf(Date) - year;

  case vehicletype of
    1..2:
      begin
        if tollyear <= 0 then result := 12
        else if tollyear <= 8 then result := 10
        else result := 9;
      end;
    3..5:
      begin
        if tollyear <= 0 then result := 12
        else if tollyear <= 5 then result := 10
        else if (tollyear > 5) and (tollyear <= 10) then result := 9
        else result := 8;
      end;
    6: result := 8;
    7..8:
      begin
        if tollyear <= 0 then result := 12
        else if tollyear <= 5 then result := 10
        else if (tollyear > 5) and (tollyear <= 10) then result := 9
        else result := 8;
      end;

    9:
      result := 6;
    10:
      begin
        if tollyear <= 0 then result := 12
        else if tollyear <= 5 then result := 10
        else if (tollyear > 5) and (tollyear <= 10) then result := 9
        else result := 8;
      end;
    12:
      result := 8;
    13:
      result := 6;
  else
    result := 12;
  end;
end;
 //滞纳金计算


function Toewi(x: double): string;
begin
  if (x - int(x) <= 0.5) and (x - int(x) <> 0) then
  begin
    result := floattostr(int(x) + 0.5);
  end;
  if (x - int(x) > 0.5) then
  begin
    result := floattostr(int(x) + 1.0);
  end;
  if (x - int(x) = 0.0) then
  begin
    result := floattostr(x);
  end;
end;

function ComputerName: string;
var

  CNameBuffer: PChar;
  fl_loaded: Boolean;
  CLen: ^DWord;
begin
  GetMem(CNameBuffer, 255);
  New(CLen);
  CLen^ := 255;
  fl_loaded := GetComputerName(CNameBuffer, CLen^);
  if fl_loaded then
    ComputerName := StrPas(CNameBuffer)
  else
    ComputerName := 'Unkown';
  FreeMem(CNameBuffer, 255);
  Dispose(CLen);
end;

function MYState(StateInt: string): string;
begin
  if StateInt = '0' then result := '未缴';
  if StateInt = '1' then result := '月券';
  if StateInt = '2' then result := '两旬';
  if StateInt = '3' then result := '一旬';
  if StateInt = '4' then result := '次券';
  if StateInt = '5' then result := '退运';
  if StateInt = '6' then result := '驻外';
  if StateInt = '7' then result := '区减';
  if StateInt = '8' then result := '免征';
  if StateInt = '9' then result := '未注';
  if StateInt = 'A' then result := '区免';
  if StateInt = 'B' then result := '特免';
end;

function MYLateFee(StartTime: tdatetime;
  EndTime: tdatetime;
  PerMonthLevyFee: single;
  NowTime: tdatetime): single;
var i, Months, Days: integer;
  DateTmp: TDateTime;
  tempstr: Tdatetime;
begin
  Days := 0;
  if EndTime > Now then EndTime := Now;

  NowTime := GetFirstTime(Now);
  EndTime := GetFirstTime(EndTime);
  StartTime := GetFirstTime(StartTime);

  Months := monthof(endtime) - monthof(starttime) +
    (yearof(endtime) - yearof(starttime)) * 12 + 1;

  tempstr := starttime;

  if Months >= 1 then
  begin
    for i := 1 to Months do
    begin
      DateTmp := tempstr;
      Days := Days + DaysBetween(endoftheday(NowTime), DateTmp) + 1;
      tempstr := EndOfTheMonth(datetmp) + 1;
      tempstr := startoftheday(tempstr);
    end;
  end
  else days := 0;

  if NowTime < StartTime then Days := 0;
  if NowTime = StartTime then Days := 1;
  result := Days * PerMonthLevyFee * 0.01;
end;

procedure PrintForQuery(var DataSource1: TdataSource; var DBGrid1: TDbgrid);
const
  LeftBlank = 1; //定义页边距，单位厘米
  RightBlank = 1;
  TopBlank = 1;
  BottomBlank = 1;
var
  PointX, PointY: integer;
  PointScale, PrintStep: integer;
  s: string;
  x, y: integer;
  i: integer;
begin //获取当前打印机的分辨率;
  Printer();

  PointX := Trunc(GetDeviceCaps(Printer.Handle, LOGPIXELSX) / 2.54);
  PointY := Trunc(GetDeviceCaps(Printer.Handle, LOGPIXELSY) / 2.54);
//根据打印机和屏幕的分辨率计算出从屏幕转换到打印机的比例　
  PointScale := Trunc(GetDeviceCaps(Printer.Handle, LOGPIXELSX) / Screen.PixelsPerInch + 0.5); //横向打印
  printer.Orientation := poLandscape;

 //打印的字体和大小
  printer.Canvas.Font.Name := '宋体';
  printer.canvas.Font.Size := 10;
//根据字体的大小确定每行的高度
  s := '漳州市刑警支队';
  PrintStep := printer.canvas.TextHeight(s) + 16;

//打印的起点位置
  x := PointX * LeftBlank;
  y := PointY * TopBlank;

//DataSource1是DBGrid1所连接的数据源
  if ((DataSource1.DataSet).Active = true) and ((DataSource1.DataSet).RecordCount > 0)
    then
  begin
    printer.BeginDoc;
    (DataSource1.DataSet).First;
    while not (DataSource1.DataSet).Eof do
    begin //打印DBGrid中的所有列
      for i := 0 to DBGrid1.FieldCount - 1 do
      begin
     //假如所要打印的列超出了打印范围，则忽略该

        if (x + DBGrid1.Columns.Items[i].Width * PointScale) <= (Printer.PageWidth - PointX * RightBlank) then
        begin //画表格
//每页的第一行打印表头

          Printer.Canvas.Rectangle(x, y, x + DBGrid1.Columns.Items[i].Width * PointScale, y + PrintStep);
          if y = PointY * TopBlank then
            Printer.Canvas.TextOut(x + 8, y + 8, DBGrid1.Columns[i].Title.Caption)
          else
            Printer.Canvas.TextOut(x + 8, y + 8, DBGrid1.Fields[i].asString);
        end; //计算下一列的横坐标
        x := x + DBGrid1.Columns.Items[i].Width * PointScale;
      end;
      if not (y = PointY * TopBlank) then (DataSource1.DataSet).next;
      x := PointX * LeftBlank;
      y := y + PrintStep; //换页
      if (y + PrintStep) > (Printer.PageHeight - PointY * BottomBlank) then
      begin
        Printer.NewPage;
        y := PointY * TopBlank;
      end;
    end;
    printer.EndDoc;
    (DataSource1.DataSet).First;
    Application.MessageBox('打印完成', '打印', 32);
  end;

end;

function ValidText(KeyIn: Char; ValidateString: string; Editable: Boolean; IsValid: Boolean): Char;
var
  ValidateList: string;
  KeyOut: Char;
begin
  if Editable = True then
    ValidateList := UpperCase(ValidateString) + #8 + #13
  else
    ValidateList := UpperCase(ValidateString);

  if IsValid then
  begin
    if Pos(UpperCase(KeyIn), ValidateList) > 0 then
      KeyOut := KeyIn
    else
    begin
      KeyOut := #0;
      SysUtils.Beep;
    end
  end
  else
  begin
    if Pos(UpperCase(KeyIn), ValidateList) <= 0 then
      KeyOut := KeyIn
    else
    begin
      KeyOut := #0;
      SysUtils.Beep;
    end;
  end;
  Result := KeyOut;
{

KEY:= ValidText(Key,''''+' '+'''ABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/!@#$%^&()_-+=.|\?"}{][<>~`''''',FALSE,FALSE);

}
end;
//These functions and procedures are used to provide message information for users.

function MessageQuestion(InputMsg: string): Integer;
begin
  Result := Application.MessageBox(PChar(InputMsg), PChar('消息'), MB_ICONQUESTION + MB_YESNOCANCEL);
end;

function MessageQuestion(InputFmt: string; Value: array of const): Integer;
begin
  Result := MessageQuestion(Format(InputFmt, Value));
end;

function MessageSure(InputMsg: string): Boolean;
begin
  Result := Application.MessageBox(PChar(InputMsg), PChar('消息'), MB_ICONQUESTION + MB_YESNO) = IDYes;
end;

function MessageSure(InputFmt: string; Value: array of const): Boolean;
begin
  Result := MessageSure(Format(InputFmt, Value));
end;

procedure MessageInformation(InputMsg: string);
begin
  Application.MessageBox(PChar(InputMsg), PChar('提示'), MB_ICONINFORMATION + MB_OK);
end;

procedure MessageInformation(InputFmt: string; Value: array of const);
begin
  MessageInformation(Format(InputFmt, value));
end;

procedure MessageWarning(InputMsg: string);
begin
  Application.MessageBox(PChar(InputMsg), PChar('警告'), MB_ICONWARNING + MB_OK);
end;

procedure MessageWarning(InputFmt: string; Value: array of const);
begin
  MessageWarning(PChar(Format(InputFmt, Value)));
end;

procedure MessageError(InputMsg: string);
begin
  Application.MessageBox(PChar(InputMsg), PChar('错误'), MB_ICONERROR + MB_OK);
end;

procedure MessageError(InputFmt: string; Value: array of const);