ufunc.pas

delphi 源码 小型企业管理软件

  if (CurUserID='admin') or (Trim(Caption)='') then exit;

  UserPriv := GetQuery(GetSQLText('getPriv','MISC')
    ,[CurUserID,Caption,piName]).Fields[0].AsString;
  GUserCanR := pos('R',UserPriv)>0;
  GUserCanC := pos('C',UserPriv)>0;
  GUserCanU := pos('U',UserPriv)>0;
  GUserCanD := pos('D',UserPriv)>0;
  GUserCanE := pos('E',UserPriv)>0;

  if not GUserCanR then
  begin
    Result := False;
    if bShowMsg then
      abortMsg('您未获授权查看以下模块，请联系系统管理员：'
        +#13#10#13#10+ Caption);
  end;
end;

function GetDBGridSelectedColData(JVDBGrid:TJVDBGrid; ColName:string;
  ExcludeColName:string=''; ExcludeValue:string=''):string;
var
  SelectedSN: string;
  i: integer;
  Dataset: TDataset;
begin
  SelectedSN := '';
  Dataset := JVDBGrid.Datasource.Dataset;
  JVDBGrid.SelectedRows.CurrentRowSelected := True;

  for i:=0 to JVDBGrid.SelCount-1 do begin
    Dataset.Bookmark := JVDBGrid.SelectedRows[i] ;
    if (ExcludeColName<>'') and (Dataset.FieldByname(ExcludeColName).AsString<>ExcludeValue) then
      SelectedSN := SelectedSN +','+ Dataset.FieldByname(ColName).AsString  ;
  end;
  if SelectedSN<>'' then Delete(SelectedSN,1,1);

  REsult := SelectedSN ;
  if REsult='' then REsult := '-1'; //加一个伪序列号是为了防止SQL中 IN 语法 查询出错
end;

function CtrlShiftPressed: Boolean;
begin
  Result := (GetKeyState(vk_Control)<0) and (GetKeyState(vk_Shift)<0) ;
end;

procedure PrintFr3(Fr3:TFrxReport;RepTemplateName:string);
var
  RepTemplatePath: string;
begin
    RepTemplatePath := AppPath + RepTemplateName;
    if not FileExists(RepTemplatePath) then
      AbortMsg('找不到打印模板文件：['+RepTemplatePath+']!')
    else
      Fr3.LoadFromFile(RepTemplatePath);

    if CtrlShiftPressed then Fr3.DesignReport
    else Fr3.ShowReport;
end;

function GetMaxInt(const Tablename,colname:string): integer;
begin
  Result := GetQuery('select ISNULL(max(cast(%1:s as integer)),0)+1 from %0:s where isnumeric(%1:s)=1'
    ,[Tablename,colname])
    .Fields[0].AsInteger ;
end;

function getid: string;
begin
  Result := FormatDateTime('YYMMDDHHNNSSZZZ',now);
  sleep(1);
end;

procedure ShowPopMenu(Sender:TObject);
var
  Pnt: TPoint;
  JvArrowButton: TJvArrowButton;
  ParentPanel: TPanel;
begin
  JvArrowButton := TJvArrowButton(Sender);
  ParentPanel := TPanel(JvArrowButton.Parent);
  Pnt := ParentPanel.ClientToScreen(Point(JvArrowButton.Left
    , JvArrowButton.Top+JvArrowButton.Height));
  JvArrowButton.DropDown.Popup(Pnt.X, Pnt.Y);
end;

procedure CheckExcelFiles(JvListBox1:TJvListBox);
var
  i,j: integer;
begin
  if JvListBox1.Count =0 then
    AbortMsg('请指定要导入的Excel文件！');

  //删除重复的文件名  
  for i:=JvListBox1.Count-1 downto 0 do begin
    for j:=0 to i-1 do begin
      if SameText(JvListBox1.Items[i], JvListBox1.Items[j]) then begin
        JvListBox1.Items.Delete(i);  
        break;
      end;
    end;
  end;

end;

//Tablename(一般是Dataio2)表中，带千分位的小数，可以通过ISNUMRIC 的检查，但无法使用 CAST函数，故需要去除逗号
procedure ConvertFloatColumns(const Tablename,FloatColumns:string);
var
  sl: TStringList;
  i: integer;
  mSQL: string;
begin
  sl:= TStringList.Create ;
  sl.CommaText := FloatColumns;
  mSQL := '';

  try
    for I:=0 to sl.Count-1 do begin
      mSQL := mSQL+#13#10+Format(
        'update %1:s set %0:s=REPLACE(%0:s,'','','''') where CHARINDEX('','',%0:s)>0'
        ,[sl[i],Tablename]);
    end;

    ExecQuery(mSQL);
  finally
    sl.Free ;
  end;
end;

//检查数据库是否位于本客户端
function ClientIsDBServer(bShowWarn:Boolean=True):Boolean;
var
  DBComputername, ClientComputername: string;
begin
  ClientComputername := DM.JvComputerInfoEx1.Identification.LocalComputerName ;
  DBComputername := GetQuery('SELECT SERVERPROPERTY(''MachineName'')').Fields[0].AsString;
  Result := SameText(ClientComputername,DBComputername);

  if bShowWarn and not Result then
    ShowMsg('数据库的备份与恢复操作请在机器['+DBComputername+']上进行！');
end;


function GetValidSheetname(const sheetname:string):string;
var
  pagename: string;
begin
  pagename := sheetname ;
{
  在重命名工作表或图表时输入的名称无效。请尝试以下操作:

  ? 确认输入的名称不多于 31 个字符。
  ? 确认名称中不包含下列任一字符: :  / ? * [ 或 ] 。
  ? 确认工作表名称不为空。.
}
  pagename := StringReplace(pagename,'/','-',[rfReplaceALL]);
  pagename := StringReplace(pagename,'?','-',[rfReplaceALL]);
  pagename := StringReplace(pagename,'*','-',[rfReplaceALL]);
  pagename := StringReplace(pagename,'[','-',[rfReplaceALL]);
  pagename := StringReplace(pagename,']','-',[rfReplaceALL]);
  if Length(pagename)>31 then begin
    if byteType(pagename,31)=mbLeadByte then
      pagename := copy(pagename,1,30)
    else
      pagename := copy(pagename,1,31)
  end;

  Result := pagename;
end;

procedure WriteExcelText(const pasteText:string; IgnoredLines:integer);
var
  i,j,nPos: integer;
  aLine,cellData: string;
  sl: TStringList;
begin
  sl := TStringList.Create ;

  try
    sl.Text := pasteText;
    for i:=0 to sl.Count-1 do begin
      j := 0;
      aLine := sl[i];
      nPos := pos(#9,aLine);
      while nPos>0 do begin
        cellData := Copy(aLine,1,nPos-1);
        System.Delete(aLine,1,nPos);
        nPos := pos(#9,aLine);

        Inc(j);
        sheet.cells[i+1+IgnoredLines,j]:=  cellData;
      end;

      if aLine<>'' then begin
        Inc(j);
        sheet.cells[i+1+IgnoredLines,j]:=  aLine;
      end;
    end;  
  finally
    sl.Free ;
  end;                          

end;

//****** 粘贴到Excel中 **********
procedure PasteToExcel(FuncID:Integer;const sheetname:string='';
  const pasteText:string=''; UsePasteMethod:Boolean=False);
var
  ValidSheetname: string;
  IgnoredLines: integer;
begin
  if FuncID=0 then begin //初始化
    Screen.Cursor := crHourGlass;
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.DisplayAlerts := False;
      XLApp.Quit;
      VarClear(XLApp);
    end;

    try
      XLApp := CreateOleObject('Excel.Application');
    except
      Screen.Cursor := crDefault;
      Exit;
    end;

    if sheetname='' then begin
      XLApp.WorkBooks.Add;
      XLApp.SheetsInNewWorkbook := 3;
    end else begin
      XLApp.WorkBooks.Open(sheetname);
    end;
  end;

  if FuncID=1 then begin //粘贴
    IgnoredLines := 0;
    XLApp.WorkBooks[1].WorkSheets.Add;
    SetIMEState(1);    sleep(10);

    ValidSheetname := GetValidSheetname(sheetname) ;
    if ValidSheetname<>'' then
      XLApp.Workbooks[1].WorkSheets[1].Name := ValidSheetname ;
    Sheet := XLApp.Workbooks[1].WorkSheets[1];

    if UsePasteMethod then begin
      Clipboard.AsText := pasteText ;
      Sheet.Paste;
    end else begin
      //乱码 when paste,但正常 when写CELL
      WriteExcelText(pasteText,IgnoredLines);
    end;
    
  end;

  if FuncID=2 then begin //释放
    Clipboard.AsText := '';
    XlApp.Visible := True;
    Screen.Cursor := crDefault;
    SetIMEState(0);
  end;

end;

procedure ExecuteBackupDB;
begin
  if not ClientIsDBServer then exit;
  
  with TOpenDialog.Create(nil) do           
  try
    InitialDir := ExtractFilePath(Application.ExeName)+'DataBackup';
    if not DirectoryExists(InitialDir) then CreateDir(InitialDir);

    DefaultExt := 'bak';
    Filter := '数据库备份文件 (*.bak)|*.bak|所有文件 (*.*)|*.*';
    FilterIndex := 1;
    Filename := FormatDateTime('"DB"YYYY-MM-DD_HH-NN-SS',now);
    Title := '打开或创建数据库备份文件';

    if not Execute then exit;

    ExecQuery('backup database '+GetCurDBname+'  to disk='+QuotedStr(Filename));
    PutGT('DBLastBack',FormatDateTime('YYYY-MM-DD',now));
    ShowMessage('数据备份完成。');
  finally
    Free;
  end;
end;

procedure ExecuteRestoreDB;
var
  CurDBname: string;
begin
  if not ClientIsDBServer then exit;
  
  if not (CurUserID='admin') then begin
    ShowMessage('请以管理员帐号登入，然后进行数据恢复！');
    exit;
  end;

//  if MDIChildCount>0 then abortMsg('数据恢复前请关闭所有子窗口。');
  if not Sure('警告：'
    +#13#10+'1，恢复数据库操作将完全覆写现有数据，强烈建议您先备份当前数据库。'
    +#13#10+'2，数据库恢复成功后程序必须关闭重启。'
    +#13#10+'2，数据库恢复操作必须在数据库所在的机器上进行。'
    +#13#10#13#10+'继续恢复数据库操作吗？') then exit;

  with TOpenDialog.Create(nil) do
  try
    InitialDir := ExtractFilePath(Application.ExeName)+'DataBackup';
    DefaultExt := 'bak';
    Filter := '数据库备份文件 (*.bak)|*.bak|所有文件 (*.*)|*.*';
    FilterIndex := 1;
    Title := '选择数据库备份文件';

    if not Execute then exit;
    CurDBname := GetCurDBname;

    ExecQuery('use master'
      +#13#10+ 'Restore database '+CurDBname+' from disk='+QuotedStr(Filename));
    ShowMessage('数据恢复完成，程序即将关闭重启。');

    Application.Terminate;
    WinExec(PansiChar(Application.ExeName),SW_Show);
  finally
    Free;
  end;
end;

procedure BackupDB;
var
  oldDate, curDate: string;
begin
  if not ClientIsDBServer then exit;
  
  oldDate := GetQuery('select value from gt where name=''DBLastBack''').Fields[0].AsString;
  curDate := FormatDateTime('YYYY-MM-DD',now);
  if oldDate=curDate then exit;
  if not sure('今天尚未备份数据，现在要备份吗？') then exit;

  ExecuteBackupDB;
