ufunc.pas

delphi 源码 小型企业管理软件

unit uFunc;

interface
uses classes,IniFiles,SysUtils,ADODB,Forms,Controls,windows,DB,Qrctrls,QuickRpt,
  StdCtrls,Graphics,Dialogs,DBGrids,wwDBGrid,Wwdbigrd,wwdblook, wwdbedit, ExtCtrls,
  JvListBox, JvDBGrid, frxClass, KsSkinTabs;

type
  TMethod = procedure of object;

  TFakeForm=class(TForm)
  private
    procedure wwDBGridCalcTitleImage(Sender: TObject; Field: TField;
      var TitleImageAttributes: TwwTitleImageAttributes);
    procedure wwDBGridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  public
    procedure wwDBGridTitleButtonClick(Sender: TObject;
      AFieldName: String);
  end;

var
  FakeForm: TFakeForm;
  CurUserID: string;
  GDecimalQty,GDecimalPrice,GDecimalAmt: integer;
  GJEFormat, GSLFormat, GDJFormat: string;

////report funcs
//说明：设置Deltail中需要转行的DBExpr/DBText的Top/height
//参数：BandName:目标DetailBand PreTop 原始Dbtext高度,DecMent 需要减少的top量,preheight 原始的高度
//使用：Detailband的Print事件 需要DBTextOnPrint函数配合使用
procedure DetailBandBeforeSetTop(const BandName: TQRBand;const PreTop:Integer ;
  const DecMent: Integer;const PreHeight:Integer);

//说明：设置Sender的值强行转行,在Sender.onPrint事件中使用，可以首先使用DetailBandBeforeSetTop改变其Top/height
procedure DBTextOnPrint(Sender: TObject;var DBTextValue: String);

//说明：设置Deltail中需要转行的DBExpr/DBText的Top和字体 自动依次上下错行。
//参数：BandName:目标DetailBand arya 需要处理的控件的序号数组 aryb 对应前面的宽度 PreTop 原始Dbtext高度,isItalic 是否需要斜体显示
procedure setdbtexttop(BandName: TQRBand; arya: Array of Integer;
      aryb:Array of Integer;const PreTop:Integer;isItalic:Boolean );
procedure getAmt(dstCurr:string; var Value: String);

//common funcs
function  Sure(const Mess:string):Boolean;
procedure ShowMsg(const Mess:string);
procedure AbortMsg(const Mess:string);
function ShowFrm(FormClass: TFormClass; var Reference; bModal:Boolean=True):TModalResult;
procedure WriteIniFile(const SectionName,ParamName,ParamValue:string);
function ReadIniFile(const SectionName,ParamName:string;const ParamValue:string=''): string;
function AppPath: string;
procedure WriteErrorLog(const Mess:string;ReallyWrite:Boolean=False);
procedure ShowProgressBar(const OpType:integer;nPos:integer=0;
  AText:string='';ACaption:string='');
function GetTabbedExcelData(const FileName:string;sheetno:integer=1;QuitExcel:Boolean=False):string;
procedure LoadData2DB(DataLines:TStrings; usedColnos:string; LinesIgnored: integer=0);
procedure DoMutallyExclusiveWork(P:TMethod);
procedure CheckLic;
procedure CopyDbDataToExcel(Args: array of const);
procedure EnablePanCtrls(Pan:TPanel;Enabled:Boolean);
procedure DoInitWork;
function GetDecimalFmt(const DigitNum:Integer):string;
procedure PasteToExcel(FuncID:Integer;const sheetname:string='';
  const pasteText:string=''; UsePasteMethod:Boolean=False);

////database related funcs
procedure UpdateDB;
procedure BackupDB;
procedure ExecuteBackupDB;
procedure ExecuteRestoreDB;
function GetQuery(msql: string): TAdoQuery;  overload;
function GetQuery(msql: string; const Args: array of const): TAdoQuery; overload;
procedure ExecQuery(msql: string);  overload;
procedure ExecQuery(msql: string; const Args: array of const); overload;
procedure DropTempTables(temptablenames:string='');
function GetSQLText(const Sectname:string; SQLCategory:string=''): string;
function GetSQLLines(const Sectname:string; SQLCategory:string=''): TStrings;
procedure ReopenDataset(DS: TDataset);
function GetGT(const name:string):string;
procedure PutGT(const name,value:string);
function GetNextID(const tablename,colname:string;sWhereCond:string=''):Integer;
function GetInternalID(Dataset:TDataset;colname:string):Integer;
procedure DeleteHT(const HCCode:Integer);
procedure CopyHT(const HCCode:Integer);
procedure RecalcHT(const HCCode:Integer);
function CheckLJNotInUse(const HCCode,HCMnum:Integer): Boolean;
procedure ReCalcLJQty(const HCCode,SPID:Integer;const src:string);
procedure SaveData(arr:Array of TAdoQuery);
procedure SetIMEState(state: integer);
function GetCurDBname: string;
function ClientIsDBServer(bShowWarn:Boolean=True):Boolean;
procedure ConvertFloatColumns(const Tablename,FloatColumns:string);
procedure CheckExcelFiles(JvListBox1:TJvListBox);
procedure ShowPopMenu(Sender:TObject);
function getid: string;
function GetMaxInt(const Tablename,colname:string): integer;
procedure PrintFr3(Fr3:TFrxReport;RepTemplateName:string);
function CtrlShiftPressed: Boolean;
function GetDBGridSelectedColData(JVDBGrid:TJVDBGrid; ColName:string;
  ExcludeColName:string=''; ExcludeValue:string=''):string;
