?? publicfunction.pas
字號:
end;
end;
function NewDate(NowDate: String; AddMonth: Integer; AddDays: Integer): String;
var
mYear, mMonth, mDate : Integer;
TmpNowDate : String;
begin
mMonth := StrToInt(SubStr(NowDate, 4, 2));
mYear := StrToInt(LeftStr(NowDate, 2));
mMonth := mMonth + AddMonth;
if mMonth > 12 then begin
mMonth := mMonth - 12;
mYear := mYear + 1;
end;
mDate := StrToInt(RightStr(NowDate, 2));
if mMonth = 2 then begin
if mDate > 28 then begin
if mYear in [85, 89, 93, 97] then
mDate := 29
else
mDate := 28;
end;
end;
if mMonth in [4, 6, 9, 11] then begin
if mDate > 30 then
mDate := 30
end;
TmpNowDate := RightStr('00' + IntToStr(mYear), 2) + '-' +
RightStr('00' + IntToStr(mMonth), 2) + '-' +
RightStr('00' + IntToStr(mDate), 2);
NewDate := IncDate(TmpNowDate, AddDays);
end;
function IDGen(Style, InitVal, FieldName, TableName: String): String;
var
sInitVal, sSQL : String;
begin
sInitVal := LeftStr(InitVal, 2) + SubStr(InitVal, 4, 2);
sSQL := 'SELECT MAX(' + FieldName + ') AS NEW_NO ' +
'FROM ' + TableName + ' ' +
'WHERE CompanyID = ''' + sCompanyID + ''' ' +
'AND ' + FieldName + ' LIKE ''' + '%'+ Style + sInitVal + '%'' ';
with DM.qyGet do begin
Close;
SQL.Clear;
SQL.Text := sSQL;
Open;
end;
if DM.qyGet.FieldByName('NEW_NO').AsString = '' then begin
Result := Style + sInitVal + '0001';
Exit;
end;
Result := Style + sInitVal +
RightStr('0000' + IntToStr(
StrToInt(
RightStr(DM.qyGet.FieldByName('NEW_NO').AsString, 4)
) + 1
), 4);
end;
function ITGen(REAL_NO, ITFieldName, REAL_FieldName, TableName: String): String;
var
sSQL : String;
begin
sSQL := 'SELECT MAX(' + ITFieldName + ') AS NEW_IT FROM ' + TableName + ' ' +
'WHERE CompanyID = ''' + sCompanyID + ''' ' +
'AND ' + REAL_FieldName + ' = ''' + REAL_NO + ''' ';
with DM.qyGet do
begin
Close;
SQL.Clear;
SQL.Text := sSQL;
Open;
end;
if DM.qyGet.FieldByName('NEW_IT').AsString = '' then
ITGen := '001'
else
begin
if (StrToInt(DM.qyGet.FieldByName('NEW_IT').AsString) + 1) > 999 then
raise Exception.Create('明細(xì)最多不超過999筆。');
ITGen := RightStr('000' +
IntToStr(StrToInt(DM.qyGet.FieldByName('NEW_IT').AsString) + 1), 3);
end;
end;
function FormatFloat(cReal: Real;cInt:integer):real;
var
def:real;
begin
result := 0;
if cReal=0 then exit;
if cReal>0 then def:=0.5 else def:=-0.5;
if cint=0 then result:=int(cReal+def);
if cint=2 then result:=int(cReal*100+def)/100;
if cint=4 then result:=int(cReal*10000+def)/10000;
end;
function RealToInt(cReal: Real):Integer;
var
R, F : Real;
PArea : Integer;
IntF : String;
cNumber, IntNumber : Integer;
begin
if cReal = 0 then begin
Result := 0;
Exit;
end;
R := Int(cReal);
F := Frac(cReal);
IntNumber := StrToInt(FloatToStr(R));
IntF := FloatToStr(F);
PArea := Pos('.', IntF);
if PArea = 0 then begin
RealToInt := IntNumber;
Exit;
end;
cNumber := StrToInt(SubStr(IntF, PArea + 1, 1));
if cNumber >= 5 then begin
if cReal >= 0 then
RealToInt := IntNumber + 1
else
RealToInt := IntNumber - 1;
end else
RealToInt := IntNumber;
end;
function FormatReal(cReal: Real; iFrac: Integer): Extended;
var
X : String;
begin
X := FloatToStrF(cReal, ffFixed, 7, 2);
Result := StrToFloat(X);
end;
function Space(NT: Integer): String;
var
ms : String;
i : Integer;
begin
ms := '';
for i := 1 to NT do ms := ms + ' ';
Space := ms;
end;
function RepStr(sC: String; iCount: Integer): String;
var
ms : String;
i : Integer;
begin
ms := '';
for i := 1 to iCount do ms := ms + sC;
RepStr := ms;
end;
function GetTmpFileName(none: Boolean): String;
var
i : Integer;
TmpTableName : String;
begin
TmpTableName := 'TEMP0001.DB';
if FileExists(TmpTableName) then begin
i :=1;
while FileExists(TmpTableName) do begin
Inc(i);
TmpTableName := 'TEMP' + Copy('0000' + IntToStr(i), Length(IntToStr(i))
+ 1, 4) + '.DB';
if not FileExists(TmpTableName) then Break;
end;
end;
GetTmpFileName := TmpTableName;
end;
function SubStr(cString: String; cB: Integer; cE: Integer): String;
var
ms : String;
ml, mb, me : Integer;
begin
ms := cString;
ml := Length(cString);
mb := cB;
me := cE;
if mb > ml then mb := ml;
if me > (ml - mb + 1) then me := (ml - mb + 1);
SubStr := Copy(ms, mb, me);
end;
function LeftStr(cString: String; cL: Integer): String;
var
ms : String;
ml, mh, mb, me : Integer;
begin
ms := cString;
ml := Length(cString);
mh := cL;
if mh > ml then mh := ml;
mb := 1;
me := mh;
LeftStr := Copy(ms, mb, me);
end;
function RightStr(cString: String; cR: Integer): String;
var
ms : String;
ml, mh, mb, me : Integer;
begin
ms := cString;
ml := Length(cString);
mh := cR;
if mh > ml then mh := ml;
mb := ml - mh + 1;
me := mh;
RightStr := Copy(ms, mb, me);
end;
function AtStr(cString: String; eString: String): Integer;
var
ms : String;
i, ml : Integer;
begin
ms := LeftStr(cString,1);
ml := Length(eString);
AtStr := 0;
for i := 1 to ml do begin
if SubStr(eString, i, 1) = ms then
begin
AtStr := i;
Break;
end;
end;
end;
{function CanRunning(FunctionNo, Kind: String): Boolean;
begin
CanRunning := False;
if sUserID = 'SUPERVISOR' then begin
CanRunning := True;
Exit;
end;
end;}
procedure OpenForm(FormClass: TFormClass; var fm; AOwner:TComponent);
var
i: integer;
Child:TForm;
begin
for i := 0 to Screen.FormCount -1 do
if Screen.Forms[i].ClassType = FormClass then begin
Child:=Screen.Forms[i];
if Child.WindowState=wsMinimized then
ShowWindow(Child.handle,SW_SHOWNORMAL)
else
ShowWindow(Child.handle,SW_SHOWNA);
if (not Child.Visible) then Child.Visible:=True;
Child.BringToFront;
Child.Setfocus;
TForm(fm):=Child;
exit;
end;
Child:=TForm(FormClass.NewInstance);
TForm(fm):=Child;
Child.Create(AOwner);
end;
function Today: String;
begin
with DM.qyTemp0 do begin
Close;
SQL.Clear;
SQL.Add('SELECT year(now()) AS Year1, ');
SQL.Add(' month(now()) AS Month1, ');
SQL.Add(' day(now()) AS Day1 ');
Open;
end;
Today := RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('Year1').AsInteger - 2000), 2) + '-' +
RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('Month1').AsInteger), 2) + '-' +
RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('Day1').AsInteger), 2);
{ with DM.qyTemp0 do begin
Close;
SQL.Clear;
SQL.Add('SELECT now() AS Now ');
Open;
end;
Today :=SubStr(DM.qyTemp0.FieldByName('Now').Asstring,3,2)+ '-' +
SubStr(DM.qyTemp0.FieldByName('Now').Asstring,6,2)+ '-' +
SubStr(DM.qyTemp0.FieldByName('Now').Asstring,9,2);
}
end;
function NowTime: String;
begin
with DM.qyTemp0 do begin
Close;
SQL.Clear;
SQL.Add('SELECT hour(now()) AS sHOUR, ');
SQL.Add(' minute(now()) AS sTIME, ');
SQL.Add(' second(now()) AS sSECOND ');
Open;
end;
NowTime := RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('sHOUR').AsInteger), 2) + ':' +
RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('sTIME').AsInteger), 2) + ':' +
RightStr('00' + IntToStr(DM.qyTemp0.FieldByName('sSECOND').AsInteger), 2);
{ nowtime:='20:00:00';
with DM.qyTemp0 do begin
Close;
SQL.Clear;
SQL.Add('SELECT now() AS Now ');
Open;
end;
nowtime :=SubStr(DM.qyTemp0.FieldByName('Now').Asstring,12,2)+ ':' +
SubStr(DM.qyTemp0.FieldByName('Now').Asstring,15,2)+ ':' +
SubStr(DM.qyTemp0.FieldByName('Now').Asstring,18,2);
}
end;
function WeekDay: String;
begin
with DM.qyTemp0 do begin
Close;
SQL.Clear;
SQL.Add('SELECT DATEPART(WEEKDAY, DATE()) AS WEEKDATE ');
Open;
end;
WeekDay := IntToStr(DM.qyTemp0.FieldByName('WEEKDATE').AsInteger);
end;
function DateCal(InDate : String; IncDec : Integer) : String;
var
mInDate : TDateTime;
Year, Month, Day : Word;
begin
mInDate := StrToDateTime(
IntToStr(StrToInt(LeftStr(InDate,2)) + 1911) + '-' +
SubStr(InDate, 4, 2) + '-' +
RightStr(InDate, 2));
mInDate := mInDate + IncDec;
DecodeDate(mInDate, Year, Month, Day);
Year := Year - 1911;
DateCal := IntToStr(Year) + '-' +
RightStr('00' + IntToStr(Month), 2) + '-' +
RightStr('00' + IntToStr(Day), 2);
end;
procedure MyWarning(MyMessage : String);
begin
MessageDlg(MyMessage, mtWarning, [mbOk], 0);
end;
procedure MyError(MyMessage: String);
begin
MessageDlg(MyMessage, mtError, [mbOk], 0);
end;
function MyConfirmation(MyMessage : String): Boolean;
begin
if MessageDlg(MyMessage, mtConfirmation, [mbOk, mbCancel], 0) = mrOk then
MyConfirmation := True
else
MyConfirmation := False;
end;
procedure MyInformation(MyMessage: String);
begin
MessageDlg(MyMessage, mtInformation, [mbOk], 0);
end;
procedure NullWarning(MyMessage: String);
begin
MyWarning(MyMessage + '不可空白,請重新輸入!');
end;
procedure RepeatWarning(MyMessage: String);
begin
MyWarning(MyMessage + '重復(fù),請重新輸入!');
end;
procedure NotFoundWarning(FieldTitle, sValue: String);
begin
MyWarning(FieldTitle + '
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -