commfun.pas.svn-base

这是一个功能齐全的,代码完整的ERP企业信息管理系统,现在上传和大家分享

  try
    Instance.Create(application);
  except
    TComponent(Reference) := nil;
    raise;
  end;
  CloseWaitForm;
  try
    TForm(Instance).ShowModal;
  finally
    Instance.Free;
  end;
end;

//开启MDICHILD子窗体过程
procedure OpenChildForm(AFormClass:TFormClass;AForm:TComponent);
var
  I:integer;
  AChild:TForm;
begin
  Screen.Cursor:=crHourGlass;

  for I:=0 to Screen.FormCount-1 do
  begin
    if Screen.Forms[I].ClassType=AFormClass then
    begin
      AChild:=Screen.Forms[I];
      if AChild.WindowState=wsMinimized then
        ShowWindow(AChild.handle,SW_SHOWNORMAL)
      else
        ShowWindow(AChild.handle,SW_SHOWNA);
      if (not AChild.Visible) then AChild.Visible:=True;
      AChild.BringToFront;
      AChild.SetFocus;
      TForm(AForm):=AChild;
      Screen.Cursor:=crDefault;
      Exit;
    end;
  end;

  ShowWaitForm;

  Application.ProcessMessages;

  AChild:=TForm(AFormClass.NewInstance);
  TForm(AForm):=AChild;
  AChild.Create(Application);
  Achild.WindowState:=wsMaximized;

  CloseWaitForm;
  Screen.Cursor:=crDefault;
end;

//错误信息显示
function ShowMsg(AMsg:string;AType:Integer=0):Integer;
var
  AText,ACaption:string;
begin
  case AType of
    0:AText:=GetDBString(AMsg);
    1:AText:=AMsg;
  end;
  case AType of
    0:ACaption:=GetDBString('UMS10000001');  //系统信息
    1:ACaption:='Information';
  end;
  Result:=Application.Messagebox(PChar(AText),PChar(ACaption),
          MB_OK+MB_ICONINFORMATION);
end;

//显示确认对话框
function ShowDialog(AMsg:string;AType:Integer=0;DEFBUTTON:Integer=MB_DEFBUTTON2):Integer;
var
  AText,ACaption:string;
begin
  case AType of
    0:AText:=GetDBString(AMsg);
    1:AText:=AMsg;
  end;
  case AType of
    0:ACaption:=GetDBString('UMS10000001');  //系统信息
    1:ACaption:='Information';
  end;
  Result:=Application.Messagebox(PChar(AText),PChar(ACaption),
          MB_YESNO+MB_ICONQUESTION+DEFBUTTON);
end;

//防止程序执行两次 注意主窗体的CAPTION不能和APPLICATION。TITLE相同
procedure CheckInstance(AProgram:string);
var
  WindowsHand:HWND;
  AText,ACaption:string;
begin
  WindowsHand:=FindWindow(nil,PChar(AProgram));
  if WindowsHand<>0 then
  begin
    //语言编号(2052=简体中文,1028=繁体中文,1033=英文)
    case GetSystemDefaultLangID of
      2052:begin ACaption:='系统信息';  AText:=AProgram+' 程序已经运行' end;
      1028:begin ACaption:='系統信息';  AText:=AProgram+' 程序已經運行' end;
      1033:begin ACaption:='System information';  AText:=AProgram+' program is running' end;
    else
      begin ACaption:='System information';  AText:=AProgram+' program is running' end;
    end;
    Application.Messagebox(PChar(AText),PChar(ACaption),
          MB_OK+MB_ICONINFORMATION);
    if Isiconic(WindowsHand) then
      ShowWindow(WindowsHand,SW_SHOW)
    else
      SetForegroundWindow(WindowsHand);
    Halt;
  end;
end;

//创建新的数据库别名
procedure NewAlias(AliasName:string);
var
  ASession:TSession;
  AList: TStringList;
