unit Tools;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DB, Menus, DateUtils;

type
TMenuList=packed Record
Code:String;
MenuItem:TMenuItem;
end;

const CodeLen=3;

{数据转换时获取相应的ACCESS字段类型}
function GetDataType(DataType:TFieldType):integer;
{小写金额转换成大写金额}
function SumSmallTOBig(small:double):string;
{年份是否涧年}
function IsLeapYear(AYear: Integer): Boolean;
{取得每月的最后一天}
function DaysPerMonth(ADate : TDateTime): Integer;
{取得农历日期}
function GetNDate(sDate: TDate): string;
{取得星期几}
function GetWeekofDay(sDate: TDate): string;
{取得长型日期}
function GetLongDate(sDate: TDate): string;
{取得计算机机}
function ComputerName : String;
{加小数点}
function Addradixpoint(s: string; digits: integer): string;
{按拼音检索}
function GetPyIndexChar( hzchar:string):char;
{取出汉字拼音}
function GetPy( HZString:string ):string;

implementation

{数据转换时获取相应的ACCESS字段类型}
function GetDataType(DataType:TFieldType):integer;
begin
case DataType of
ftUnknown, ftString, ftCursor, ftFixedChar, ftWideString, ftADT, ftArray, ftReference,
ftDataSet, ftVariant, ftInterface, ftIDispatch:
Result:=10;
ftSmallint, ftWord, ftAutoInc:
Result:=3;
ftInteger:
Result:=4;
ftBoolean:
Result:=1;
ftFloat, ftBCD:
Result:=7;
ftCurrency:
Result:=5;
ftDate, ftTime, ftDateTime:
Result:=8;
ftBytes, ftVarBytes, ftBlob, ftGraphic, ftParadoxOle, ftDBaseOle, ftOraBlob,
ftOraClob:
Result:=11;
ftMemo, ftFmtMemo:
Result:=12;
ftTypedBinary:
Result:=9;
ftGuid:
Result:=15;
ftLargeint:
Result:=16
end;
end;

{小写金额转换成大写金额}
function SumSmallTOBig(small:double):string;
var
bigmoney,bigmoney_unit:string;// 大写金额数字和大写金额单位字符串
moneystring:string; //小写字母转化以后的固定格式的小写字符串 #####0.00
len:integer;//MONEYSTRING的长度
thisnumber_station:integer;//当前小写数字的位置
len_i:integer;// 用来标志bigmoney_unit和MONEYSTRING的长度，务必理解！！！！
thisnumberstring:string;// 当前小写数字的字符串
nextnumber:integer;// 当前小写数字下一位 数字
thisnumber:integer;// 当前小写数字数字
returnstring:string;//返回值
temp_bigmoneystring :string;//某个数字的大写
temp_bigmoney_unitstring:string;//某个数字单位的大写
begin
bigmoney:='零壹贰叁肆伍陆柒捌玖';
bigmoney_unit:='分角圆拾佰仟万拾佰仟亿拾佰仟';
if abs(small) >999999999999.99 then
begin
Application.MessageBox('恭喜恭喜！您已荣升为全球首富！！！','恭喜恭喜',
MB_DEFBUTTON1+ MB_ICONINFORMATION+MB_ok);
exit;//防止死机。
end;
moneystring:=formatfloat('0.00',abs(small));
len:=length(moneystring);//长度
thisnumber_station:=1;//循环位置,起始为1。
nextnumber:=0;//下一个位置的数字。
len_i:=len;
returnstring:='';
while thisnumber_station<=len do
begin
//-----------------------本位置上的数字字符串------------
thisnumberstring:=copy(moneystring,thisnumber_station,1);
if thisnumberstring<>'.' then
begin
if thisnumber_stationbegin
if copy(moneystring,thisnumber_station+1,1)<>'.' then
nextnumber:=strtoint(copy(moneystring,thisnumber_station+1,1))
end;
thisnumber:=strtoint(thisnumberstring);//本位置的数字。
temp_bigmoneystring:=copy(bigmoney,thisnumber*2+1,2);//本位置的大写数字
temp_bigmoney_unitstring:=copy(bigmoney_unit,len_i*2-3,2);//本位置的大写数字单位
//-------------------------------------------------------------------------
if ((thisnumber=0) and (nextnumber=0)) or
((thisnumber=0) and ((len_i=4) or(len_i=8) or (len_i=12) )) then
temp_bigmoneystring:='';
{ 如果本位置和下一位置数字为零或者本位数字为零并且单位位置在圆、万、亿上，
本大写字符为空}
//-------------------------------------------------------------------------
if ((thisnumber=0) and (len_i<>4) and (len_i<>8) and
(len_i<>12) or ((ABS(small)<1)and (len_i=4))) then
temp_bigmoney_unitstring:='';
{如果本位置数字为零，圆、万、亿必须有 ，除非ABS(SMALL)为<1的小数，
本单位字符为空}
//---------------------------------------------------------------------------------------------------------
if (temp_bigmoney_unitstring='万')and
(copy(returnstring,length(returnstring)-1,2)='亿') then
temp_bigmoney_unitstring:='';
//处理万为零，本单位字符为万，但RETURNSTRING最后字符为亿，本单位字符为空
//----------------------------------------------------------------------------
returnstring:=returnstring+temp_bigmoneystring+temp_bigmoney_unitstring;
len_i:=len_i-1;
end;
inc(thisnumber_station);
end;//while
if strtoint(copy(moneystring,len,1))=0 then
returnstring:=returnstring+'整';
if small=0 then returnstring:=''; //如果为0，什么也不显示
if small<0 then
returnstring:='负'+returnstring;
result:=returnstring;
end;

