syspublic.pas

蓝图财务进销存一体化,delphi源码,使用ACCESS数据库

  x   : Integer;
  sl  :Tstringlist;
begin
  sl:=Tstringlist.Create;
  sl.Add('首条');
  sl.Add('前一条');
  sl.Add('后一条');
  sl.Add('尾一条');
  sl.Add('新增');
  sl.Add('删除');
  sl.Add('编辑');
  sl.Add('提交');
  sl.Add('取消');
  sl.Add('刷新');
  try
    begin
      for i :=  Fd.ControlCount - 1 downto 0 do
      begin
        Tnavbutton(Fd.Controls[i]).Caption:=sl.Strings[i];
        x:= Fd.Left + Fd.Controls[i].Left;
        with Fd.Controls[i] do
        begin
          Parent  :=  Fd.Parent;
          Left    :=  x;
          Top     :=  Fd.Top;
        end;
      end;
      Fd.Visible  :=  False;
      Fd.Flat:=true;
    end;
  finally
    sl.Free;
  end;
end;

procedure OpenForm(FormClass: TFormClass; var fm; AOwner:TComponent);
var
  i, j: 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);

  //控制子窗体位置
{    for j := 0 to MainForm.MDIChildCount -1 do
    begin
      MainForm.MDIChildren[j].Left := 0;
      MainForm.MDIChildren[j].Top := 0;
    end; }

end;

Function LnkAccess(Var ADOConnet: TADOConnection; Db, DbPwd: String):Boolean;
Begin
  if ADOConnet = Nil then
    ADOConnet := TadoConnection.Create(nil);
  if ADOConnet.Connected then
    ADOConnet.Close;
  ADOConnet.LoginPrompt := False;
  ADOConnet.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;'+
                              'Data Source='+Db+';'+
                              'Jet OLEDB:Database Password='+DbPwd;

  Try
    ADOConnet.Open;
    Result := True;
//    ShowMsg('连接成功！');
  Except
    Result := False;
    ShowMsg('连接失败！');
    Application.Terminate;
  End;
End;

function LnkLocalAccess: Boolean;
begin
  Result:= LnkAccess(DataMForm.ADOConnet, 'Data\MainDB.mdb', DBPass);
end;

function GridFieldToTitle(GridEh: TDBGridEh; sField: string):
  string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to GridEh.Columns.Count - 1 do
  begin
    if Trim(GridEh.Columns[i].FieldName) = sField then
    begin
      Result := GridEh.Columns[i].Title.Caption;
      Break;
    end;
  end;
end;

function SaveDataSet(ADOQuery1: TADOQuery; Cached: Boolean): Boolean;
begin
  Result := True;
  if Cached = false then
  begin
    if (ADOQuery1.State = dsEdit) or (ADOQuery1.State = dsInsert) then
      ADOQuery1.Post;
  end
  else
  begin
    if (ADOQuery1.State = dsEdit) or (ADOQuery1.State = dsInsert) then
      ADOQuery1.Post;
    try
      ADOQuery1.UpdateBatch;
    except
      Result := False;
    end;
  end;
end;

function FindPublic(Grid1: TDBGridEh; var sText: string; var
  lFiled: Integer): Boolean;
begin
  Result := FindPublicShow(Grid1, sText, lFiled);
end;

procedure DBGridEhExport(DBGridEh: TDBGridEh; Form: TForm);
//导出数据
var
  ExpClass:TDBGridEhExportClass;
  Ext, sSave:String;
  SaveDialog: TSaveDialog;
