?? untpub.~pas
字號:
Procedure GetErrorInfo(var iErrorCode: integer; var sErrorMsg: string);
begin
iErrorCode := _iErrorCode;
sErrorMsg := _sErrorMsg;
end;
// ★★★
// 功能:字符型數據轉換成浮點型的較驗涵數
// 調用方法::MyStrToFloat(要轉換的值,iNum)=False/True,其中iNum引用要定義
function MyStrToFloat(const sText: string; var iNum: Double): boolean;
begin
try
iNum:=StrToFloat(sText);
result:=true;
except
result:=false;
end;
end;
// ★★★
//日期轉換校驗函數
//調用方法:MyStrToDate(要轉換的值,dtDate)=False/true,其中dtDate引用要定義
function MyStrToDate(const sDate:string; var dtDate:TDate):boolean;
begin
try
begin
dtDate:=StrToDate(sDate);
Result:=true;
end;
except
result:=false;
end;
end;
// ★★★
// 功能:字符型數據轉換成數字型的較驗涵數
// 調用方法::MyStrToInt(要轉換的值,iNum)=False/True,其中iNum引用要定義
function MyStrToInt(const sText: string; var iNum: integer): boolean;
begin
try
iNum:=StrtoInt(SText);
result:=true;
except
result:=false;
end;
end;
// ★★★
//日期型轉換成字符型,用于數據表的明細顯示的函數
//調用方法:將要轉換的日期類型賦給本函數就可
function MyDateToStr(const dtDate: Tdate; var sDate: string): boolean;
begin
try
if dtDate=0 then
sDate:='' //當日期型為0時,返回值;為空
else
sDate:=DateToStr(dtDate);
result:=true;
except
result:=false;
end;
end;
// ★★★
// 返回兩個日期之間的月份數
// 同一個年月的日期返回0, 依次類推.
function GetMonthsBetweenTwoDate(const dtD1, dtD2: TDateTime): Integer;
var
dtDA, dtDB: TDateTime;
wY1, wM1, wD1: word;
wY2, wM2, wD2: word;
begin
if dtD1>=dtD2 then
begin
dtDA := dtD2;
dtDB := dtD1;
end
else
begin
dtDA := dtD1;
dtDB := dtD2;
end;
DecodeDate(dtDA, wY1, wM1, wD1);
DecodeDate(dtDB, wY2, wM2, wD2);
Result := (wY2-wY1)*12 + (wM2-wM1);
end;
// ★★★
// 相對于 dtDate, 計算新日期.
// 新日期與 dtDate 有 iDltYear 年 iDltMonth 月 iDltDay 天的差距.
// iDltYear, iDltMonth, iDltDay 可以為負數, -12 < iDltMonth < 12
function GetNextDate(const dtDate: TDate; const iDltYear, iDltMonth, iDltDay: integer): TDate;
var
dtTmp: TDate;
wY, wM, wD: word;
begin
dtTmp := dtDate + iDltDay;
DecodeDate(dtTmp, wY, wM, wD);
wY := wY + iDLtYear;
wM := wM + iDltMonth;
if wM > 12 then
begin
wY := wY + wM div 12;
wM := wM mod 12; // 適應任何月份差異
end
else if wM <= 0 then // 繼續改進
begin
wM := wM + 12;
wY := wY - 1;
{
wY := wY + wM div 12;
wM := wM mod 12; // 適應任何月份差異
}
end;
try
Result := EncodeDate(wY, wM, wD);
except // 出錯的唯一可能:xxxx.02.29 無對應的下一個日期, 改為 xxxx.02.28
Result := EncodeDate(wY, 2, 28);
end;
end;
//★★★
// 根據人的身份證號碼求出生日期
function GetBirthday(const sInsQueryID: string; var dtBirthday: TDate): boolean;
const
iY2K: Integer = 0; // 決定年份, 以判斷2000年前出生或2000年后出生 ★★★★★
iP18: Integer = 7; // 18位身份證的生日日期起始位置 ★★★★★
var
sYear, sMonth, sDay: string;
begin
try
// 18位身份證號碼處理
if Length(sInsQueryID) = 18 then
begin
sYear := Copy(sInsQueryID,iP18,4);
sMonth:= Copy(sInsQueryID,iP18+4,2);
sDay := Copy(sInsQueryID,iP18+6,2);
end
else // 15位身份證號碼處理
begin
sYear := Copy(sInsQueryID,7,2);
sMonth:= Copy(sInsQueryID,9,2);
sDay := Copy(sInsQueryID,11,2);
if StrToInt(sYear) < iY2K then
sYear:= '20' + sYear
else
sYear:= '19' + sYear;
end;
dtBirthday := EncodeDate(StrToInt(sYear),StrToInt(sMonth),StrToInt(sDay));
Result := true;
except
Result:= false;
end;
end;
// 將一表單在另一主表單客戶區居中
// 參數:frmMain: 主表單, frmSub: 待居中的子表單
// iOffset: 垂直方向其他對象占用高度(缺省為0)
// 例如:CenterForm(frmClinicMain, frmRegister, Toolbar.height)
Procedure CenterForm(frmMain, frmSub: TCustomForm; const iOffset: integer=0);
var
p: TPoint;
bHf, bVf: boolean;
begin
bHf:=false; bVf:=false;
with frmMain do
begin
if ClientWidth > frmSub.width then
p.x := ( ClientWidth - frmSub.width) div 2
else
begin
p.x :=0;
bHf:=true;
end;
if ClientHeight + iOffset > frmSub.height then
p.y := (( Clientheight + iOffset - frmSub.height) div 2)
else
begin
p.y :=0;
bVf:=true;
end;
p:= ClientToScreen(p);
if bVf then
frmSub.Top :=0
else
if p.y>=0 then
frmSub.Top := p.y;
if bHf then
frmSub.left :=0
else
if p.x>=0 then
frmSub.left := p.x ;
end;
end;
// Blob 字段 --> OLE 控件
function OLEFieldToContainer(var fldWhich: TBlobField; var ocWhich: TOLEContainer;
const sInitFile: string = ''):boolean;
var
bsOLE: TBlobStream;
begin
result:=true;
try
// 打開 Query.Field 流
bsOLE := TBlobStream.Create(fldWhich, bmRead);
// 讀到 OLE 構件
try
if bsOLE.Size = 0 then // 初始化 ocWhich: 創建一個嵌入對象
begin
if sInitFile='' then
ocWhich.createObjectFromFile(_sAppPath+'Emp.doc', false)
else
ocWhich.createObjectFromFile(_sAppPath+sInitFile, false);
end
else
begin
ocWhich.LoadFromStream(bsOLE);
end;
except
on E:exception do
begin
ErrorHandler(E,'OLEFieldToContainer');
result:=false;
end;
end;
finally
// 關閉 Query.F_OLE 流
bsOLE.Free;
end;
end;
// Blob 控件 --> 字段
function OLEContainerToField(var fldWhich: TBlobField; var ocWhich: TOLEContainer):boolean;
var
bsOLE: TBlobStream;
begin
result:=true;
try
// 打開 Table.Field 流, 清除原數據
bsOLE := TBlobStream.Create(fldWhich, bmReadWrite);
bsOLE.Seek(0, soFromBeginning);
bsOLE.Truncate;
try
// 從 OLE 構件寫入
ocWhich.SaveToStream(bsOLE);
except
on E:exception do
begin
ErrorHandler(E,'OLEContainerToField');
result:=false;
end;
end;
finally
// 關閉 Table1.Field 流
bsOLE.Free;
end;
end;
//★★★
// 根據數據庫代碼返回數據庫類別的字符串
function GetDBSName(const iDBSType: integer): string;
begin
case iDBSType of
1: // _iDBAccess = 1;
Result := 'MSACCESS';
2: // _iDBOracle = 2;
Result := 'ORACLE';
3: // _iDBSybase = 3;
Result := 'SYBASE';
4: // _iDBMSSQL = 4;
Result := 'MSSQL';
5: // _iDBDBF = 5;
Result := 'STANDARD';
else
Result := 'UNKNOW';
end;
end;
//★★★
// 文件拷貝,綜合報錯
function DiskCopyFile(const SourceFile:string;const TargetFile:string):boolean;
var
SourceFileName,SourcePathName:string;
TargetFileName,TargetPathName:string;
iErr: integer;
begin
Result := false;
SourceFileName:=ExtractFileName(SourceFile);
SourcePathName:=ExtractFilePath(SourceFile);
TargetFileName:=ExtractFileName(TargetFile);
TargetPathName:=ExtractFilePath(TargetFile);
copyFile(Pchar(SourceFile),Pchar(TargetFile),False);
iErr := GetLastError;
case iErr of
0:
Result := true;
21, 5: //未插入盤
Application.MessageBox(pchar(' 未插入軟盤 '),pchar(_sAppTitle),
mb_IconWarning+mb_ok);
2: //源文件不存在
Application.MessageBox(pchar('源文件不存在:'+#13+#13+SourceFileName),
pchar(_sAppTitle),
mb_IconWarning+mb_ok);
3: //目標文件的目錄不存在
Application.MessageBox(pchar('目標文件的目錄不存在:'+#13+#13+TargetPathName),
pchar(_sAppTitle),
mb_IconWarning+mb_ok);
112:
Application.MessageBox(pchar('目標盤空間不夠:'+TargetPathName),
pchar(_sAppTitle),
mb_IconWarning+mb_ok);
else
Application.MessageBox(PChar('拷貝文件失敗。'+#13+#13+
SourceFile+' --> '+TargetFile),
pchar(_sAppTitle), mb_IconInformation+mb_ok);
end;
end;
//★★★
// 比較日期是否相同
// 輸入: iCmp: 比較類型(1:年 2:年月 3:年月日 4:年月日時 5:年月日時分 6:年月日時分秒)
// 返回: True: 相同
function SameDateTime(const dtD1, dtD2: TDateTime; const iCmpType: integer): boolean;
var
wY1, wY2, wM1, wM2, wD1, wD2, wH1, wH2, wMi1, wMi2, wS1, wS2, wMs1, wMs2: word;
begin
DecodeDate(dtD1, wY1, wM1, wD1);
DecodeDate(dtD2, wY2, wM2, wD2);
DecodeTime(dtD1, wH1, wMi1, wS1, wMs1);
DecodeTime(dtD2, wH2, wMi2, wS2, wMs2);
case iCmpType of
1: Result := (wY1=wY2);
2: Result := (wY1=wY2) and (wM1=wM2);
3: Result := (wY1=wY2) and (wM1=wM2) and (wD1=wD2);
4: Result := (wY1=wY2) and (wM1=wM2) and (wD1=wD2) and (wH1=wH2);
5: Result := (wY1=wY2) and (wM1=wM2) and (wD1=wD2) and (wH1=wH2) and (wMi1=wMi2);
6: Result := (wY1=wY2) and (wM1=wM2) and (wD1=wD2) and (wH1=wH2) and (wMi1=wMi2) and (wS1=wS2);
else
result := false;
end;
end;
function MyCy2Round(const X: Extended): Currency;
begin
if X>=0 then
Result := Trunc(X*100+0.5)/100
else
Result := -Trunc(Abs(X)*100+0.5)/100;
end;
// 將日期 sDate 和字段 sFieldName 組合成 sCondition,
// 使其能使用在 Select ... where <sCondition> 中。
// 本函數在 MS Access、Oracle、Sybase 數據庫中獲得通過。
// sDate 的格式是 'YYYY-MM-DD'
// sOptr 為 '>', '>=', '<', '<=', '=', '<>'
function MyDateCondition(const sFieldName, sDate, sOptr, sDB: string;
var sCondition: string): boolean;
var
sYear, sMonth, sDay, sFN: string;
begin
Result:=true;
sYear:=Copy(sDate, 1, 4);
sMonth:=Copy(sDate, 6, 2);
sDay:=Copy(sDate, 9, 2);
// Access
if sDB='MSACCESS' then
begin
sFN:='['+sFieldName+']';
if sOptr = '=' then
sCondition := ' (DatePart("yyyy",'+sFN+')='+sYear+
' and DatePart("m",'+sFN+')='+sMonth+
' and DatePart("d",'+sFN+')='+sDay+') '
else if sOptr = '<>' then
sCondition := ' (DatePart("yyyy",'+sFN+')<>'+sYear+
' or DatePart("m",'+sFN+')<>'+sMonth+
' or DatePart("d",'+sFN+')<>'+sDay+') '
else if (sOptr = '>') or (sOptr = '>=') or
(sOptr = '<') or (sOptr = '<=') then
sCondition :=
' (DatePart("yyyy",'+sFN+')'+sOptr+sYear+ // 年大/小
' or (DatePart("yyyy",'+sFN+')='+sYear+ // 年等, 月大/小
' and DatePart("m",'+sFN+')'+sOptr+sMonth+')'+
' or (DatePart("yyyy",'+sFN+')='+sYear+ // 年等, 月等, 日大/小
' and DatePart("m",'+sFN+')='+sMonth+
' and DatePart("d",'+sFN+')'+sOptr+sDay+')) '
else
sCondition:=' 1=1 ';
exit; // 退出
end;
// Sybase
if sDB='SYBASE' then
begin
sFN:=sFieldName;
if sOptr = '=' then
sCondition := ' (DatePart(yy,'+sFN+')='+sYear+
' and DatePart(mm,'+sFN+')='+sMonth+
' and DatePart(dd,'+sFN+')='+sDay+') '
else if sOptr = '<>' then
sCondition := ' (DatePart(yy,'+sFN+')<>'+sYear+
' or DatePart(mm,'+sFN+')<>'+sMonth+
' or DatePart(dd,'+sFN+')<>'+sDay+') '
else if (sOptr = '>') or (sOptr = '>=') or
(sOptr = '<') or (sOptr = '<=') then
sCondition :=
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -