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.