H
hyc991
Unregistered / Unconfirmed
GUEST, unregistred user!
是否有以函数可求当前日期的前一天日期,即2001-11-1,求2001-10-31?如没有如何编程?
您正在使用一款已经过时的浏览器！部分功能不能正常使用。
请尝试升级或使用 其他浏览器。
请尝试升级或使用 其他浏览器。
D
dongberlin
Unregistered / Unconfirmed
GUEST, unregistred user!
var
Yesterday: TDate;
begin
Yesterday:=date-1;
end;
Yesterday: TDate;
begin
Yesterday:=date-1;
end;
S
Super Power
Unregistered / Unconfirmed
GUEST, unregistred user!
可以仿LOTUS NOTES中写一个函数叫function justtime(data:Tdatatime;n,y,r:integer):Tdatatime
其中n:要改变的年份，y,要改变的月份，r,要改变的月份，正的表示向前推，负的表示往回
推。我写过一个，但一时不知放哪去了，但思路是这个样子的。
其中n:要改变的年份，y,要改变的月份，r,要改变的月份，正的表示向前推，负的表示往回
推。我写过一个，但一时不知放哪去了，但思路是这个样子的。
U
ugvanxk
Unregistered / Unconfirmed
GUEST, unregistred user!
date-1
W
WilliamGui
Unregistered / Unconfirmed
GUEST, unregistred user!
我自己有個公共pas文件﹐其中有這類函數﹐
寫mail給我. williamgui@21cn.com
寫mail給我. williamgui@21cn.com
飞
飞虎队no.1
Unregistered / Unconfirmed
GUEST, unregistred user!
JSP中获得当前时间
[% public String getTime()
{java.util.Date now = new java.util.Date();
int dd = now.getDate();
int mt = now.getMonth() + 1;
int yy = now.getYear();
yy=(yy [ 1000) ? yy + 1900 : yy;
String mydate=String.valueOf(yy) +"年"+String.valueOf(mt) +"月"+String.valueOf(dd) +"日";
int hh = now.getHours();
int mm = now.getMinutes();
int ss = now.getSeconds();
String mytime=mydate+String.valueO f(hh)+"时"+String.valueOf (mm)+"分"+String.valueOf (ss)+"秒";
return mytime;
} %]
[%=getTime()%]
做一下判断即可！
[% public String getTime()
{java.util.Date now = new java.util.Date();
int dd = now.getDate();
int mt = now.getMonth() + 1;
int yy = now.getYear();
yy=(yy [ 1000) ? yy + 1900 : yy;
String mydate=String.valueOf(yy) +"年"+String.valueOf(mt) +"月"+String.valueOf(dd) +"日";
int hh = now.getHours();
int mm = now.getMinutes();
int ss = now.getSeconds();
String mytime=mydate+String.valueO f(hh)+"时"+String.valueOf (mm)+"分"+String.valueOf (ss)+"秒";
return mytime;
} %]
[%=getTime()%]
做一下判断即可！
Z
zhihuali
Unregistered / Unconfirmed
GUEST, unregistred user!
Date - 1
W
WilliamGui
Unregistered / Unconfirmed
GUEST, unregistred user!
////////////////////////////////////////////////////////////////
// Author: WilliamGui //
// Modify Date: 2001-04-20 //
// Visit my personal WebSite: http://21sparrow.yeah.net //
////////////////////////////////////////////////////////////////
unit wgpubcode;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ShellAPI;
{-$define _ENG}
{$DEFINE _BG}
{-$define _BIG5}
{--- Common Function ---}
//About String Function
function StrRepeat(AProcessString: string;
n: integer): string;
const
{$IFDEF _BG}
UNITAGE_STR: string = 'Ǫ°ÛÊ°ÒÚǪ°ÛÊ°ÍòǪ°ÛÊ°Ôª½Ç·Ö';
UPPER_STR: string = 'ÁãÒ¼·¡²ÎËÁÎé½Æâ°Æ¾Á';
CURRENCY_UOM_STR: string = 'Ôª½Ç·Ö';
CURRENCY_SUFFIX_STR: string = 'ÕûÕý¸º';
{$ENDIF}
{$IFDEF _BIG5}
UNITAGE_STR: string = '¥a¨Õ¬B»õ¥a¨Õ¬BÉE¥a¨Õ¬B¤¸¨¤¤À';
UPPER_STR: string = '¹s³ü¶L°Ñ¸v¥î³°¬m®Ã¨h';
CURRENCY_UOM_STR: string = '¤¸¨¤¤À';
CURRENCY_SUFFIX_STR: string = '¾ã¥¿­t';
{$ENDIF}
//{$ifdef _BG or _BIG5}
{$IFDEF _BG}
function CurrencyToChinese(ACurrency: Currency;
Default: string = ''): string;
{$ENDIF}
//About Datetime Function
function GetItYear(AProcessDate: TDate): integer;
function GetItMonth(AProcessDate: TDate): integer;
function GetItDay(AProcessDate: TDate): integer;
function GetYear: integer;
function GetMonth: integer;
function GetDay: integer;
function GetFirstDayOfMonth(AProcessDate: TDate): TDate;
function GetLastDayOfMonth(AProcessDate: TDate): TDate;
function GetDayCountInMonth(AProcessDate: TDate): integer;
function GetFirstDayOfPriorMonth(AProcessDate: TDate): TDate;
function GetLastDayOfPriorMonth(AProcessDate: TDate): TDate;
function GetDayCountInPriorMonth(AProcessDate: TDate): integer;
function GetFirstDayOfNextMonth(AProcessDate: TDate): TDate;
function GetLastDayOfNextMonth(AProcessDate: TDate): TDate;
function GetDayCountInNextMonth(AProcessDate: TDate): integer;
{--- MessageBox ---}
const
{$IFDEF _ENG}
TIP_STRING = 'Tip';
WARNING_STRING = 'Warning';
ERROR_STRING = 'Error';
CONFIRM_STRING = 'Confirm';
QUERY_DELETE_STRING = ' Are you sure to delete this record(Y/N)? ';
QUERY_SAVE_STRING = ' Are you save it(Y/N)? ';
QUERY_EXIT_STRING = ' Are you sure to exit(Y/N)? ';
NOT_DEVELOP_FINISH_STRING = ' The function is developing ...... ';
{$ENDIF}
{$IFDEF _BG}
TIP_STRING = 'Ìáʾ';
WARNING_STRING = '¾¯¸æ';
ERROR_STRING = '´íÎó';
CONFIRM_STRING = 'È·ÈÏ';
QUERY_DELETE_STRING = ' ÊÇ·ñҪɾ³ýÕâÌõ¼Ç¼(Y/N)? ';
QUERY_SAVE_STRING = ' ÊÇ·ñ´æÅÌ(Y/N)? ';
QUERY_EXIT_STRING = ' ÊÇ·ñÕæµÃÒªÍ˳ö(Y/N)? ';
NOT_DEVELOP_FINISH_STRING = ' ¸Ã¹¦ÄÜ»¹ÔÚ¿ª·¢ÖÐ...... ';
{$ENDIF}
{$IFDEF _BIG5}
TIP_STRING = '´£¥Ü';
WARNING_STRING = 'ĵ§i';
ERROR_STRING = '¿ù»~';
CONFIRM_STRING = '½T»{';
QUERY_DELETE_STRING = ' ¬O§_­n§R°£³o±ø°O¿ý(Y/N)? ';
QUERY_SAVE_STRING = ' ¬O§_¦s½L(Y/N)? ';
QUERY_EXIT_STRING = ' ¬O§_¯u±o­n°h¥X(Y/N)? ';
NOT_DEVELOP_FINISH_STRING = ' ¸Ó¥/¯àÁÙ¦b¶}µo¤¤...... ';
{$ENDIF}
{ New MessageBox 2001/08/01}
function InfoMsgBox(AInformationString: string): integer;
function WarningMsgBox(AWarningString: string): integer;
function ErrorMsgBox(AErrorString: string): integer;
function QueryMsgBox(AQuestionString: string;
ADefaultButton: integer = 1): integer;
function ConfMsgBox(AQuestionString: string;
ADefaultButton: integer = 1): integer;
function QueryDelMsgBox(ADeleteString: string = QUERY_DELETE_STRING): integer;
function QuerySaveMsgBox(ASaveString: string = QUERY_SAVE_STRING): integer;
function QueryExitMsgBox(AExitString: string = QUERY_EXIT_STRING): integer;
function NotDevelopFinishMsgBox(ANotDevelopFinishString: string = NOT_DEVELOP_FINISH_STRING): integer;
{--- Windows ---}
function OpenWindow(var AForm: TForm;
ATFormClass: TFormClass;
AOwner: TComponent;
AOpenMethod: integer = 1): integer;
{--- Voice ---}
type
TBleepType = (vOK, vInterrupt, vError);
procedure Bleep(BleepType: TBleepType);
//·¢³öÉùÒô
procedure Sound(dFreq:do
uble;
wLong: word);
//·¢³ö¸÷Òô½×ÉùÒô
{ #49,#97: sound(261.7,400);
C
#50,#98: sound(293.7,400);
D
#51,#99: sound(329.6,400);
E
#52,#100: sound(349.2,400);
F
#53,#101: sound(392.0,400);
G
#54,#102: sound(440.0,400);
A
#55,#103: sound(493.9,400);
B }
{--- About System ---}
function DiskInDrive(Drive: Char): Boolean;
//Çý¶¯Æ÷ÊÇ·ñ×¼±¸ºÃ
function GetWindowsTempPath: string;
{--- About Network ---}
function GetLoginName: string;
{--- Code ---}
implementation
function StrRepeat(AProcessString: string;
n: integer): string;
var
i: integer;
TempVar: string;
begin
TempVar := '';
for i := 1 to ndo
begin
TempVar := TempVar + AProcessString;
end;
Result := TempVar;
end;
{$IFNDEF _ENG}
function CurrencyToChinese(ACurrency: Currency;
Default: string = ''): string;
function RightStr(S: string;
N: Integer): string;
// ·µ»ØÖ¸¶¨×Ö·û´®µÄÓÒ±ß
N ¸ö×Ö·û
var
Start: Integer;
begin
Start := Length(S) - N + 1;
if Start <= Length(S) then
Result := Copy(S, Start, N)
else
Result := '';
end;
var
LowStr: string;
// &ETH;&iexcl;&ETH;&acute;&frac12;&eth;&para;&icirc;×&Ouml;·&ucirc;&acute;&reg;
CurrentChar: Char;
// &micro;±&Ccedil;°&Ecirc;&yacute;&Ouml;&micro;&micro;&Auml;ASCII&Acirc;&euml;
CurrentNum: Integer;
// &micro;±&Ccedil;°&Ecirc;&yacute;&Ouml;&micro;
UpperStr, UnitageChar: string[4];
// &acute;ó&ETH;&acute;&frac12;&eth;&para;&icirc;×&Ouml;·&ucirc;&acute;&reg;&ordm;&Iacute;&frac12;&eth;&para;&icirc;&micro;&yen;&Icirc;&raquo;×&Ouml;·&ucirc;&acute;&reg;
CurrentPos, UnitagePos: Integer;
// &Euml;÷&Ograve;&yacute;
begin
// Is Zero?
if ACurrency = 0 then
begin
Result := Default;
Exit;
end;
Result := '';
FmtStr(LowStr, '%15.2f', [ACurrency]);
// Convert to string
LowStr := Trim(LowStr);
if ACurrency < 0 then
LowStr := Copy(LowStr, 2, Length(LowStr) - 1);
// &Egrave;&ccedil;&sup1;&ucirc;&Ecirc;&Ccedil;&cedil;&ordm;&Ouml;&micro;&pound;&not;&Iuml;&Egrave;°&Ntilde;×&Ouml;·&ucirc;&acute;&reg;&Agrave;&iuml;&micro;&Auml;&Auml;&Ccedil;&cedil;&ouml;&cedil;&ordm;&ordm;&Aring;&Egrave;&yen;&micro;&ocirc;
CurrentPos := 1;
UnitagePos := 15 - Length(LowStr);
while UnitagePos < 14do
begin
CurrentChar := LowStr[CurrentPos];
// &Egrave;&iexcl;&micro;±&Ccedil;°&Icirc;&raquo;&Ecirc;&yacute;×&Ouml;
if (CurrentChar > '9') or (CurrentChar < '0') then
begin
// &Egrave;&iexcl;&micro;&frac12;&micro;&Auml;×&Ouml;·&ucirc;&iquest;&Eacute;&Auml;&Uuml;&sup2;&raquo;&Ecirc;&Ccedil;&Ecirc;&yacute;×&Ouml;&pound;¨±&Egrave;&Egrave;&ccedil;&Euml;&micro;&Ecirc;&Ccedil;&ETH;&iexcl;&Ecirc;&yacute;&micro;&atilde;&pound;&copy;
Inc(CurrentPos);
Continue;
end;
CurrentNum := Ord(CurrentChar) - Ord('0');
// &Egrave;&iexcl;&micro;±&Ccedil;°&Ecirc;&yacute;×&Ouml;&micro;&Auml;&Ouml;&micro;
UpperStr := Copy(UPPER_STR, (CurrentNum shl 1) + 1, 2);
// &Egrave;&iexcl;&Iuml;à&Oacute;&brvbar;&micro;&Auml;&acute;ó&ETH;&acute;&Ouml;&ETH;&Icirc;&Auml;
UnitageChar := Copy(UNITAGE_STR, (UnitagePos shl 1) + 1, 2);
// &Iuml;à&Oacute;&brvbar;&micro;&Auml;&micro;&yen;&Icirc;&raquo;
if (CurrentNum <> 0) then
begin
// &Egrave;&ccedil;&sup1;&ucirc;&Egrave;&iexcl;&micro;&Atilde;&micro;&Auml;&Ecirc;&yacute;×&Ouml;&sup2;&raquo;&Ecirc;&Ccedil;&Aacute;&atilde;&pound;&not;&ordm;&Uuml;&frac14;ò&micro;&yen;&pound;&not;&Ocirc;&Uacute;×&Ouml;·&ucirc;&acute;&reg;&ordm;ó&Atilde;&aelig;&Igrave;í&frac14;&Oacute;&Eacute;&Iuml;&Ecirc;&yacute;&Ouml;&micro;&ordm;&Iacute;&micro;&yen;&Icirc;&raquo;&frac34;&Iacute;&ETH;&ETH;&Aacute;&Euml;
Result := Result + UpperStr + UnitageChar;
Inc(UnitagePos);
Inc(CurrentPos);
Continue;
end;
if RightStr(Result, 2) <> copy(UPPER_STR, 1, 2) then
Result := Result + copy(UPPER_STR, 1, 2);
// &Ecirc;&Ccedil;&Aacute;&atilde;&frac34;&Iacute;&Acirc;é·&sup3;&Aacute;&Euml;&pound;&not;&Iuml;&Egrave;&iquest;&acute;&iquest;&acute;&Ecirc;&Ccedil;&sup2;&raquo;&Ecirc;&Ccedil;&Ouml;&Oslash;&cedil;&acute;&Aacute;&atilde;&pound;&not;&sup2;&raquo;&Ecirc;&Ccedil;&frac34;&Iacute;&Iuml;&Egrave;&frac14;&Oacute;&Ograve;&raquo;&cedil;&ouml;'&Aacute;&atilde;'&Ocirc;&Ugrave;&Euml;&micro;
{ &Egrave;&ccedil;&sup1;&ucirc;&Ecirc;&Ccedil;&Aacute;&atilde;&Ccedil;&Ograve;&Oacute;&Ouml;&Otilde;&yacute;&ordm;&Atilde;&Ocirc;&Uacute;'&Ograve;&Uacute;'&iexcl;&cent;'&Iacute;ò'&iexcl;&cent;'&Ocirc;&ordf;'&Otilde;&acirc;&Egrave;&yacute;&cedil;&ouml;&Icirc;&raquo;&Ouml;&Atilde;&Eacute;&Iuml;&pound;&not;&frac34;&Iacute;&iexcl;&shy;&iexcl;&shy;
&acute;ó&frac14;&Ograve;&para;&frac14;&Ccedil;&aring;&sup3;&thorn;&pound;&not;&Atilde;&raquo;&Oacute;&ETH;'&sup2;&Icirc;&Ecirc;°&Aacute;&atilde;&Ocirc;&ordf;'&raquo;ò'·&iexcl;&Ecirc;°&Aacute;&atilde;&Iacute;ò&frac34;&Aacute;&Ccedil;&ordf;'&Otilde;&acirc;&Ouml;&Ouml;&Euml;&micro;·¨&pound;&not;&Ouml;&raquo;&Oacute;&ETH;
'&sup2;&Icirc;&Ecirc;°&Ocirc;&ordf;'&ordm;&Iacute;'·&iexcl;&Ecirc;°&Iacute;ò&frac34;&Aacute;&Ccedil;&ordf;'&pound;&not;&Ograve;ò&acute;&Euml;&Ograve;&ordf;&Eacute;&frac34;&Egrave;&yen;&Eacute;&Iuml;&Atilde;&aelig;&Auml;&Ccedil;&frac34;&auml;&acute;ú&Acirc;&euml;&Euml;ù&frac14;&Oacute;&micro;&Auml;'&Aacute;&atilde;'×&Ouml;·&ucirc;
}
if (UnitageChar = copy(UNITAGE_STR, 7, 2)) or (UnitageChar = copy(UNITAGE_STR, 15, 2)) or (UnitageChar = '¤&cedil;') then
begin
Delete(Result, Length(Result) - 1, 2);
if RightStr(Result, 2) <> copy(UNITAGE_STR, 7, 2) then
Result := Result + UnitageChar;
// &raquo;&sup1;&Ograve;&ordf;&iquest;&acute;&iquest;&acute;&Ccedil;°&Ograve;&raquo;&Icirc;&raquo;&Ecirc;&Ccedil;&sup2;&raquo;&Ecirc;&Ccedil;'&Ograve;&Uacute;'&Icirc;&raquo;&pound;&not;&Ecirc;&Ccedil;&frac34;&Iacute;&sup2;&raquo;&frac14;&Oacute;&micro;&yen;&Icirc;&raquo;&Aacute;&Euml;
Result := Result + copy(UPPER_STR, 1, 2);
end;
Inc(UnitagePos);
Inc(CurrentPos);
end;
if RightStr(Result, 2) = copy(UPPER_STR, 1, 2) then
Result := Copy(Result, 1, Length(Result) - 2);
// &Ntilde;&frac12;&pound;&not;&Ouml;&Otilde;&Oacute;&Uacute;×&ordf;&raquo;&raquo;&Iacute;ê&Aacute;&Euml;&pound;&not;±&eth;&Atilde;&brvbar;&pound;&not;&Egrave;&ccedil;&sup1;&ucirc;&frac12;á&sup1;&ucirc;&micro;&Auml;&Auml;&copy;&Icirc;&sup2;&Ecirc;&Ccedil;'&Aacute;&atilde;'&raquo;&sup1;&Ograve;&ordf;&Eacute;&frac34;&Egrave;&yen;&Euml;ü
if Copy(Result, 1, 2) = copy(UPPER_STR, 1, 2) then
Result := Copy(Result, 3, Length(Result) - 2);
// &Egrave;&ccedil;&sup1;&ucirc;&frac12;á&sup1;&ucirc;&micro;&Auml;&iquest;&ordf;&Ecirc;&frac14;&frac34;&Iacute;&Ecirc;&Ccedil;&Aacute;&atilde;&pound;&not;&Ograve;&sup2;&Ograve;&ordf;&Eacute;&frac34;&sup3;&yacute;&Euml;ü
if RightStr(Result, 2) = copy(CURRENCY_UOM_STR, 3, 2) then
Result := Result + copy(CURRENCY_SUFFIX_STR, 3, 2) // &Egrave;&ccedil;&sup1;&ucirc;&frac12;á&sup1;&ucirc;&Otilde;&yacute;&ordm;&Atilde;&Ecirc;&Ccedil;'XXXX&frac12;&Ccedil;'&pound;&not;°&acute;&Iuml;°&sup1;&szlig;&Oacute;&brvbar;&cedil;&Atilde;&frac14;&Oacute;&Eacute;&Iuml;&Ograve;&raquo;&cedil;&ouml;'XXXX&frac12;&Ccedil;&Otilde;&yacute;'
else
if RightStr(Result, 2) <> copy(CURRENCY_UOM_STR, 5, 2) then
Result := Result + copy(CURRENCY_SUFFIX_STR, 1, 2);
// &Egrave;&ccedil;&sup1;&ucirc;&frac12;á&sup1;&ucirc;&sup2;&raquo;&Ecirc;&Ccedil;'XXXX·&Ouml;&pound;&not;&frac34;&Iacute;&Ograve;&ordf;&frac14;&Oacute;&Eacute;&Iuml;&Ograve;&raquo;&cedil;&ouml;'&Otilde;&ucirc;'×&Ouml;
if Copy(Result, 1, 2) = copy(CURRENCY_UOM_STR, 1, 2) then
Result := RightStr(Result, Length(Result) - 4);
// &raquo;&sup1;&Oacute;&ETH;&Ograve;&raquo;&cedil;&ouml;&ETH;&iexcl;&Icirc;&Ecirc;&Igrave;&acirc;&pound;&not;&frac34;&Iacute;&Ecirc;&Ccedil;......
if ACurrency < 0 then
Result := copy(CURRENCY_SUFFIX_STR, 5, 2) + Result;
// ×&icirc;&ordm;ó&pound;&not;&Egrave;&ccedil;&sup1;&ucirc;&Ecirc;&Ccedil;&cedil;&ordm;&Ouml;&micro;&raquo;&sup1;&Ograve;&ordf;&frac14;&Oacute;&Eacute;&Iuml;&Ograve;&raquo;&cedil;&ouml;'&cedil;&ordm;'
end;
{$ENDIF}
function InfoMsgBox(AInformationString: string): integer;
begin
Result := MessageBox(GetActiveWindow, PChar(AInformationString), PChar(TIP_STRING), MB_ICONINFORMATION + MB_OK);
end;
function WarningMsgBox(AWarningString: string): integer;
begin
Result := MessageBox(GetActiveWindow, PChar(AWarningString), PChar(WARNING_STRING), MB_ICONWARNING + MB_OK);
end;
function ErrorMsgBox(AErrorString: string): integer;
begin
Result := MessageBox(GetActiveWindow, PChar(AErrorString), PChar(ERROR_STRING), MB_ICONERROR + MB_OK);
end;
function QueryMsgBox(AQuestionString: string;
ADefaultButton: integer = 1): integer;
begin
if ADefaultButton = 2 then
Result := MessageBox(GetActiveWindow, PChar(AQuestionString), PChar(CONFIRM_STRING), MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2)
else
Result := MessageBox(GetActiveWindow, PChar(AQuestionString), PChar(CONFIRM_STRING), MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON1);
end;
function ConfMsgBox(AQuestionString: string;
ADefaultButton: integer = 1): integer;
begin
Result := QueryMsgBox(AQuestionString, ADefaultButton);
end;
function QueryDelMsgBox(ADeleteString: string = QUERY_DELETE_STRING): integer;
begin
Result := QueryMsgBox(ADeleteString, 2);
end;
function QuerySaveMsgBox(ASaveString: string = QUERY_SAVE_STRING): integer;
begin
Result := QueryMsgBox(ASaveString);
end;
function QueryExitMsgBox(AExitString: string = QUERY_EXIT_STRING): integer;
begin
Result := QueryMsgBox(AExitString, 2);
end;
function NotDevelopFinishMsgBox(ANotDevelopFinishString: string = NOT_DEVELOP_FINISH_STRING): integer;
begin
Result := InfoMsgBox(ANotDevelopFinishString);
end;
procedure AsmShutUp;
pascal;
begin
asm
In AL, $61 { Stop Bleeping }
And AL, $FC
Out $61, AL
end;
end;
procedure AsmBeep(Freq: Word);
pascal;
label
Skip;
begin
asm
Push BX
In AL, $61
Mov BL, AL
And AL, 3
Jne Skip
//Jne @Skip
Mov AL, BL
Or AL, 3
Out $61, AL
Mov AL, $B6
Out $43, AL
Skip: Mov AX, Freq
//@Skip: Mov AX, Freq
Out $42, AL
Mov AL, AH
Out $42, AL
Pop BX
end;
end;
procedure HardBleep(Freq: Word;
MSecs: Integer);
var
FirstTickCount: DWord;
begin
if (Freq >= 20) and (Freq <= 5000) then
begin
AsmBeep(Word(1193181 div LongInt(Freq)));
if MSecs >= 0 then
begin
FirstTickCount := GetTickCount;
repeat
if MSecs > 1000 then
Application.ProcessMessages;
//Until ((GetTickCount-FirstTickCount)>LongInt(MSecs));
until (LongInt(GetTickCount - FirstTickCount) > LongInt(MSecs));
AsmShutUp;
end;
end;
end;
var
SysWinNT: Boolean;
proceduredo
Bleep(Freq: Word;
MSecs: Integer);
begin
if SysWinNT then
Windows.Beep(Freq, MSecs)
else
HardBleep(Freq, MSecs);
end;
{ Added to help counter the effects ofdo
Bleep (Freq, -1).
If you are producing a tone, &
you want to stop withoutdo
ing another Bleep, call this procedure }
//Procedure ShutUp;
//begin
// If SysWinNT then
Windows.Beep(1, 0) else
AsmShutUp;
//end;
procedure Bleep(BleepType: TBleepType);
begin
case BleepType of
vOK: begin
do
Bleep(1047, 100);
do
Bleep(1109, 100);
do
Bleep(1175, 100);
end;
vInterrupt: begin
do
Bleep(2093, 100);
do
Bleep(1976, 100);
do
Bleep(1857, 100);
end;
vError: begin
do
Bleep(80, 500);
end;
end;
end;
procedure InitSysType;
var
VersionInfo: TOSVersionInfo;
begin
VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
GetVersionEx(VersionInfo);
SysWinNT := VersionInfo.dwPlatformID = VER_PLATFORM_WIN32_NT;
end;
procedure Sound(dFreq:do
uble;
wLong: word);
var
wFreq: word;
begin
wFreq := round(1192576 / dFreq);
asm
push ax
push bx
push cx
push dx
push di
mov al,0b6h
out 43h,al
mov dx,12h
mov ax,wFreq
out 42h,al
mov al,ah
out 42h,al
in al,61h
mov ah,al
or al,3
out 61h,al
@wait1:mov cx,wLong
@delay:loop @delay
dec bx
jnz @wait1
mov al,0b6h
out 43h,al
mov al,ah
out 61h,al
pop di
pop dx
pop cx
pop bx
pop ax
end;
end;
function DiskInDrive(Drive: Char): Boolean;
var
ErrorMode: word;
begin
{ make it upper case }
if Drive in ['a'..'z'] then
Dec(Drive, $20);
{ make sure it's a letter }
if not (Drive in ['A'..'Z']) then
raise EConvertError.Create('Not a valid drive ID');
{ turn off critical errors }
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
try
{ drive 1 = a, 2 = b, 3 = c, etc. }
if DiskSize(Ord(Drive) - $40) = -1 then
Result := False
else
Result := True;
finally
{ restore old error mode }
SetErrorMode(ErrorMode);
end;
end;
function GetWindowsTempPath: string;
var
TempVar1: array[0..100] of Char;
begin
GetTempPath(100, TempVar1);
Result := trim(string(TempVar1));
end;
function GetLoginName: string;
var
lpBuffer: array[0..100] of Char;
nSize: DWord;
begin
nSize := Sizeof(lpBuffer);
GetUserName(lpBuffer, nSize);
Result := trim(lpBuffer);
end;
function GetItYear(AProcessDate: TDate): integer;
var
TempVar1, TempVar2, TempVar3: word;
begin
decodedate(AProcessDate, TempVar1, TempVar2, TempVar3);
Result := TempVar1;
end;
function GetItMonth(AProcessDate: TDate): integer;
var
TempVar1, TempVar2, TempVar3: word;
begin
decodedate(AProcessDate, TempVar1, TempVar2, TempVar3);
Result := TempVar2;
end;
function GetItDay(AProcessDate: TDate): integer;
var
TempVar1, TempVar2, TempVar3: word;
begin
decodedate(AProcessDate, TempVar1, TempVar2, TempVar3);
Result := TempVar3;
end;
function GetYear: integer;
begin
Result := GetItYear(Date);
end;
function GetMonth: integer;
begin
Result := GetItMonth(Date);
end;
function GetDay: integer;
begin
Result := GetItDay(Date);
end;
function GetFirstDayOfMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
Result := EncodeDate(TempVar1, TempVar2, 1);
end;
function GetLastDayOfMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if (TempVar2 = 12) then
Result := EncodeDate(TempVar1 + 1, 1, 1) - 1
else
Result := EncodeDate(TempVar1, TempVar2 + 1, 1) - 1;
end;
function GetDayCountInMonth(AProcessDate: TDate): integer;
begin
Result := GetItDay(GetLastDayOfMonth(AProcessDate));
end;
function GetFirstDayOfPriorMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if TempVar2 = 1 then
Result := EncodeDate(TempVar1 - 1, 12, 1)
else
Result := EncodeDate(TempVar1, TempVar2 - 1, 1);
end;
function GetLastDayOfPriorMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if TempVar2 = 1 then
begin
Result := EncodeDate(TempVar1 - 1, 12, 31);
end
else
begin
Result := EncodeDate(TempVar1, TempVar2, 1) - 1;
end;
end;
function GetDayCountInPriorMonth(AProcessDate: TDate): integer;
begin
Result := GetItDay(GetLastDayOfPriorMonth(AProcessDate));
end;
function GetFirstDayOfNextMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if (TempVar2 = 12) then
Result := EncodeDate(TempVar1 + 1, 1, 1)
else
Result := EncodeDate(TempVar1, TempVar2 + 1, 1);
end;
function GetLastDayOfNextMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
case TempVar2 of
11: Result := EncodeDate(TempVar1, 12, 31);
12: Result := EncodeDate(TempVar1 + 1, 1, 31);
else
Result := EncodeDate(TempVar1, TempVar2 + 2, 1) - 1;
end;
end;
function GetDayCountInNextMonth(AProcessDate: TDate): integer;
begin
Result := GetItDay(GetLastDayOfNextMonth(AProcessDate));
end;
function OpenWindow(var AForm: TForm;
ATFormClass: TFormClass;
AOwner: TComponent;
AOpenMethod: integer = 1): integer;
begin
AForm := ATFormClass.Create(AOwner);
//AForm.Create(AOwner);
// .CreateParented(AOwner) ;
if AOpenMethod = 0 then
begin
try
AForm.Show;
Result := 0;
except
AForm.free;
Result := -1;
end;
end
else
begin
try
Result := AForm.ShowModal;
AForm.free;
except
Result := -1;
end;
end;
end;
{--- Initialization ---}
initialization
InitSysType;
end.
// Author: WilliamGui //
// Modify Date: 2001-04-20 //
// Visit my personal WebSite: http://21sparrow.yeah.net //
////////////////////////////////////////////////////////////////
unit wgpubcode;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ShellAPI;
{-$define _ENG}
{$DEFINE _BG}
{-$define _BIG5}
{--- Common Function ---}
//About String Function
function StrRepeat(AProcessString: string;
n: integer): string;
const
{$IFDEF _BG}
UNITAGE_STR: string = '&Ccedil;&ordf;°&Ucirc;&Ecirc;°&Ograve;&Uacute;&Ccedil;&ordf;°&Ucirc;&Ecirc;°&Iacute;ò&Ccedil;&ordf;°&Ucirc;&Ecirc;°&Ocirc;&ordf;&frac12;&Ccedil;·&Ouml;';
UPPER_STR: string = '&Aacute;&atilde;&Ograve;&frac14;·&iexcl;&sup2;&Icirc;&Euml;&Aacute;&Icirc;é&Acirc;&frac12;&AElig;&acirc;°&AElig;&frac34;&Aacute;';
CURRENCY_UOM_STR: string = '&Ocirc;&ordf;&frac12;&Ccedil;·&Ouml;';
CURRENCY_SUFFIX_STR: string = '&Otilde;&ucirc;&Otilde;&yacute;&cedil;&ordm;';
{$ENDIF}
{$IFDEF _BIG5}
UNITAGE_STR: string = '&yen;a¨&Otilde;&not;B&raquo;&otilde;&yen;a¨&Otilde;&not;B&Eacute;E&yen;a¨&Otilde;&not;B¤&cedil;¨¤¤&Agrave;';
UPPER_STR: string = '&sup1;s&sup3;ü&para;L°&Ntilde;&cedil;v&yen;&icirc;&sup3;°&not;m&reg;&Atilde;¨h';
CURRENCY_UOM_STR: string = '¤&cedil;¨¤¤&Agrave;';
CURRENCY_SUFFIX_STR: string = '&frac34;&atilde;&yen;&iquest;&shy;t';
{$ENDIF}
//{$ifdef _BG or _BIG5}
{$IFDEF _BG}
function CurrencyToChinese(ACurrency: Currency;
Default: string = ''): string;
{$ENDIF}
//About Datetime Function
function GetItYear(AProcessDate: TDate): integer;
function GetItMonth(AProcessDate: TDate): integer;
function GetItDay(AProcessDate: TDate): integer;
function GetYear: integer;
function GetMonth: integer;
function GetDay: integer;
function GetFirstDayOfMonth(AProcessDate: TDate): TDate;
function GetLastDayOfMonth(AProcessDate: TDate): TDate;
function GetDayCountInMonth(AProcessDate: TDate): integer;
function GetFirstDayOfPriorMonth(AProcessDate: TDate): TDate;
function GetLastDayOfPriorMonth(AProcessDate: TDate): TDate;
function GetDayCountInPriorMonth(AProcessDate: TDate): integer;
function GetFirstDayOfNextMonth(AProcessDate: TDate): TDate;
function GetLastDayOfNextMonth(AProcessDate: TDate): TDate;
function GetDayCountInNextMonth(AProcessDate: TDate): integer;
{--- MessageBox ---}
const
{$IFDEF _ENG}
TIP_STRING = 'Tip';
WARNING_STRING = 'Warning';
ERROR_STRING = 'Error';
CONFIRM_STRING = 'Confirm';
QUERY_DELETE_STRING = ' Are you sure to delete this record(Y/N)? ';
QUERY_SAVE_STRING = ' Are you save it(Y/N)? ';
QUERY_EXIT_STRING = ' Are you sure to exit(Y/N)? ';
NOT_DEVELOP_FINISH_STRING = ' The function is developing ...... ';
{$ENDIF}
{$IFDEF _BG}
TIP_STRING = '&Igrave;á&Ecirc;&frac34;';
WARNING_STRING = '&frac34;&macr;&cedil;&aelig;';
ERROR_STRING = '&acute;í&Icirc;ó';
CONFIRM_STRING = '&Egrave;·&Egrave;&Iuml;';
QUERY_DELETE_STRING = ' &Ecirc;&Ccedil;·&ntilde;&Ograve;&ordf;&Eacute;&frac34;&sup3;&yacute;&Otilde;&acirc;&Igrave;&otilde;&frac14;&Ccedil;&Acirc;&frac14;(Y/N)? ';
QUERY_SAVE_STRING = ' &Ecirc;&Ccedil;·&ntilde;&acute;&aelig;&Aring;&Igrave;(Y/N)? ';
QUERY_EXIT_STRING = ' &Ecirc;&Ccedil;·&ntilde;&Otilde;&aelig;&micro;&Atilde;&Ograve;&ordf;&Iacute;&Euml;&sup3;&ouml;(Y/N)? ';
NOT_DEVELOP_FINISH_STRING = ' &cedil;&Atilde;&sup1;&brvbar;&Auml;&Uuml;&raquo;&sup1;&Ocirc;&Uacute;&iquest;&ordf;·&cent;&Ouml;&ETH;...... ';
{$ENDIF}
{$IFDEF _BIG5}
TIP_STRING = '&acute;&pound;&yen;&Uuml;';
WARNING_STRING = '&Auml;&micro;§i';
ERROR_STRING = '&iquest;ù&raquo;~';
CONFIRM_STRING = '&frac12;T&raquo;{';
QUERY_DELETE_STRING = ' &not;O§_&shy;n§R°&pound;&sup3;o±&oslash;°O&iquest;&yacute;(Y/N)? ';
QUERY_SAVE_STRING = ' &not;O§_&brvbar;s&frac12;L(Y/N)? ';
QUERY_EXIT_STRING = ' &not;O§_&macr;u±o&shy;n°h&yen;X(Y/N)? ';
NOT_DEVELOP_FINISH_STRING = ' &cedil;&Oacute;&yen;/&macr;à&Aacute;&Ugrave;&brvbar;b&para;}&micro;o¤¤...... ';
{$ENDIF}
{ New MessageBox 2001/08/01}
function InfoMsgBox(AInformationString: string): integer;
function WarningMsgBox(AWarningString: string): integer;
function ErrorMsgBox(AErrorString: string): integer;
function QueryMsgBox(AQuestionString: string;
ADefaultButton: integer = 1): integer;
function ConfMsgBox(AQuestionString: string;
ADefaultButton: integer = 1): integer;
function QueryDelMsgBox(ADeleteString: string = QUERY_DELETE_STRING): integer;
function QuerySaveMsgBox(ASaveString: string = QUERY_SAVE_STRING): integer;
function QueryExitMsgBox(AExitString: string = QUERY_EXIT_STRING): integer;
function NotDevelopFinishMsgBox(ANotDevelopFinishString: string = NOT_DEVELOP_FINISH_STRING): integer;
{--- Windows ---}
function OpenWindow(var AForm: TForm;
ATFormClass: TFormClass;
AOwner: TComponent;
AOpenMethod: integer = 1): integer;
{--- Voice ---}
type
TBleepType = (vOK, vInterrupt, vError);
procedure Bleep(BleepType: TBleepType);
//·&cent;&sup3;&ouml;&Eacute;ù&Ograve;&ocirc;
procedure Sound(dFreq:do
uble;
wLong: word);
//·&cent;&sup3;&ouml;&cedil;÷&Ograve;&ocirc;&frac12;×&Eacute;ù&Ograve;&ocirc;
{ #49,#97: sound(261.7,400);
C
#50,#98: sound(293.7,400);
D
#51,#99: sound(329.6,400);
E
#52,#100: sound(349.2,400);
F
#53,#101: sound(392.0,400);
G
#54,#102: sound(440.0,400);
A
#55,#103: sound(493.9,400);
B }
{--- About System ---}
function DiskInDrive(Drive: Char): Boolean;
//&Ccedil;&yacute;&para;&macr;&AElig;÷&Ecirc;&Ccedil;·&ntilde;×&frac14;±&cedil;&ordm;&Atilde;
function GetWindowsTempPath: string;
{--- About Network ---}
function GetLoginName: string;
{--- Code ---}
implementation
function StrRepeat(AProcessString: string;
n: integer): string;
var
i: integer;
TempVar: string;
begin
TempVar := '';
for i := 1 to ndo
begin
TempVar := TempVar + AProcessString;
end;
Result := TempVar;
end;
{$IFNDEF _ENG}
function CurrencyToChinese(ACurrency: Currency;
Default: string = ''): string;
function RightStr(S: string;
N: Integer): string;
// ·&micro;&raquo;&Oslash;&Ouml;&cedil;&para;¨×&Ouml;·&ucirc;&acute;&reg;&micro;&Auml;&Oacute;&Ograve;±&szlig;
N &cedil;&ouml;×&Ouml;·&ucirc;
var
Start: Integer;
begin
Start := Length(S) - N + 1;
if Start <= Length(S) then
Result := Copy(S, Start, N)
else
Result := '';
end;
var
LowStr: string;
// &ETH;&iexcl;&ETH;&acute;&frac12;&eth;&para;&icirc;×&Ouml;·&ucirc;&acute;&reg;
CurrentChar: Char;
// &micro;±&Ccedil;°&Ecirc;&yacute;&Ouml;&micro;&micro;&Auml;ASCII&Acirc;&euml;
CurrentNum: Integer;
// &micro;±&Ccedil;°&Ecirc;&yacute;&Ouml;&micro;
UpperStr, UnitageChar: string[4];
// &acute;ó&ETH;&acute;&frac12;&eth;&para;&icirc;×&Ouml;·&ucirc;&acute;&reg;&ordm;&Iacute;&frac12;&eth;&para;&icirc;&micro;&yen;&Icirc;&raquo;×&Ouml;·&ucirc;&acute;&reg;
CurrentPos, UnitagePos: Integer;
// &Euml;÷&Ograve;&yacute;
begin
// Is Zero?
if ACurrency = 0 then
begin
Result := Default;
Exit;
end;
Result := '';
FmtStr(LowStr, '%15.2f', [ACurrency]);
// Convert to string
LowStr := Trim(LowStr);
if ACurrency < 0 then
LowStr := Copy(LowStr, 2, Length(LowStr) - 1);
// &Egrave;&ccedil;&sup1;&ucirc;&Ecirc;&Ccedil;&cedil;&ordm;&Ouml;&micro;&pound;&not;&Iuml;&Egrave;°&Ntilde;×&Ouml;·&ucirc;&acute;&reg;&Agrave;&iuml;&micro;&Auml;&Auml;&Ccedil;&cedil;&ouml;&cedil;&ordm;&ordm;&Aring;&Egrave;&yen;&micro;&ocirc;
CurrentPos := 1;
UnitagePos := 15 - Length(LowStr);
while UnitagePos < 14do
begin
CurrentChar := LowStr[CurrentPos];
// &Egrave;&iexcl;&micro;±&Ccedil;°&Icirc;&raquo;&Ecirc;&yacute;×&Ouml;
if (CurrentChar > '9') or (CurrentChar < '0') then
begin
// &Egrave;&iexcl;&micro;&frac12;&micro;&Auml;×&Ouml;·&ucirc;&iquest;&Eacute;&Auml;&Uuml;&sup2;&raquo;&Ecirc;&Ccedil;&Ecirc;&yacute;×&Ouml;&pound;¨±&Egrave;&Egrave;&ccedil;&Euml;&micro;&Ecirc;&Ccedil;&ETH;&iexcl;&Ecirc;&yacute;&micro;&atilde;&pound;&copy;
Inc(CurrentPos);
Continue;
end;
CurrentNum := Ord(CurrentChar) - Ord('0');
// &Egrave;&iexcl;&micro;±&Ccedil;°&Ecirc;&yacute;×&Ouml;&micro;&Auml;&Ouml;&micro;
UpperStr := Copy(UPPER_STR, (CurrentNum shl 1) + 1, 2);
// &Egrave;&iexcl;&Iuml;à&Oacute;&brvbar;&micro;&Auml;&acute;ó&ETH;&acute;&Ouml;&ETH;&Icirc;&Auml;
UnitageChar := Copy(UNITAGE_STR, (UnitagePos shl 1) + 1, 2);
// &Iuml;à&Oacute;&brvbar;&micro;&Auml;&micro;&yen;&Icirc;&raquo;
if (CurrentNum <> 0) then
begin
// &Egrave;&ccedil;&sup1;&ucirc;&Egrave;&iexcl;&micro;&Atilde;&micro;&Auml;&Ecirc;&yacute;×&Ouml;&sup2;&raquo;&Ecirc;&Ccedil;&Aacute;&atilde;&pound;&not;&ordm;&Uuml;&frac14;ò&micro;&yen;&pound;&not;&Ocirc;&Uacute;×&Ouml;·&ucirc;&acute;&reg;&ordm;ó&Atilde;&aelig;&Igrave;í&frac14;&Oacute;&Eacute;&Iuml;&Ecirc;&yacute;&Ouml;&micro;&ordm;&Iacute;&micro;&yen;&Icirc;&raquo;&frac34;&Iacute;&ETH;&ETH;&Aacute;&Euml;
Result := Result + UpperStr + UnitageChar;
Inc(UnitagePos);
Inc(CurrentPos);
Continue;
end;
if RightStr(Result, 2) <> copy(UPPER_STR, 1, 2) then
Result := Result + copy(UPPER_STR, 1, 2);
// &Ecirc;&Ccedil;&Aacute;&atilde;&frac34;&Iacute;&Acirc;é·&sup3;&Aacute;&Euml;&pound;&not;&Iuml;&Egrave;&iquest;&acute;&iquest;&acute;&Ecirc;&Ccedil;&sup2;&raquo;&Ecirc;&Ccedil;&Ouml;&Oslash;&cedil;&acute;&Aacute;&atilde;&pound;&not;&sup2;&raquo;&Ecirc;&Ccedil;&frac34;&Iacute;&Iuml;&Egrave;&frac14;&Oacute;&Ograve;&raquo;&cedil;&ouml;'&Aacute;&atilde;'&Ocirc;&Ugrave;&Euml;&micro;
{ &Egrave;&ccedil;&sup1;&ucirc;&Ecirc;&Ccedil;&Aacute;&atilde;&Ccedil;&Ograve;&Oacute;&Ouml;&Otilde;&yacute;&ordm;&Atilde;&Ocirc;&Uacute;'&Ograve;&Uacute;'&iexcl;&cent;'&Iacute;ò'&iexcl;&cent;'&Ocirc;&ordf;'&Otilde;&acirc;&Egrave;&yacute;&cedil;&ouml;&Icirc;&raquo;&Ouml;&Atilde;&Eacute;&Iuml;&pound;&not;&frac34;&Iacute;&iexcl;&shy;&iexcl;&shy;
&acute;ó&frac14;&Ograve;&para;&frac14;&Ccedil;&aring;&sup3;&thorn;&pound;&not;&Atilde;&raquo;&Oacute;&ETH;'&sup2;&Icirc;&Ecirc;°&Aacute;&atilde;&Ocirc;&ordf;'&raquo;ò'·&iexcl;&Ecirc;°&Aacute;&atilde;&Iacute;ò&frac34;&Aacute;&Ccedil;&ordf;'&Otilde;&acirc;&Ouml;&Ouml;&Euml;&micro;·¨&pound;&not;&Ouml;&raquo;&Oacute;&ETH;
'&sup2;&Icirc;&Ecirc;°&Ocirc;&ordf;'&ordm;&Iacute;'·&iexcl;&Ecirc;°&Iacute;ò&frac34;&Aacute;&Ccedil;&ordf;'&pound;&not;&Ograve;ò&acute;&Euml;&Ograve;&ordf;&Eacute;&frac34;&Egrave;&yen;&Eacute;&Iuml;&Atilde;&aelig;&Auml;&Ccedil;&frac34;&auml;&acute;ú&Acirc;&euml;&Euml;ù&frac14;&Oacute;&micro;&Auml;'&Aacute;&atilde;'×&Ouml;·&ucirc;
}
if (UnitageChar = copy(UNITAGE_STR, 7, 2)) or (UnitageChar = copy(UNITAGE_STR, 15, 2)) or (UnitageChar = '¤&cedil;') then
begin
Delete(Result, Length(Result) - 1, 2);
if RightStr(Result, 2) <> copy(UNITAGE_STR, 7, 2) then
Result := Result + UnitageChar;
// &raquo;&sup1;&Ograve;&ordf;&iquest;&acute;&iquest;&acute;&Ccedil;°&Ograve;&raquo;&Icirc;&raquo;&Ecirc;&Ccedil;&sup2;&raquo;&Ecirc;&Ccedil;'&Ograve;&Uacute;'&Icirc;&raquo;&pound;&not;&Ecirc;&Ccedil;&frac34;&Iacute;&sup2;&raquo;&frac14;&Oacute;&micro;&yen;&Icirc;&raquo;&Aacute;&Euml;
Result := Result + copy(UPPER_STR, 1, 2);
end;
Inc(UnitagePos);
Inc(CurrentPos);
end;
if RightStr(Result, 2) = copy(UPPER_STR, 1, 2) then
Result := Copy(Result, 1, Length(Result) - 2);
// &Ntilde;&frac12;&pound;&not;&Ouml;&Otilde;&Oacute;&Uacute;×&ordf;&raquo;&raquo;&Iacute;ê&Aacute;&Euml;&pound;&not;±&eth;&Atilde;&brvbar;&pound;&not;&Egrave;&ccedil;&sup1;&ucirc;&frac12;á&sup1;&ucirc;&micro;&Auml;&Auml;&copy;&Icirc;&sup2;&Ecirc;&Ccedil;'&Aacute;&atilde;'&raquo;&sup1;&Ograve;&ordf;&Eacute;&frac34;&Egrave;&yen;&Euml;ü
if Copy(Result, 1, 2) = copy(UPPER_STR, 1, 2) then
Result := Copy(Result, 3, Length(Result) - 2);
// &Egrave;&ccedil;&sup1;&ucirc;&frac12;á&sup1;&ucirc;&micro;&Auml;&iquest;&ordf;&Ecirc;&frac14;&frac34;&Iacute;&Ecirc;&Ccedil;&Aacute;&atilde;&pound;&not;&Ograve;&sup2;&Ograve;&ordf;&Eacute;&frac34;&sup3;&yacute;&Euml;ü
if RightStr(Result, 2) = copy(CURRENCY_UOM_STR, 3, 2) then
Result := Result + copy(CURRENCY_SUFFIX_STR, 3, 2) // &Egrave;&ccedil;&sup1;&ucirc;&frac12;á&sup1;&ucirc;&Otilde;&yacute;&ordm;&Atilde;&Ecirc;&Ccedil;'XXXX&frac12;&Ccedil;'&pound;&not;°&acute;&Iuml;°&sup1;&szlig;&Oacute;&brvbar;&cedil;&Atilde;&frac14;&Oacute;&Eacute;&Iuml;&Ograve;&raquo;&cedil;&ouml;'XXXX&frac12;&Ccedil;&Otilde;&yacute;'
else
if RightStr(Result, 2) <> copy(CURRENCY_UOM_STR, 5, 2) then
Result := Result + copy(CURRENCY_SUFFIX_STR, 1, 2);
// &Egrave;&ccedil;&sup1;&ucirc;&frac12;á&sup1;&ucirc;&sup2;&raquo;&Ecirc;&Ccedil;'XXXX·&Ouml;&pound;&not;&frac34;&Iacute;&Ograve;&ordf;&frac14;&Oacute;&Eacute;&Iuml;&Ograve;&raquo;&cedil;&ouml;'&Otilde;&ucirc;'×&Ouml;
if Copy(Result, 1, 2) = copy(CURRENCY_UOM_STR, 1, 2) then
Result := RightStr(Result, Length(Result) - 4);
// &raquo;&sup1;&Oacute;&ETH;&Ograve;&raquo;&cedil;&ouml;&ETH;&iexcl;&Icirc;&Ecirc;&Igrave;&acirc;&pound;&not;&frac34;&Iacute;&Ecirc;&Ccedil;......
if ACurrency < 0 then
Result := copy(CURRENCY_SUFFIX_STR, 5, 2) + Result;
// ×&icirc;&ordm;ó&pound;&not;&Egrave;&ccedil;&sup1;&ucirc;&Ecirc;&Ccedil;&cedil;&ordm;&Ouml;&micro;&raquo;&sup1;&Ograve;&ordf;&frac14;&Oacute;&Eacute;&Iuml;&Ograve;&raquo;&cedil;&ouml;'&cedil;&ordm;'
end;
{$ENDIF}
function InfoMsgBox(AInformationString: string): integer;
begin
Result := MessageBox(GetActiveWindow, PChar(AInformationString), PChar(TIP_STRING), MB_ICONINFORMATION + MB_OK);
end;
function WarningMsgBox(AWarningString: string): integer;
begin
Result := MessageBox(GetActiveWindow, PChar(AWarningString), PChar(WARNING_STRING), MB_ICONWARNING + MB_OK);
end;
function ErrorMsgBox(AErrorString: string): integer;
begin
Result := MessageBox(GetActiveWindow, PChar(AErrorString), PChar(ERROR_STRING), MB_ICONERROR + MB_OK);
end;
function QueryMsgBox(AQuestionString: string;
ADefaultButton: integer = 1): integer;
begin
if ADefaultButton = 2 then
Result := MessageBox(GetActiveWindow, PChar(AQuestionString), PChar(CONFIRM_STRING), MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2)
else
Result := MessageBox(GetActiveWindow, PChar(AQuestionString), PChar(CONFIRM_STRING), MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON1);
end;
function ConfMsgBox(AQuestionString: string;
ADefaultButton: integer = 1): integer;
begin
Result := QueryMsgBox(AQuestionString, ADefaultButton);
end;
function QueryDelMsgBox(ADeleteString: string = QUERY_DELETE_STRING): integer;
begin
Result := QueryMsgBox(ADeleteString, 2);
end;
function QuerySaveMsgBox(ASaveString: string = QUERY_SAVE_STRING): integer;
begin
Result := QueryMsgBox(ASaveString);
end;
function QueryExitMsgBox(AExitString: string = QUERY_EXIT_STRING): integer;
begin
Result := QueryMsgBox(AExitString, 2);
end;
function NotDevelopFinishMsgBox(ANotDevelopFinishString: string = NOT_DEVELOP_FINISH_STRING): integer;
begin
Result := InfoMsgBox(ANotDevelopFinishString);
end;
procedure AsmShutUp;
pascal;
begin
asm
In AL, $61 { Stop Bleeping }
And AL, $FC
Out $61, AL
end;
end;
procedure AsmBeep(Freq: Word);
pascal;
label
Skip;
begin
asm
Push BX
In AL, $61
Mov BL, AL
And AL, 3
Jne Skip
//Jne @Skip
Mov AL, BL
Or AL, 3
Out $61, AL
Mov AL, $B6
Out $43, AL
Skip: Mov AX, Freq
//@Skip: Mov AX, Freq
Out $42, AL
Mov AL, AH
Out $42, AL
Pop BX
end;
end;
procedure HardBleep(Freq: Word;
MSecs: Integer);
var
FirstTickCount: DWord;
begin
if (Freq >= 20) and (Freq <= 5000) then
begin
AsmBeep(Word(1193181 div LongInt(Freq)));
if MSecs >= 0 then
begin
FirstTickCount := GetTickCount;
repeat
if MSecs > 1000 then
Application.ProcessMessages;
//Until ((GetTickCount-FirstTickCount)>LongInt(MSecs));
until (LongInt(GetTickCount - FirstTickCount) > LongInt(MSecs));
AsmShutUp;
end;
end;
end;
var
SysWinNT: Boolean;
proceduredo
Bleep(Freq: Word;
MSecs: Integer);
begin
if SysWinNT then
Windows.Beep(Freq, MSecs)
else
HardBleep(Freq, MSecs);
end;
{ Added to help counter the effects ofdo
Bleep (Freq, -1).
If you are producing a tone, &
you want to stop withoutdo
ing another Bleep, call this procedure }
//Procedure ShutUp;
//begin
// If SysWinNT then
Windows.Beep(1, 0) else
AsmShutUp;
//end;
procedure Bleep(BleepType: TBleepType);
begin
case BleepType of
vOK: begin
do
Bleep(1047, 100);
do
Bleep(1109, 100);
do
Bleep(1175, 100);
end;
vInterrupt: begin
do
Bleep(2093, 100);
do
Bleep(1976, 100);
do
Bleep(1857, 100);
end;
vError: begin
do
Bleep(80, 500);
end;
end;
end;
procedure InitSysType;
var
VersionInfo: TOSVersionInfo;
begin
VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
GetVersionEx(VersionInfo);
SysWinNT := VersionInfo.dwPlatformID = VER_PLATFORM_WIN32_NT;
end;
procedure Sound(dFreq:do
uble;
wLong: word);
var
wFreq: word;
begin
wFreq := round(1192576 / dFreq);
asm
push ax
push bx
push cx
push dx
push di
mov al,0b6h
out 43h,al
mov dx,12h
mov ax,wFreq
out 42h,al
mov al,ah
out 42h,al
in al,61h
mov ah,al
or al,3
out 61h,al
@wait1:mov cx,wLong
@delay:loop @delay
dec bx
jnz @wait1
mov al,0b6h
out 43h,al
mov al,ah
out 61h,al
pop di
pop dx
pop cx
pop bx
pop ax
end;
end;
function DiskInDrive(Drive: Char): Boolean;
var
ErrorMode: word;
begin
{ make it upper case }
if Drive in ['a'..'z'] then
Dec(Drive, $20);
{ make sure it's a letter }
if not (Drive in ['A'..'Z']) then
raise EConvertError.Create('Not a valid drive ID');
{ turn off critical errors }
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
try
{ drive 1 = a, 2 = b, 3 = c, etc. }
if DiskSize(Ord(Drive) - $40) = -1 then
Result := False
else
Result := True;
finally
{ restore old error mode }
SetErrorMode(ErrorMode);
end;
end;
function GetWindowsTempPath: string;
var
TempVar1: array[0..100] of Char;
begin
GetTempPath(100, TempVar1);
Result := trim(string(TempVar1));
end;
function GetLoginName: string;
var
lpBuffer: array[0..100] of Char;
nSize: DWord;
begin
nSize := Sizeof(lpBuffer);
GetUserName(lpBuffer, nSize);
Result := trim(lpBuffer);
end;
function GetItYear(AProcessDate: TDate): integer;
var
TempVar1, TempVar2, TempVar3: word;
begin
decodedate(AProcessDate, TempVar1, TempVar2, TempVar3);
Result := TempVar1;
end;
function GetItMonth(AProcessDate: TDate): integer;
var
TempVar1, TempVar2, TempVar3: word;
begin
decodedate(AProcessDate, TempVar1, TempVar2, TempVar3);
Result := TempVar2;
end;
function GetItDay(AProcessDate: TDate): integer;
var
TempVar1, TempVar2, TempVar3: word;
begin
decodedate(AProcessDate, TempVar1, TempVar2, TempVar3);
Result := TempVar3;
end;
function GetYear: integer;
begin
Result := GetItYear(Date);
end;
function GetMonth: integer;
begin
Result := GetItMonth(Date);
end;
function GetDay: integer;
begin
Result := GetItDay(Date);
end;
function GetFirstDayOfMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
Result := EncodeDate(TempVar1, TempVar2, 1);
end;
function GetLastDayOfMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if (TempVar2 = 12) then
Result := EncodeDate(TempVar1 + 1, 1, 1) - 1
else
Result := EncodeDate(TempVar1, TempVar2 + 1, 1) - 1;
end;
function GetDayCountInMonth(AProcessDate: TDate): integer;
begin
Result := GetItDay(GetLastDayOfMonth(AProcessDate));
end;
function GetFirstDayOfPriorMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if TempVar2 = 1 then
Result := EncodeDate(TempVar1 - 1, 12, 1)
else
Result := EncodeDate(TempVar1, TempVar2 - 1, 1);
end;
function GetLastDayOfPriorMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if TempVar2 = 1 then
begin
Result := EncodeDate(TempVar1 - 1, 12, 31);
end
else
begin
Result := EncodeDate(TempVar1, TempVar2, 1) - 1;
end;
end;
function GetDayCountInPriorMonth(AProcessDate: TDate): integer;
begin
Result := GetItDay(GetLastDayOfPriorMonth(AProcessDate));
end;
function GetFirstDayOfNextMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if (TempVar2 = 12) then
Result := EncodeDate(TempVar1 + 1, 1, 1)
else
Result := EncodeDate(TempVar1, TempVar2 + 1, 1);
end;
function GetLastDayOfNextMonth(AProcessDate: TDate): TDate;
var
TempVar1, TempVar2, TempVar3: word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
case TempVar2 of
11: Result := EncodeDate(TempVar1, 12, 31);
12: Result := EncodeDate(TempVar1 + 1, 1, 31);
else
Result := EncodeDate(TempVar1, TempVar2 + 2, 1) - 1;
end;
end;
function GetDayCountInNextMonth(AProcessDate: TDate): integer;
begin
Result := GetItDay(GetLastDayOfNextMonth(AProcessDate));
end;
function OpenWindow(var AForm: TForm;
ATFormClass: TFormClass;
AOwner: TComponent;
AOpenMethod: integer = 1): integer;
begin
AForm := ATFormClass.Create(AOwner);
//AForm.Create(AOwner);
// .CreateParented(AOwner) ;
if AOpenMethod = 0 then
begin
try
AForm.Show;
Result := 0;
except
AForm.free;
Result := -1;
end;
end
else
begin
try
Result := AForm.ShowModal;
AForm.free;
except
Result := -1;
end;
end;
end;
{--- Initialization ---}
initialization
InitSysType;
end.
S
SS2000
Unregistered / Unconfirmed
GUEST, unregistred user!
date-1
就行，偏有人搞那么麻烦，好几百行程序
就行，偏有人搞那么麻烦，好几百行程序
Y
YNTW
Unregistered / Unconfirmed
GUEST, unregistred user!
倒，楼上那位老大也太夸张了
B
BILL_OWEN
Unregistered / Unconfirmed
GUEST, unregistred user!
我在写每月销售明细报表中习惯这样做：
报表要求是：求出每天的进销存情况；
假若要求2月份：我将最后的日期定为：'2001/3/1'
for i:=1 to strtodate('2001/3/1')-1do
begin
end;
报表要求是：求出每天的进销存情况；
假若要求2月份：我将最后的日期定为：'2001/3/1'
for i:=1 to strtodate('2001/3/1')-1do
begin
end;
曹
曹晓钢
Unregistered / Unconfirmed
GUEST, unregistred user!
[red]拜托！
这里是Jsp版！[/red]
to hyc991:
你需要的是一个java.util.Calendar 类。
Locale locale=Locale.getDefault();
TomeZone timeZone=TimeZone.getDefault();
Calendar cal=Calendar.getInstance(timeZone,locale);
cal.set(Calendar.DAY_OF_MONTH,cal.get(Calendar.DAY_OF_MONTH)-1);
现在cal里面的就是前一天了.
如果你想要java.util.Date，再
java.util.Date d = cal.getTime();
如果你要java.sql.Date,再
java.sql.Date sqld = d.getTime();
这里是Jsp版！[/red]
to hyc991:
你需要的是一个java.util.Calendar 类。
Locale locale=Locale.getDefault();
TomeZone timeZone=TimeZone.getDefault();
Calendar cal=Calendar.getInstance(timeZone,locale);
cal.set(Calendar.DAY_OF_MONTH,cal.get(Calendar.DAY_OF_MONTH)-1);
现在cal里面的就是前一天了.
如果你想要java.util.Date，再
java.util.Date d = cal.getTime();
如果你要java.sql.Date,再
java.sql.Date sqld = d.getTime();
H
hyc991
Unregistered / Unconfirmed
GUEST, unregistred user!
接受答案了.
Similar threads
- 回复
- 4
- 查看
- 4K