function CheckUserPriv(const Caption:string; const piName:string='R';
  const bShowMsg:Boolean=True): Boolean;
procedure SetEditPriv(AForm:TForm);
function GetUniqueColnames(DataSet:TDataset): string ;
function GetIDFieldname(DataSet:TDataset): string ;
procedure FillItems(Items:TStrings; mSQL:string);
function moneytostr(money : double) : string;
procedure HidePageTabs(SeSkinPageControl:TSeSkinPageControl);
procedure EffectDJ(const DJType,DJid:string);
function GetSHDid(const khid:string; theDate:TDateTime):string;
procedure ActivateCtrlDataset(SeSkinPageControl1: TSeSkinPageControl);
procedure CheckFieldIDExists(DataSet: TDataSet; IDFieldname:string);
procedure SetNewID(DataSet: TDataSet; mTablename:string='');
function ColumnByName(DG:TjvDBGrid;FieldName:string): TColumn;
procedure SetDatasetReadonly(DataSet:TDataset; ReadOnly:Boolean=True);
function GetKHSPPrice(const khid,spno:string): double;

implementation

uses uDM,JvProgressDialog,ComObj,Variants,Excel2000,clipbrd, UReg, Registry,
  WNDEC,JvStringHolder,imm,JvArrowButton,Types, uCtrlCustomize,
  wwdbdatetimepicker, wwcheckbox, DBCtrls, KsSkinDBControls,DBCtrlsEh,
  JvDBLookup,JvDBCombobox,StrUtils, UConstString;

var
  JvProgressDialog1: TJvProgressDialog;
  GWorking: Boolean=False;
  LeftRuntimes: integer= -1; //剩余运行次数：为－1表示不限
  RegUserCnt: integer; //单机版，网络版用户数
  imename: string;
  XLApp,Sheet: Variant;

const
  CurDBVer='20070521';

//取得客户商品价格
function GetKHSPPrice(const khid,spno:string): double;
begin
  if (khid='') or (spno='') then
    Result := 0
  else
    Result := getQuery('select price from khPrice where spno=%s and khid=%s'
      ,[QuotedStr(spno),QuotedStr(khid)
       ]
       ).Fields[0].AsFloat;
end;

procedure SetDatasetReadonly(DataSet:TDataset; ReadOnly:Boolean=True);
var
  i: integer;
begin
  for i:=0 to Dataset.FieldCount-1 do
    Dataset.Fields[i].ReadOnly := ReadOnly;
end;

function ColumnByName(DG:TjvDBGrid;FieldName:string): TColumn;
var
  i: integer;
begin
  Result := nil;
  for i:=0 to DG.Columns.Count-1 do begin
    if SameText(DG.Columns[i].FieldName,FieldName) then begin
      Result := DG.Columns[i];
      exit;
    end;
  end;

  ShowMessage(DG.Name + '未发现栏位：'+FieldName);
  abort;
end;

procedure SetNewID(DataSet: TDataSet; mTablename:string='');
var
  tableName: string;
  IDFieldname:string;
  newid: integer;
begin
  if mTablename<>'' then
    tableName := mTablename
  else
    tableName := TadoTable(DataSet).TableName ;
    
  IDFieldname := GetIDFieldname(DataSet) ;
  newid := GetMaxInt(tableName,IDFieldname);
//  if (DataSet=T_SP) and (newid<10001) then
//    newid := 10001;  //单据序号从10001开始

  with Dataset do begin
    FieldByName(IDFieldname).AsInteger := newid;
    post;
    Edit;
  end;
end;

//检测当前数据集ID列是否出现重复值
procedure CheckFieldIDExists(DataSet: TDataSet; IDFieldname:string);
var
  AQuery: TAdoQuery;
  CurRecno: integer;
  KeyValue: string;