{年份是否涧年}
function IsLeapYear(AYear: Integer): Boolean;
begin
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;

{获取每月的最后一天}
function DaysPerMonth(ADate : TDateTime): Integer;
var
AYear, AMonth: integer;
const
DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
AYear:=YearOf(ADate);
AMonth:=MonthOf(ADate);
Result := DaysInMonth[AMonth];
if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result);{如果是闰年则2月加1天}
end;

{获取农历日期}
function GetNDate(sDate: TDate): string;
const
LDayName : array[1..30] of string = ('初一', '初二', '初三', '初四', '初五', '初六', '初七', '初八', '初九', '初十',
'十一', '十二', '十三', '十四', '十五', '十六', '十七', '十八', '十九', '二十',
'廿一', '廿二', '廿三', '廿四', '廿五', '廿六', '廿七', '廿八', '廿九', '三十');
LMonthName : array[1..12] of string = ('正月', '二月', '三月', '四月', '五月', '六月', '七月', '八月', '九月', '十月', '十一月', '十二月');
LYearName : array[0..9] of string =('零', '一', '二', '三', '四','五', '六', '七', '八', '九');

LongLife : array[1..100] of string[9] = (
'132637048', '133365036', '053365225', '132900044', '131386034', '022778122', //6
'132395041', '071175231', '131175050', '132635038', '052891127', '131701046', //12
'131748035', '042741223', '130694043', '132391032', '021327122', '131175040', //18
'061623129', '133402047', '133402036', '051769125', '131453044', '130694034', //24
'032158223', '132350041', '073213230', '133221049', '133402038', '063466226', //30
'132901045', '131130035', '042651224', '130605043', '132349032', '023371121', //36
'132709040', '072901128', '131738047', '132901036', '051333226', '131210044', //42
'132651033', '031111223', '131323042', '082714130', '133733048', '131706038', //48
'062794127', '132741045', '131206035', '042734124', '132647043', '131318032', //54
'033878120', '133477039', '071461129', '131386047', '132413036', '051245126', //60
'131197045', '132637033', '043405122', '133365041', '083413130', '132900048', //66
'132922037', '062394227', '132395046', '131179035', '042711124', '132635043', //72
'102855132', '131701050', '131748039', '062804128', '132742047', '132359036', //78
'051199126', '131175045', '131611034', '031866122', '133749040', '081717130', //84
'131452049', '132742037', '052413127', '132350046', '133222035', '043477123', //90
'133402042', '133493031', '021877121', '131386039', '072747128', '130605048', //96
'132349037', '053243125', '132709044', '132890033' );
SMDay : array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

var
lYear, lMonth, lDay : integer;
LMDay : array[1..13] of integer;
InterMonth, InterMonthDays, SLRangeDay : integer;

procedure CovertLunarMonth(magicno : integer);
var
i, size, m : integer;
begin
m := magicno;
for i := 12 downto 1 do
begin
size := m mod 2;
if size = 0 then
LMDay[i] := 29
else
LMDay[i] := 30;
m := m div 2;
end;
end;

procedure ProcessMagicStr(yy : integer);
var
magicstr : string;
dsize, LunarMonth : integer;
begin
magicstr := LongLife[yy];
InterMonth := StrToInt(Copy(magicstr, 1, 2));
LunarMonth := StrToInt(copy(magicstr, 3, 4));
CovertLunarMonth(LunarMonth);
dsize := StrToInt(Copy(magicstr, 7, 1));
case dsize of
0 : InterMonthDays := 0;
1 : InterMonthDays := 29;
2 : InterMonthDays := 30;
end;
SLRangeDay := StrToInt(Copy(Magicstr, 8, 2));
end;