end;

function GetCurDBname: string;
begin
  REsult := GetQuery('select db_name(db_id())').Fields[0].AsString;
end;

procedure SetIMEState(state: integer);
var
  myhkl:hkl;
begin
  if imename='' then begin
    if  Screen.Imes.Count=0 then imename :='-1'
    else imename := Screen.Imes[0];
  end;
  if imename='-1' then exit;

  if state=1 then begin //开启中文输入法
    myhkl:=hkl(screen.Imes.objects[0]);
    activatekeyboardlayout(myhkl, KLF_ACTIVATE);
  end else
  if state=0 then begin //关闭中文输入法
    myhkl:=GetKeyBoardLayOut(0);
    if ImmIsIME(myhkl)then //判断是否在中文状态,若是则关闭它
    immsimulateHotkey(Application.handle, IME_CHotKey_IME_NonIME_Toggle);
  end
end;

procedure SaveData(arr:Array of TAdoQuery);
var
  i: integer;
begin
  for i:=low(arr) to high(arr) do
  if arr[i].Active then arr[i].CheckBrowseMode ;
end;

//依据src为成品还是料件，重算料件耗用数量  
procedure ReCalcLJQty(const HCCode,SPID:Integer;const src:string);
begin
  DropTempTables;
  ExecQuery(GetSQLText('ReCalcLJQty.SQL','HT')
    ,[HCCode,SPID,src,GDecimalQty,GDecimalPrice,GDecimalAmt]);