begin
  if dsInsert=Dataset.State then
    CurRecno := Dataset.RecordCount + 1
  else
    CurRecno := Dataset.Recno ;
    
  KeyValue := Dataset.FieldByName(IDFieldname).AsString;

  AQuery := TAdoQuery.Create(nil) ;
  AQuery.Clone(TAdoQuery(DataSet));

  try
    with AQuery do begin
      First;

      while not eof do begin
        if (RecNo<>CurRecno) and (KeyValue=FieldByName(IDFieldname).AsString)
        then abortMsg(DataSet.FieldByName(IDFieldname).DisplayLabel+'：'+ KeyValue+' 已经存在！');

        Next;
      end;
    end;

  finally
    AQuery.Free ;
  end;

end;

procedure ActivateCtrlDataset2(APanel:TPanel);
var
  i: integer;
begin
  with APanel do
  for i:=0 to ControlCount-1 do begin
    if Controls[i] is TjvDBGrid then begin
      if TjvDBGrid(Controls[i]).DataSource<>nil then
        TjvDBGrid(Controls[i]).DataSource.DataSet.Active := True;
    end
    else
    if Controls[i] is TPanel then
      ActivateCtrlDataset2(TPanel(Controls[i]));
  end;
end;

procedure ActivateCtrlDataset(SeSkinPageControl1: TSeSkinPageControl);
var
  i: integer;
begin
  with SeSkinPageControl1.ActivePage do
  for i:=0 to ControlCount-1 do begin
    if Controls[i] is TPanel then begin
      ActivateCtrlDataset2(TPanel(Controls[i]));
    end
    else
    if Controls[i] is TjvDBGrid then begin
      if TjvDBGrid(Controls[i]).DataSource<>nil then
        TjvDBGrid(Controls[i]).DataSource.DataSet.Active := True;
    end;
  end;

end;

function GetSHDid(const khid:string; theDate:TDateTime):string;
var
  theFirstDay,theLastDay,Prefix,sLike: string;
begin
//  theFirstDay := FormatDateTime('YYYY-MM-',theDate)+'01';
//  theLastDay  := FormatDateTime('YYYY-MM-',theDate)+IntToStr(DaysInMonth(theDate));
  Prefix := khid + FormatDateTime('YYMM',theDate) ;
  sLike :=  Prefix + '[0-9][0-9][0-9]%';

  Result := GetQuery('select Max(invid) from invHead where invid like ''%0:s'''
    ,[sLike]).Fields[0].AsString ;

  if Result='' then
    Result := Prefix + '001'
  else
    Result := Prefix + FormatFloat('000'
      ,StrToInt(RightBStr(Result,3))+1);
end;

procedure EffectDJ(const DJType,DJid:string);
begin
  DropTempTables;

  if DJType='po' then
    ExecQuery(GetSQLText('EffectPO','MISC'),[DJid]);

  if DJType='inv' then
    ExecQuery(GetSQLText('EffectInv','MISC'),[DJid]);
end;

procedure HidePageTabs(SeSkinPageControl:TSeSkinPageControl);
var
  i: integer;
begin
  for i:=0 to SeSkinPageControl.PageCount -1 do begin
    SeSkinPageControl.Pages[i].PageVisible := False;
  end;
end;

function moneytostr(money : double) : string;
const
   Cunits : array [0..11] of string =('拾','亿','仟','佰','拾','萬','仟','佰','拾','元','角','分');
   Cdigits: array [0..9] of string =('零','壹','贰','叁','肆','伍','陆','柒','捌','玖');
var
   nbase :real;
   flag,i,digit : integer;
   flag2 : boolean;
   str : string;
begin
   str :='';
   if money<0 then
      begin
      money :=-money;
      str := '[负]';
      end;
   if money > 10000000000.0 then
      begin
      result :='*********';
      exit;
      end;
   money := int(money*100+0.5)/100.0+0.001;
   flag :=0;
   flag2 := false;
   nbase := 1000000000.0;
   for i:=0 to 11 do
      begin
      digit :=trunc(money/nbase);
      money := money - nbase*digit;
      nbase :=nbase/10.0;
      if flag=0 then                     //前所有位为零
         begin
         if digit <> 0 then
            begin
            flag :=1;
            str := str+Cdigits[digit]+Cunits[i];
            end
         end
      else if digit=0 then
         case i of
         1,9 :                           //当前位为零亿，零元
             begin
             flag :=1;
             str := str + Cunits[i];
             end;
         5 :                             //当前位为零万
             if flag2 then
                begin
                flag :=1;
                str := str+ Cunits[i];
                end;
         11:                              //当前位为零分
            str := str + '正';
         else
            flag := 2;
         end //case
      else if flag=1 then                 //前一位非零
         begin
         if digit=0 then
            flag := 2
         else
            str := str + Cdigits[digit] + Cunits[i];
         end
      else if flag=2 then                 //前一位为零
         begin
         if digit <> 0 then
            begin
            flag :=1;
            str := str+'零'+Cdigits[digit]+Cunits[i];
            end
         end;
      if (i>1) and (digit<>0) then
          flag2 :=true;
      end; // for
   result :=str;
