Delphi program often used public code Tools.PAS

UNIT TOOLs;

Interface

Uses Windows, Messages, Sysutils, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, DB, Menus, DateUtils;

TYPE TMENULIST = PACKED Record Code: String; MenuItem: TMenuItem;

Const Codelen = 3;

{Data Conversion Get the corresponding Access field type} Function getDataType (DataType: TfieldType): integer; {Calcotive amount converted to capital amount} Function SumsmallTobig (Small: double): string; {Year}} function isleApyear (Ayear: Integer: Boolean; {Monthly last day} Function DaySpermonth (adate: tdatetime): integer; {get the Lunar Date} Function getndate (SDATE: TDATE): String; {Type of Week} Function GetWeekofDay (SDATE: TDATE) : String; {Take the long date} function getlongdate: string; {Getting computer machine} function computename: string; {plus small number} function addradixpoint (s: string; Digits: integer): string; {Press Pinyin Search} Function getPyindexchar (hzchar: string): char; {Take out Chinese characters} function getpy (hzstring: string): string;

IMPLEMENTATION

{Acquires the data conversion corresponding ACCESS field type} 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;

{Small write amount converted into capital amount} Function SUMSMALLTOBIG (SMALL: DOUBLE): String; var bigmoney, bigmoney_unit: string; // uppercase amount number and uppercase amount unit string MoneyString: String; / / lowercase letters after the format Small write string ##### 0.00 len: integer; // MoneyString length THIGER_STATION: INTEGER; // Current lowercase number location LEN_I: Integer; // Used to mark the length of Bigmoney_Unit and MoneyString, be sure to understand! ! ! ! THINNUMBERSTRING: STRING; // Current lowercase digital string NextNumber: integer; // Current lowercase Digital Next Digital Thisumber: integer; // Current lowercase digital digital returbustring: string; // Return Value Temp_bigmoneyString: String; // Digital uppercase Temp_bigmoney_Unitstring: String; // A larger in a digital unit Begin Bigmoney: = 'zero 壹 叁 柒捌'; bigmoney_Unit: = 'Point round, 万 万 佰仟 '; if ABS (Small)> 999999999999.991 Begin Application.Messagebox (' Congratulations! You have been honored to the world's richest !!! ',' Congratulations', MB_DEFBUTTON1 MB_ICONINFORMATION MB_OK); exit; // prevent crash. End; MoneyString: = Formatfloat ('0.00', ABS (SMALL)); LEN: = Length (MoneyString); // Length Thisumber_Station: = 1; // The loop position, starting 1. Nextnumber: = 0; // The number of the next position. LEN_I: = LEN; RETURnstring: = '; while thisnumber_station <= len do beg // -------------------- This location number string ------------ thisnumBerstring: = COPY (MoneyString, thisnumber_station, 1); if thisnumBerstring <> '.' THEN BEGIN INUMBER_STATION '.' Ten nextnumber: = start (COPY (MoneyString, Thisumber_Station 1, 1)) End; Thisnumber: = STRTOINT (THISNUMBERSTRING); // This location number.

Temp_bigmoneyString: = COPY (Bigmoney, Thisumber * 2 1, 2); // This location in uppercase digital TEMP_BIGMONEY_UNITSTRING: = COPY (Bigmoney_Unit, Len_i * 2-3, 2); // This location is in uppercase digital unit // -------------------------------------------------- ---------------------- IF ((thisnumber = 0) AND (NEXTNUMBER = 0)) OR ((Thisnumber = 0) and ((len_i = 4) OR (len_i = 8))) The ten Temp_bigmoneyString: = '; {If this location and the next position number is zero or the number of norms is zero, the unit position is in the circle, 10 million, the capital Character is empty} // -------------------------------------------- ----------------------------- IF ((thisnumber = 0) and (len_i <> 4) and (len_i <> 8) AND (LEN_I <> 12) OR ((SMALL) <1) and (len_i = 4))) The temp_bigmoney_unitstring: = '; {If the number is zero, circle, 10 million must, unless ABS (Small) is <1 decimal, the character character is empty} // ------------------------------- -------------------------------------------------- ---------------------- IF (Temp_bigmoney_Unitstring = ') And (Returnstring, Length (ReturnString) -1, 2) =' billion ') The Temp_bigmoney_Unitstring: = ''; // Handling Wan Zero, the character character is 10,000, but returbtring is the most After the character is a hundred million, the character character is empty ~ -------------------------------------- -------------------------------------- Returnstring: = RETURNSTRING TEMP_BIGMONEYSTRING TEMP_BIGMONEY_UNITSTRING; LEN_I: = Len_i-1; end; inc; // while if strat (copy (MoneyString, Len, 1)) = 0 THEN RETURnstring: = RETURNSTRING 'whole'; if small = 0 Then returbtring: = '; // If 0, what does not show if small <0 the returbustring: = 'negative' returbtring; result: = returbustring;

{Whether the year} function isleapyear (Ayear: Integer): boolean; begin result: = (Ayear Mod 4 = 0) AND (Ayear Mod 100 <> 0) or (Ayear Mod 400 = 0); end; { Get the month's last day} 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 (adte); amonth: = monthof (adate); result: = daysinmonth [amonth]; if (amonth = 2) And isleaar (Ayear) THEN INC; {If it is a leap year plus 1 day} end;

{Get Lun Date (SDATE: TDATE): String; const LDAYNAME: Array [1..30] of string = ('First', 'Junior 2', 'First Third', 'First Four ",' The first five ',' first six ',' first seven ',' first eight ',' Jijiu ',' Junior 10 ',' 11 ',' 12 ',' 13 ',' 14 ", ' Fifteen ',' 16 ',' 17th ',' 18 ',' 19 ',' 20 ',' 廿 1 ',' 廿 二 ',' 廿三 ',' 廿 4 ','廿五 ',' 廿 六 ',' 廿七 ',' 廿 八 ',' 九 ',' 30 '); LMONTHNAME: Array [1..12] of string = (' 正 月 ',' February ',' March ',' April ',' May ',' June ',' July ',' August ',' September ',' October ',' November ',' 10 February '); lyearname: array [0..9] of string = (' zero ',' one ',' two ',' three ',' four ',' five ',' six ',' seven ", 'Eight', 'Nine');

Longlife: array [1..100] of string [9] = ('132637048 ",' 133365036 ',' 053365225 ',' 132900044 ',' 131386034 ',' 022778122 ', //6' 132395041 ',' 071175231 ' '131 175 050' '132 635 038' '052 891 127' '131 701 046', // 12 '131 748 035' '042 741 223' '130 694 043' '132 391 032' '021 327 122' '131 175 040', // 18 '061623129' '133 402 047' '133 402 036' '051 769 125' '131 453 044' '130 694 034', // 24 '032 158 223' '132 350 041' '073 213 230' '133 221 049' '133 402 038' '063 466 226', // 30 '132 901 045' '131 130 035' '042 651 224' '130 605 043' '132 349 032' '023 371 121', // 36 '132 709 040' '072 901 128' '131 738 047' '132 901 036' '051 333 226' '131 210 044 ', // 42' 132 651 033 '' 031 111 223 '' 131 323 042 '' 082 714 130 '' 133 733 048 '' 131 706 038 ', // 48' 062 794 127 '' 132 741 045 '' 131 206 035 '' 042 734 124 '' 132 647 043 ',' 131318032 ', // 54' 033 878 120 '' 133 477 039 '' 071 461 129 '' 131 386 047 '' 132 413 036 '' 051 245 126 ', // 60' 131 197 045 '' 132 637 033 '' 043 405 122 '' 133 365 041 ',' 083413130 ​​',' 132900048 ', //66' 132922037 ',' 062394227 ',' 1323950 46 ',' 131179035 ',' 042711124 ',' 132635043 ', // 72' 102855132 ',' 131701050 ',' 131748039 ',' 062804128 ',' 132742047 ','

132,359,036 ', // 78' 051 199 126 '' 131 175 045 '' 131 611 034 '' 031 866 122 '' 133 749 040 '' 081 717 130 ', // 84' 131 452 049 '' 132 742 037 '' 052 413 127 '' 132 350 046 '' 133 222 035 '' 043 477 123 ', // 90' 133 402 042 '' 133 493 031 '' 021 877 121 '' 131 386 039 '' 072 747 128 '' 130 605 048 ', // 96' 132 349 037 '' 053 243 125 '' 132 709 044 '' 132890033 '); smday: array [1..12] of integer = (31, 28, 31, 30, 31, 30, 31); Var lyear, lmonth, lday: integer LMDAY: Array [1..13] of integer; intermonth, intermonthdays, slangeday: 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;

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; dsize: = start (Copy (Magicstr, 7, 1)); Case Dsize of 0: InterMonthdays: = 0; 1: InterMonthdays: = 29; 2: Intermonthdays: = 30; end; slangededay: = start (COPY (Magicstr, 8, 2));

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 iF isleApyear (Syear 1911) Then Day: = day 1; day: = day sday; end; if day <= slangeday 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; lyser: = SYAR - 1; LMONTH: = I; LDAY: = day; end else begin day: = day - slonseDay; for i: = 1 to intermonth-1 do begin day: = day - lmday [i]; if day <= 0 THEN BREAK; END If day <= 0 THEN BEGIN = SYEAR; LMONTH: = I; LDAY: = day lmday [i]; end else begin day: = day - lmday [intermonth]; if d AY <= 0 dam = 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; lyser: = syear; lday: = day lmday [i]; END;

Lyear: = lyser 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 INTSTOSTOSTR (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: = dayofthewek (sdate); case i of 0: result: = 'day'; 1: Result: = 'one'; 2: Result: = '2'; 3: Result: = 'three'; 4: Result: = 'four'; 5: Result: = '5'; 6: Result: = 'six'; end; result: = 'Week' Result ;

Function GetlongDate (SDATE: TDATE): String; Begin Result: = INTOSTR (Yearof (SDATE)) ' INTHOF (SDATE) ' Moon ' INTOSTR (Dayof (SDATE)) ' Day ' END;

{Getting computer machine} Function Computername: string; var cnamebuffer: pchar; fl_loaded: boolean; clen: ^ dword; begin getmem (cnamebuffer, 255); new; clen ^: = 255;

fl_loaded: = GetComputerName (CNameBuffer, CLen ^); if fl_loaded then ComputerName: = StrPas (CNameBuffer) else ComputerName: = 'Unkown'; FreeMem (CNameBuffer, 255); Dispose (CLen); end;

{Character encryption}

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 the 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;

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); Else Result: = Result Hz; Inc (i); END .