end;

function GetDecimalFmt(const DigitNum:Integer):string;
var
  i: integer;
begin
  Result := '';
  for i:=1 to DigitNum do
    Result := Result + '#';

  if Result='' then Result := '0'
  else Result := '0.'+ Result ;
end;

procedure DoInitWork;
var
  ErrorLogFilename: string;
begin
  ErrorLogFilename := AppPath+'error.log' ;
  if not FileExists(ErrorLogFilename) then FileCreate(ErrorLogFilename);

  GDecimalQty := StrToIntDef(GetGT('GDecimalQty'),2);
  GDecimalPrice := StrToIntDef(GetGT('GDecimalPrice'),3);
  GDecimalAmt := StrToIntDef(GetGT('GDecimalAmt'),2);

  GJEFormat := GetDecimalFmt(GDecimalAmt);
  GSLFormat := GetDecimalFmt(GDecimalQty);
  GDJFormat := GetDecimalFmt(GDecimalPrice);

  if ClientIsDBServer(False) then BackupDB;
end;


procedure EnablePanCtrls(Pan:TPanel;Enabled:Boolean);
var
  i: integer;
begin
  for i:=0 to Pan.ControlCount-1 do
    if Pan.Controls[i] is TCustomEdit then
    TEdit(Pan.Controls[i]).Enabled := Enabled ;