begin
  ASession:=TSession.Create(Application);
  ASession.AutoSessionName:=True;
  ASession.Active:=True;
  AList := TStringList.Create;
  if not ASession.IsAlias(AliasName) then
  begin
    try
      AList.Add('SERVER NAME='+AServerName);
      AList.Add('DATABASE NAME=PAY');
      AList.Add('USER NAME=sa');
      ASession.AddAlias(AliasName, 'MSSQL', AList);
      ASession.SaveConfigFile;
    finally
      AList.Free;
    end;
  end else
  begin
    try
      AList.Add('SERVER NAME='+AServerName);
      ASession.ModifyAlias(AliasName, AList);
      ASession.SaveConfigFile;
    finally
      AList.Free;
    end;
  end;
end;

//复制记录
procedure CopyRecord(ADataSet:TDataSet);
var
  I,ACount:integer;
begin
  ACount:=ADataSet.FieldCount;
  SetLength(ARecord,ACount);
  for I:=0 to ACount-1 do
  begin
    if ADataSet.Fields[I].FieldKind=fkData then
      ARecord[I]:=ADataSet.Fields[I].AsVariant;
  end;
{
  ADataSet.Insert;
  for I:=0 to ADataSet.FieldCount-1 do
  begin
    if (ADataSet.Fields[I].FieldKind=fkData) and (ADataSet.Fields[I].CanModify=True) then
      ADataSet.Fields[I].AsVariant:=ARecord[I];
  end; }
end;

//粘贴记录
procedure PasteRecord(ADataSet:TDataSet);
var
  I:integer;
begin
  if not (ADataSetName=ADataSet.Name) then Exit;
  for I:=0 to ADataSet.FieldCount-1 do
  begin
    if (ADataSet.Fields[I].FieldKind=fkData) and (ADataSet.Fields[I].CanModify=True) then
      ADataSet.Fields[I].AsVariant:=ARecord[I];
  end;
end;

//字符串加密函数
function Encrypt(AStr:String):String;
var
  I:Byte;
begin
  for I:=1 to Length(AStr) do
    AStr[I]:=Chr((Ord(AStr[I])+5*I) mod 256);
  Result:=AStr;
end;

//字符串解密函数
function Decrypt(AStr:String):String;
var
  I:Byte;
begin
  for I:=1 to Length(AStr) do
    AStr[I]:=Chr((Ord(AStr[I])-5*I+256) mod 256);
  Result:=AStr;
end;

//取得某月的第一天的日期
function GetMonthFirstDate(ADate:TDate):TDate;
var
  AFirstDay:string;
begin
  AFirstDay:=FormatDateTime('yyyy-mm-dd',ADate);
  Delete(AFirstDay,9,2);
  Insert('01',AFirstDay,9);
  Result:=StrToDate(AFirstDay);
end;

//取得某月的最后一天的日期
function GetMonthEndDate(ADate:TDate):TDate;
var
  AFirstDay,ANextFirstDay:string;
begin
  AFirstDay:=FormatDateTime('yyyy-mm-dd',GetMonthFirstDate(ADate));
  if StrToInt(copy(AFirstDay,6,2))<12 then
  begin
    //取当月第一天的日期
    ANextFirstDay:=IntToStr(StrToInt(Copy(AFirstDay,6,2))+1);
    //取下月第一天的日期
    Delete(AFirstDay,6,2);  //删除字串中的月份
    Insert(ANextFirstDay,AFirstDay,6);  //插入当月的月份到字串中
    Result:=StrToDate(AFirstDay)-1;  //取得当月最后一天的日期
  end else
  begin
    Result:=StrToDate(copy(AFirstDay,1,4)+'-12-31');
  end;
end;

//取得上月的第一天的日期
function GetLastMonthFirstDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  if AMonth=1 then
  begin
    AYear:=AYear-1;
    AMonth:=12
  end else
  begin
    AMonth:=AMonth-1;
  end;
  ADate:=EncodeDate(AYear,AMonth,ADay);
  Result:=GetMonthFirstDate(ADate);
end;

