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_station<len then begin 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. |
|