end;

//料件是否未被成品使用  
function CheckLJNotInUse(const HCCode,HCMnum:Integer): Boolean;
var
  UsingHCPnum: string;
begin
  UsingHCPnum := GetQuery('select HCPnum from contrDH where HCCode=%d and HCMnum=%d'
    ,[HCCode,HCMnum]).Fields[0].AsString ;

  if UsingHCPnum<>'' then begin
    Result := False;
    ShowMsg('料件'+IntToStr(HCMnum)+'被至少一个成品['+UsingHCPnum+']使用！');
  end else
    Result := True;
end;

//获得序号列中可用的序号  （取中间间断值,if available）
function GetInternalID(Dataset:TDataset;colname:string):Integer;
var
  bm: string;
  sl: TStringList;
  i: integer;
begin
  with Dataset do
  try
    sl := TStringList.Create ;
    bm := Bookmark;
    DisableControls;

    first;
    while not eof do begin
      sl.Add(FormatFloat('000000',FieldByName(colname).AsInteger));
      next;
    end;

    //sl 排序
    sl.Sort ;
    Result := sl.Count+1;  //预设为最大值
    for i:=0 to sl.Count-1 do
    if i+1<>StrToInt(sl[i]) then begin
      Result := i+1;     //有间断时，取间断值
      Break;
    end;

  finally
    sl.Free ;
    Bookmark := bm;
    EnableControls;
  end;

end;


procedure DeleteHT(const HCCode:Integer);
begin
  ExecQuery(GetSQLText('EraseContract.SQL','HT'),[HCCode]);
end;

procedure CopyHT(const HCCode:Integer);
begin
  ExecQuery(GetSQLText('CopyContract.SQL','HT'),[HCCode]);