//取得上月的最后一天的日期
function GetLastMonthEndDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  if AMonth=1 then
  begin
    AYear:=AYear-1;
    AMonth:=12
  end else
  begin
    AMonth:=AMonth-1;
  end;
  ADate:=EncodeDate(AYear,AMonth,ADay);
  Result:=GetMonthEndDate(ADate);
end;

//取得本季的第一天的日期
function GetSeasonFirstDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  if AMonth<=3 then AMonth:=1
  else if AMonth<=6 then AMonth:=4
  else if AMonth<=9 then AMonth:=7
  else if AMonth<=12 then AMonth:=10;
  ADate:=EncodeDate(AYear,AMonth,1);
  Result:=ADate;
end;

//取得本季的最后一天的日期
function GetSeasonEndDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  if AMonth<=3 then AMonth:=3
  else if AMonth<=6 then AMonth:=6
  else if AMonth<=9 then AMonth:=9
  else if AMonth<=12 then AMonth:=12;
  ADate:=EncodeDate(AYear,AMonth,ADay);
  Result:=GetMonthEndDate(ADate);
end;

//取得上季的第一天的日期
function GetLastSeasonFirstDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  if AMonth<=3 then begin AMonth:=10; AYear:=AYear-1; end
  else if AMonth<=6 then AMonth:=1
  else if AMonth<=9 then AMonth:=4
  else if AMonth<=12 then AMonth:=7;
  ADate:=EncodeDate(AYear,AMonth,1);
  Result:=GetMonthFirstDate(ADate);
end;

//取得上季的最后一天的日期
function GetLastSeasonEndDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  if AMonth<=3 then begin AMonth:=12; AYear:=AYear-1; end
  else if AMonth<=6 then AMonth:=3
  else if AMonth<=9 then AMonth:=6
  else if AMonth<=12 then AMonth:=9;
  ADate:=EncodeDate(AYear,AMonth,ADay);
  Result:=GetMonthEndDate(ADate);
end;

//取得本年的第一天的日期
function GetYearFirstDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  ADate:=EncodeDate(AYear,1,1);
  Result:=ADate;
end;

//取得本年的最后一天的日期
function GetYearEndDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  ADate:=EncodeDate(AYear,12,31);
  Result:=ADate;
end;

//取得上年的第一天的日期
function GetLastYearFirstDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  ADate:=EncodeDate(AYear-1,1,1);
  Result:=ADate;
end;

//取得上年的最后一天的日期
function GetLastYearEndDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  ADate:=EncodeDate(AYear-1,12,31);
  Result:=ADate;
end;

//取得上年同期
function GetLastYearSameDate(ADate:TDate):TDate;
var
  AYear,AMonth,ADay:Word;
begin
  DecodeDate(ADate,AYear,AMonth,ADay);
  ADate:=EncodeDate(AYear-1,AMonth,ADay);
  Result:=ADate;
end;

//检查输入是否数字
procedure ValidInteger(Sender: TObject; var Key: Char);
var
  ValidCharSet: set of Char;
  AResult:Boolean;
begin
  ValidCharSet:=['+', '-', '0'..'9'];
  AResult:=(Key in ValidCharSet) or ((Key<#32) and (Key <> Chr(vk_Return)));
  if AResult then
  begin
    if (Key='+') or (Key='-') then
      AResult:=(TCustomEdit(Sender).SelStart=0) and (Pos('+', TCustomEdit(Sender).Text)=0) and (Pos('-',TCustomEdit(Sender).Text)=0);
  end;
  if not AResult then Key:=#0;
end;

//检查输入是否浮点数
procedure ValidFloat(Sender: TObject; var Key: Char);
var
  ValidCharSet: set of Char;
  AResult:Boolean;
begin
  ValidCharSet:=[DecimalSeparator, '+', '-', '0'..'9'];
  AResult:=(Key in ValidCharSet) or ((Key<#32) and (Key <> Chr(vk_Return)));
  if AResult then
  begin
    if Key=DecimalSeparator then