procedure Solar2Lunar(SYear, SMonth, SDay : integer; var LYear, LMonth, LDay : integer);
var
i, Day : integer;
begin
Day := 0;
ProcessMagicStr(SYear);
if SMonth = 1 then
Day := SDay
else
begin
for i := 1 to SMonth-1 do
Day := day + SMDay[i];
if IsLeapYear(SYear+1911) then Day:=Day+1;
Day := Day + SDay;
end;
if Day <= SLRangeDay then
begin
Day := Day - SLRangeDay;
processmagicstr(SYear-1);
for i := 12 downto 1 do
begin
day := day + LMDay[i];
if day > 0 then Break;
end;
LYear := SYear - 1;
LMonth := i;
LDay := day;
end
else
begin
day := day - SLRangeDay;
for i := 1 to InterMonth-1 do
begin
day := day - LMDay[i];
if day <= 0 then
break;
end;
if day <= 0 then
begin
LYear := SYear;
LMonth := i;
LDay := day + LMDay[i];
end
else
begin
day := day - LMDay[InterMonth];
if day <= 0 then
begin
LYear := SYear;
LMonth := InterMonth;
LDay := day + LMDay[InterMonth];
end
else
begin
LMDay[InterMonth] := InterMonthDays;
for i := InterMonth to 12 do
begin
day := day - LMDay[i];
if day <= 0 then
break;
end;
if i = InterMonth then
LMonth := 0 - InterMonth
else
LMonth := i;
LYear := SYear;
LDay := day + LMDay[i];
end;
end;
end;
LYear:=LYear+1911;
end;

function GetNlYear(Year: integer):string;
var
i: integer;
begin
for i:=1 to Length(IntToStr(Year)) do
begin
Result:=Result+LYearName[StrToInt(Copy(IntToStr(Year),I,1))];
end;
end;

var
y, m, d: integer;
begin
y:=YearOf(sDate);
m:=MonthOf(sDate);
d:=DayOf(sDate);
Solar2Lunar(y-1911, m, d, lYear, lMonth, lDay);
Result:=GetNlYear(lYear)+'年'
+LMonthName[abs(lMonth)]
+LDayName[lDay];
end;

function GetWeekofDay(sDate: TDate): string;
var
i: integer;
begin
i:=DayOfTheWeek(sDate);
case i of
0:Result:='日';
1:Result:='一';
2:Result:='二';
3:Result:='三';
4:Result:='四';
5:Result:='五';
6:Result:='六';
end;
Result:='星期'+Result;
end;

function GetLongDate(sDate: TDatE): string;
begin
Result:=IntToStr(Yearof(sDate))+'年'+
IntToStr(Monthof(sDate))+'月'+
IntToStr(Dayof(sDATE))+'日';
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 Addradixpoint(s: string; digits: integer): string;
var
i, dig: integer;
begin
dig:=Pos('.', s);
Result:=s;
if dig=0 then
begin
dig:=Length(s)+1;
s:=s+'.';
end; //6613189
if dig=Length(s)-digits then Exit;
for i:=0 to digits-(Length(s)-dig+1) do
begin
s:=s+'0';
end;
Result:=s;
end;

function GetPYIndexChar( hzchar:string):char;
begin
case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
$B0A1..$B0C4 : result := 'a';
$B0C5..$B2C0 : result := 'b';
$B2C1..$B4ED : result := 'c';
$B4EE..$B6E9 : result := 'd';
$B6EA..$B7A1 : result := 'e';
$B7A2..$B8C0 : result := 'f';
$B8C1..$B9FD : result := 'g';
$B9FE..$BBF6 : result := 'h';
$BBF7..$BFA5 : result := 'j';
$BFA6..$C0AB : result := 'k';
$C0AC..$C2E7 : result := 'l';
$C2E8..$C4C2 : result := 'm';
$C4C3..$C5B5 : result := 'n';
$C5B6..$C5BD : result := 'o';
$C5BE..$C6D9 : result := 'p';
$C6DA..$C8BA : result := 'q';
$C8BB..$C8F5 : result := 'r';
$C8F6..$CBF9 : result := 's';
$CBFA..$CDD9 : result := 't';
$CDDA..$CEF3 : result := 'w';
$CEF4..$D188 : result := 'x';
$D1B9..$D4D0 : result := 'y';
$D4D1..$D7F9 : result := 'z';
else
result := char(32);
end;
end;

function GetPY( HZString:string ):string;
var
i:integer;
Hz:string;
begin
i:=1;
while i <= Length(HZString) do
begin
Hz := Copy(HZString, I , 1);
if Hz >= Chr(128) then
begin
Inc(I);
Hz := Hz+ Copy(HZString, I , 1);
Result := Result + GetPYIndexChar(Hz);
end
else
Result := Result + Hz;
Inc(I);
end;
end;

end.