end;


procedure FillItems(Items:TStrings; mSQL:string);
begin
  Items.Clear ;

  with GetQuery(mSQL) do
  while not eof do begin
    Items.Add(Fields[0].AsString); 
    next;
  end;

end;

function GetPartString(const wholeString:string; partno:integer): string ;
begin
  Result := wholeString;
  if pos('~',Result)=0 then begin
    if partno=1 then exit
    else begin
      Result := '';
      exit;
    end;
  end else begin
    if partno=1 then Result := Copy(Result,1,pos('~',Result)-1)
    else Result := GetPartString(Copy(Result,pos('~',Result)+1,255),partno-1);
  end;

end;

function GetUniqueColnames(DataSet:TDataset): string ;
begin
  Result := GetPartString(DataSet.Filter,2);
end;

function GetIDFieldname(DataSet:TDataset): string ;
begin
  Result := GetPartString(DataSet.Filter,1);
end;

//根据当前用户的权限，设置DBEdit的ReadOnly属性
procedure SetEditPriv(AForm:TForm);
var
  i: integer;
  wwDBEdit: TwwDBEdit;
  DBEdit: TDBEdit;
  wwDBDateTimePicker: TwwDBDateTimePicker;
  wwDBLookupCombo: TwwDBLookupCombo;
  SeSkinDBLookupComboBox: TSeSkinDBLookupComboBox;
  DBDateTimeEditEh: TDBDateTimeEditEh;
  JvDBLookupCombo: TJvDBLookupCombo;
  JvDBComboBox: TJvDBComboBox;
begin
  for i:=0 to AForm.ComponentCount-1 do
    if AForm.Components[i] is TwwDBEdit then begin
      wwDBEdit := TwwDBEdit(AForm.Components[i]);
      wwDBEdit.ReadOnly := wwDBEdit.ReadOnly or not GUserCanU;
    end else

    if AForm.Components[i] is TwwDBDateTimePicker then begin
      wwDBDateTimePicker := TwwDBDateTimePicker(AForm.Components[i]);
      wwDBDateTimePicker.ReadOnly := wwDBDateTimePicker.ReadOnly or not GUserCanU;
    end else

    if AForm.Components[i] is TwwDBLookupCombo then begin
      wwDBLookupCombo := TwwDBLookupCombo(AForm.Components[i]);
      wwDBLookupCombo.ReadOnly := wwDBLookupCombo.ReadOnly or not GUserCanU;
    end else

    if AForm.Components[i] is TDBEdit then begin
      DBEdit := TDBEdit(AForm.Components[i]);
      DBEdit.ReadOnly := DBEdit.ReadOnly or not GUserCanU;
    end else

    if AForm.Components[i] is TDBDateTimeEditEh then begin
      DBDateTimeEditEh := TDBDateTimeEditEh(AForm.Components[i]);
      DBDateTimeEditEh.ReadOnly := DBDateTimeEditEh.ReadOnly or not GUserCanU;
    end else

    if AForm.Components[i] is TSeSkinDBLookupComboBox then begin
      SeSkinDBLookupComboBox := TSeSkinDBLookupComboBox(AForm.Components[i]);
      SeSkinDBLookupComboBox.ReadOnly := SeSkinDBLookupComboBox.ReadOnly or not GUserCanU;
    end else

    if AForm.Components[i] is TJvDBLookupCombo then begin
      JvDBLookupCombo := TJvDBLookupCombo(AForm.Components[i]);
      JvDBLookupCombo.ReadOnly := JvDBLookupCombo.ReadOnly or not GUserCanU;
    end else

    if AForm.Components[i] is TJvDBComboBox then begin
      JvDBComboBox := TJvDBComboBox(AForm.Components[i]);
      JvDBComboBox.ReadOnly := JvDBComboBox.ReadOnly or not GUserCanU;
    end else
end;


function CheckUserPriv(const Caption:string; const piName:string='R';
  const bShowMsg:Boolean=True): Boolean;
var
  UserPriv: string;
begin
  Result := True;
  GUserCanC := True;
  GUserCanD := True;
  GUserCanU := True;
  GUserCanR := True;
  GUserCanE := True;