begin
  SaveDialog:= TSaveDialog.Create(Nil);
  SaveDialog.FileName:= Form.Caption;
  SaveDialog.Filter:='Text files (*.txt)|*.TXT|Comma separated values (*.csv)|*.CSV|HTML file (*.htm)|*.HTM|Rich Text Format (*.rtf)|*.RTF|Microsoft Excel Workbook (*.xls)|*.XLS';
  sSave := Trim(ExtractFilePath(Application.ExeName)) + 'Save';

  if not DirectoryExists(sSave) then
  begin
    if not CreateDir(sSave) then
    begin
      raise Exception.Create('不能新建目录,请手工新建这目录。' + #13 + sSave);
    end;
  end;
  SaveDialog.InitialDir:= sSave;

  if SaveDialog.Execute then
  begin
    case SaveDialog.FilterIndex of
      1:  begin ExpClass  :=  TDBGridEhExportAsText;  Ext :=  'txt';  end;
      2:  begin ExpClass  :=  TDBGridEhExportAsCSV;   Ext :=  'csv';  end;
      3:  begin ExpClass  :=  TDBGridEhExportAsHTML;  Ext :=  'htm';  end;
      4:  begin ExpClass  :=  TDBGridEhExportAsRTF;   Ext :=  'rtf';  end;
      5:  begin ExpClass  :=  TDBGridEhExportAsXLS;   Ext :=  'xls';  end;
    else
      ExpClass := nil; Ext := '';
    end;
    if ExpClass <> nil then
    begin
      if UpperCase(Copy(SaveDialog.FileName,Length(SaveDialog.FileName)-2,3)) <>
         UpperCase(Ext) then
        SaveDialog.FileName := SaveDialog.FileName + '.' + Ext;
      SaveDBGridEhToExportFile(ExpClass,DBGridEh,SaveDialog.FileName,not DBGridEh.CheckCopyAction);
    end;
  end;
end;

function GetFieldType(fField: TField): string;
var
  s1: string;
begin
  case fField.DataType of
    ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftBCD: s1 := 'Int';
    ftBoolean: s1 := 'Bool';
    ftDate, ftTime, ftDateTime: s1 := 'Date';
    ftWideString, ftString: s1 := 'Str';
    ftUnknown: s1 := 'Unk';
  end;
  Result := s1;
end;

function FilterPublic(Grid1: TDBGridEh): Boolean;
begin
  Result := FilterPublicShow(Grid1);
end;


function CheckEditEmpty(lMsg: Integer; Form1: TForm; AsLabel, AsEdit: array of
  string): Boolean;
var
  i: Integer;
  sCaption, sText: string;
begin
  Result := False;
  for i := 0 to Length(AsLabel) - 1 do
  begin
    if (Trim(AsLabel[i]) <> '') and (Form1.FindComponent(AsLabel[i]) is
      TLabel) and
      (Trim(AsEdit[i]) <> '') and (Form1.FindComponent(AsEdit[i]) is
      TCustomDBEditEh) and
      (TCustomDBEditEh(Form1.FindComponent(AsEdit[i])).Visible = True) then
    begin
      sCaption := TLabel(Form1.FindComponent(AsLabel[i])).Caption;
      sText := TCustomDBEditEh(Form1.FindComponent(AsEdit[i])).Text;
      if (lMsg > 0) and (Trim(sText) = '') then
      begin
        if Pos(':', sCaption) > 0 then
          sCaption := Copy(sCaption, 0, Pos(':', sCaption) - 1)
        else if Pos('：', sCaption) > 0 then
          sCaption := Copy(sCaption, 0, Pos('：', sCaption) - 1);
        MsgBox(sCaption + '不能为空！',  MB_OK);
        exit;
      end
      else if (lMsg = 0) and (Trim(sText) <> '') then
        exit;
    end;
  end;
  Result := True;
end;

Function GetID(Aqy: TADOQuery; TableName,DHFieldName,DateFieldName,TypeFieldName,TypeValue:String;
BeginPos,StrLen:integer):boolean;
var
  ls_tkdh, TypeName:string;
  ADOQryTmp: TADOQuery;
begin
  TypeName:=copy(TypeValue,1,2);  //根据进库、出库类型得到单据号前缀
  try
    ADOQryTmp:= TADOQuery.Create(Nil);
    GetConn(ADOQryTmp);
    with  ADOQryTmp do
    begin
      Close;
      Sql.Clear;
      Sql.Add('select SubString('+DHFieldName+',:BeginPos,:StrLen) from ' +TableName);
      Sql.Add('where '+DateFieldName+' =:date_1');
      Sql.Add('And '+TypeFieldName+' =:TypeFieldName');
      Parameters.ParamByName('BeginPos').Value :=BeginPos;
      Parameters.ParamByName('StrLen').Value :=StrLen;
      Parameters.ParamByName('date_1').Value :=date;
      Parameters.ParamByName('TypeFieldName').Value :=TypeValue;
      open;
    end;
    ls_tkdh:=ADOQryTmp.Fields[0].AsString;
    if ls_tkdh = ''  then//如果没有数据则为第一条
      ls_tkdh :=TypeName+FormatDateTime('YYYYMMDD',Date)+'0001'
    else//否则取最大的一条数据并将其序号加 1
      ls_tkdh :=TypeName+FormatDateTime('YYYYMMDD',Date)+FormatFloat('0000',StrToInt(ADOQryTmp.Fields[0].value)+1);
    Aqy.Open ;//打开进货表单
    Aqy.Insert;//插入一条新数据
    Aqy.FieldByName(DateFieldName).AsDateTime :=date;  //写 时间 字段
    Aqy.FieldByName(DHFieldName).AsString:=ls_tkdh;    //写 单号 字段
    Aqy.FieldByName(TypeFieldName).AsString :=TypeValue;
//    Aqy.Post ;                                         //存盘
    Result:=True;                                      //返回 真
  except
    Result:=False;                                     //如果有错，则返回 假
  end;
  ADOQryTmp.Close;
  ADOQryTmp.Free; 
end;

Function IDGen(Aqy: TADOQuery; DJType, TableName,DHFieldName,DateFieldName:String ;BeginPos,StrLen:integer):boolean;
Var
  ls_tkdh, CodeName:string;
  ADOQryTmp: TADOQuery;
begin
  ADOQryTmp:= TADOQuery.Create(Nil);
  GetConn(ADOQryTmp);

  CodeName:= Copy(DJType, 1, 2);
//  CodeName:=copy(TableName,1,2);  //根据数据库的名称得到单据号前缀
  try
    with  ADOQryTmp do
    begin
      Close;
      Sql.Clear;
      Sql.Add('select MAX(SubString('+DHFieldName+',:BeginPos,:StrLen)) from ' +TableName);
      Sql.Add('where '+DateFieldName+' =:date_1');
      Parameters.ParamByName('BeginPos').Value :=BeginPos;
      Parameters.ParamByName('StrLen').Value :=StrLen;
      Parameters.ParamByName('date_1').Value :=date;
      open;
    end;
    ls_tkdh:=ADOQryTmp.Fields[0].AsString;
    if ls_tkdh = ''  then//如果没有数据则为第一条
      ls_tkdh :=CodeName+FormatDateTime('YYYYMMDD',Date)+'0001'
    else//否则取最大的一条数据并将其序号加 1
      ls_tkdh :=CodeName+FormatDateTime('YYYYMMDD',Date)+FormatFloat('0000',StrToInt(ADOQryTmp.Fields[0].value)+1);
    Aqy.Open ;//打开进货表单
    Aqy.Insert;//插入一条新数据
    Aqy.FieldByName(DateFieldName).AsDateTime :=date;  //写 时间 字段
    Aqy.FieldByName(DHFieldName).AsString:=ls_tkdh;    //写 单号 字段
    Aqy.Post ;                                         //存盘
    Result:=True;                                      //返回 真
  except
    Result:=False;                                     //如果有错，则返回 假
  end;
  ADOQryTmp.Close;
  ADOQryTmp.Free; 
end;

procedure ConnAccess(AdoConn: TADOConnection; FileName, UserName, Password: string);
begin
  AdoConn.Close;
  AdoConn.LoginPrompt := False;
  AdoConn.ConnectionString:=
    'Provider=MSDASQL.1;Password=' + Password +
    ';Persist Security Info=False;User ID=' + UserName +
    ';Extended Properti' + 'es="DSN=MS Access Database;DBQ=' + FileName +
    ';DefaultDir=' + ExtractFilePath(FileName) +
    ';DriverId=281;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;UID=admin;"';
  AdoConn.Open;
end; 

procedure SetField(StrTarget,StrSource: string; ADOQryTarget,
  ADOQrySource: TADOQuery);
var
  S1, S2, S11, S22: string;
begin
  S1:= StrTarget + ',';
  S11:= StrSource + ',';
  ADOQryTarget.Edit;
  while pos(',', S1) <>0 do
  begin
    //截取，之前的字符串
    S2:= Copy(S1, 0, Pos(',', S1)-1);
    S22:= Copy(S11, 0, Pos(',', S11)-1);
    //截取，之后的字符串
    S1 := Copy(S1, pos(',', S1) + 1, Length(S1));
    S11:= Copy(S11, Pos(',', S11)+1, Length(S11));
    ADOQryTarget.FieldByName(S2).AsString := ADOQrySource.FieldByName(S22).AsString;
  end;
  ADOQryTarget.Post;
  ADOQryTarget.Edit; 
end;

procedure SendMsg(hWnd, Msg, wParam: Integer; lParam: Integer = 0);
begin
  //Handle,WM_KEYDOWN,VK_TAB
  SendMessage(hWnd, Msg, wParam, lParam);
end;

function SplitString(const source, ch: string): tstringlist;
//分解字符串,ch---分割符
var
  temp: string;
  i: integer;
begin
  result := tstringlist.Create;
  temp := source;
  i := pos(ch, source);
  while i <> 0 do
  begin
    if copy(temp, 0, i - 1) <> '' then
      result.Add(copy(temp, 0, i - 1));
    delete(temp, 1, i);
    i := pos(ch, temp);
  end;
  if temp <> '' then
    result.Add(temp);
end;

function locate_string(line_string:string;start_position,end_position:integer):string;
var
  start_pos,end_pos,total_pos,n,key_pos:integer;
  temp_string,split:string;
begin
  split:=',';
  n:=0;
  total_pos:=0;
  temp_string:=line_string;
  while n<start_position do
  begin
    key_pos:=pos(split,temp_string);
    if key_pos>0 then
    begin
      n:=n+1;
      delete(temp_string,1,key_pos);
      total_pos:=total_pos+key_pos;
    end;
  end;
  start_pos:=total_pos;

  n:=0;
  total_pos:=0;
  temp_string:=line_string;
  while n<end_position do
  begin
    key_pos:=pos(split,temp_string);
    if key_pos>0 then
    begin
      n:=n+1;
      delete(temp_string,1,key_pos);
      total_pos:=total_pos+key_pos;
    end;
  end;
  end_pos:=total_pos;
  locate_string:=copy(line_string,start_pos,end_pos-start_pos+1);
end;

function StrToInt2(s: string): Integer;
var
  i, lB, lE: Integer;
  s1, c: string;
begin
  Result := 0;
  if Trim(s) = '' then
    Exit;

  s1 := s + '!';
  for i := 1 to Length(s1) do
  begin
    if Copy(s1, i, 1) <> ' ' then
      break;
  end;
  lB := i;

  for i := lB to Length(s1) do
  begin
    c := Copy(s1, i, 1);
    if (c < '0') or (c > '9') then
      break;
  end;
  lE := i;

  if lb >= lE then
    Result := 0
  else
    Result := StrToInt(Copy(s1, lB, lE - lB));
end;

function StrToGridField(Grid1: TDBGridEh; sFieldName, sCaption, sWidth: string;
  sMask: string = ''):
  Boolean;
var
  s1, s2: string;
  lCol: Integer;
begin
  Result := False;
  if (sFie