common.pas

delphi作得信息业进销存源码.功能全面,运行稳定.

unit Common;

interface

uses BDE, Windows, Dialogs, SysUtils, DBCtrls, DB, DBGrids, DBTables, Grids,
  stdctrls,clipbrd, menus,comctrls,Forms, Messages, Classes, Graphics, Controls,
  ExtCtrls, ImgList, ToolWin, Mask, Buttons, DBClient, syncobjs, dbcgrids, Variants ;

type
	cdsEventsRecord = record
		re: TRemoteEvent;
		ne: TDataSetNotifyEvent;
		ee: TDataSetErrorEvent;
		fe: TFilterRecordEvent;
		ce: TReconcileErrorEvent;
	end;
cdsEventsArray = array[1..20] of cdsEventsRecord;

{ 网格 }
Function  ChangeCol(Const DBGrid:TDBGrid; var Key:Word):integer; 	//用回车改变DBGrid内输入焦点
Procedure DBGridAlign(DBGrid:TDBGrid;Align: TAlignment;Rect:TRect;Text:String); 	//自画网格
Procedure GridTextRect(Grid:TWinControl; Align: TAlignment; Rect:TRect; Text:String);
function  GetColumnByName(Grid:TDBGrid; FieldName:string):TColumn;//由字段名得出DBGRID的Column
Function  FindField(Data:TDataset;Str:String):TField;  //按displaylabel查找字段
{ SQL }
function SetFieldValue(strSql:string; Ds: TDataSet; strFields: string; blnFill: Boolean = False):boolean;
 //传递SQL语句，对指定DATASET的指定字段赋值，有记录返回真值，无记录返回假值
procedure SqlExec(strSql: string);  //执行SQL语句
function  CheckRecord(strSql: string):Boolean;  //检查是否有符合条件的记录
function  FieldsValueToStr(DataSet: TDataSet; strFields: string): string;  //将字段的值替换出来，像宏替换一样
function  HaveDetail(DataSet: TDataSet; strTables, strWheres: string): boolean;  //检查是否有明细记录
function  GetFieldValue(strSql: string):Variant;  //返回sql语句的字段值（一个）
function  SaveCDSEvents(ds: TClientDataSet): cdsEventsArray;  //保存CLIENTDATASET的事件
procedure RestoreCDSEvents(ds: TClientDataSet; e: cdsEventsArray);  //恢复CLIENTDATASET的事件
procedure ClearCDSEvents(ds: TClientDataSet);  //清除CLIENTDATASET的事件
function  CurDs: TClientDataSet;  //返回一个可用的clientdataset
function  ComReconcileError(DataSet: TClientDataSet; UpdateKind: TUpdateKind;
          E: EReconcileError): TReconcileAction;//存盘出错处理

{ 取系统信息 }
function  GetComputerName: AnsiString;  //取本机的计算机名称

var
  dsTmpArr: array of TClientDataSet;

implementation

uses
	Dm, Main, ComFun;

//剪切DBGRID或DBEDIT的内容
procedure MCut;
Begin
  if Screen.ActiveControl is TDBGrid then
  begin
    If not ( dgRowSelect In TDBGrid( Screen.ActiveControl ).Options ) and
       not ( TDBGrid( Screen.ActiveControl ).Readonly ) Then
    Begin
      ClipBoard.AsText := TDBGrid( Screen.ActiveControl ).SelectedField.AsString;
      TDBGrid( Screen.ActiveControl ).DataSource.DataSet.Edit;
      TDBGrid( Screen.ActiveControl ).SelectedField.Clear;
		end;
  end else if Screen.ActiveControl is TDBEdit then
  begin
    If not ( TDBEdit( Screen.ActiveControl ).Readonly ) Then
    Begin
      TDBEdit( Screen.ActiveControl ).CutToClipboard;
      TDBEdit( Screen.ActiveControl ).SelText := '';
    end;
  end;
end;

//复制DBGRID或DBEDIT的内容
procedure MCopy;
Begin
  if Screen.ActiveControl is TDBGrid then
    ClipBoard.AsText := TDBGrid( Screen.ActiveControl ).SelectedField.AsString
  else if Screen.ActiveControl is TDBEdit then
    TDBEdit( Screen.ActiveControl ).CopyToClipboard;
end;

//粘贴DBGRID或DBEDIT的内容
procedure Mpaste;
Begin
	if Screen.ActiveControl is TDBGrid then
  begin
    If not ( dgRowSelect In TDBGrid( Screen.ActiveControl ).Options ) and
       not ( TDBGrid( Screen.ActiveControl ).Readonly ) Then
    Begin
			TDbGrid( Screen.ActiveControl ).DataSource.DataSet.Edit;
			TDbGrid( Screen.ActiveControl ).SelectedField.AsString := Clipboard.AsText;
    end;
  end
  else if Screen.ActiveControl is TDBEdit then
  begin
    If not ( TDBEdit( Screen.ActiveControl ).Readonly ) Then
    Begin
      TDBEdit( Screen.ActiveControl ).DataSource.DataSet.Edit;
      TDBEdit( Screen.ActiveControl ).PasteFromClipboard;
		end;
  end
end;


//用回车改变DBGrid内输入焦点
Function ChangeCol(Const DBGrid:TDBGrid; var Key:Word):integer;
var
  EndCol:Integer;
	flag1 : boolean;
begin
  EndCol:=DBGrid.Columns.Count-1;
  Flag1 := false;
  if Key= vk_Return then
  begin
    Key:=0;
//    If not ( Dbgrid.EditorMode ) Then
//      Dbgrid.editormode := True
//    else
		Begin
      with DBGrid.DataSource.DataSet do
      begin
         if DBGrid.SelectedIndex<>EndCol then
         Begin
           DBGrid.SelectedIndex:=DBGrid.SelectedIndex+1;
           While ( DBGrid.SelectedIndex < EndCol )
             and ( Dbgrid.Columns[dbgrid.SelectedIndex].readonly ) Do
             DBGrid.SelectedIndex:=DBGrid.SelectedIndex+1;
					 If ( DBGrid.SelectedIndex = EndCol )
             and ( Dbgrid.Columns[dbgrid.SelectedIndex].readonly ) then
             flag1 := True;
//           else
//             Dbgrid.editormode := True;
         end else
           Flag1 := True;
         If Flag1 Then
         begin
            Next;
						if not Eof then
            begin
              DBGrid.SelectedIndex:=0;
            end else
            begin
              Dbgrid.datasource.DataSet.Append;
              DBGrid.SelectedIndex:=0;
            end;
         end;
			end;
    end;
  end;
  Result:=0;
end;

//自画网格
Procedure DBGridAlign(DBGrid:TDBGrid; Align: TAlignment; Rect:TRect; Text:String);
begin
  with DBGrid.Canvas,Rect do
	begin
    Case Align of
      taLeftJustify:
        TextRect(Rect,2+Left,Top+(Bottom-Top-TextHeight(Text)) div 2 ,Text);
      taRightJustify:
        TextRect(Rect,Right-TextWidth(Text)-2,Top+(Bottom-Top-TextHeight(Text)) div 2 ,Text);
			taCenter:
        TextRect(Rect,Left+(Right-Left-TextWidth(Text)) div 2,Top+(Bottom-Top-TextHeight(Text)) div 2,Text);
    end;
	end;
end;

Procedure GridTextRect(Grid:TWinControl; Align: TAlignment; Rect:TRect; Text:String);
begin
  if Grid is TDBGrid then
  begin
    with TDBGrid(Grid).Canvas, Rect do
    begin
      Case Align of
        taLeftJustify:
          TextRect(Rect,2+Left,Top+(Bottom-Top-TextHeight(Text)) div 2 ,Text);
        taRightJustify:
          TextRect(Rect,Right-TextWidth(Text)-2,Top+(Bottom-Top-TextHeight(Text)) div 2 ,Text);
        taCenter:
          TextRect(Rect,Left+(Right-Left-TextWidth(Text)) div 2,Top+(Bottom-Top-TextHeight(Text)) div 2,Text);
      end;
    end;
  end else
  if Grid is TStringGrid then
  begin
    with TStringGrid(Grid).Canvas, Rect do
    begin
      Case Align of
        taLeftJustify:
          TextRect(Rect,2+Left,Top+(Bottom-Top-TextHeight(Text)) div 2 ,Text);
        taRightJustify:
          TextRect(Rect,Right-TextWidth(Text)-2,Top+(Bottom-Top-TextHeight(Text)) div 2 ,Text);
        taCenter:
          TextRect(Rect,Left+(Right-Left-TextWidth(Text)) div 2,Top+(Bottom-Top-TextHeight(Text)) div 2,Text);
      end;
    end;
  end else
  if Grid is TDBCtrlGrid then
  begin
    with TDBCtrlGrid(Grid).Canvas, Rect do
    begin
      Case Align of
        taLeftJustify:
          TextRect(Rect,2+Left,Top+(Bottom-Top-TextHeight(Text)) div 2 ,Text);
        taRightJustify:
          TextRect(Rect,Right-TextWidth(Text)-2,Top+(Bottom-Top-TextHeight(Text)) div 2 ,Text);
        taCenter:
          TextRect(Rect,Left+(Right-Left-TextWidth(Text)) div 2,Top+(Bottom-Top-TextHeight(Text)) div 2,Text);
      end;
    end;
  end;
end;

//由字段名得出DBGRID的Column
function  GetColumnByName(Grid:TDBGrid; FieldName:string):TColumn;
var
  i: integer;
begin
  Result := nil;
  for i := 0 to Grid.Columns.Count - 1 do
  begin
    if UpperCase(Grid.Columns[i].FieldName) = UpperCase(FieldName) then
    begin
      Result := Grid.Columns[i];
      exit;
    end;
  end;
end;

//按displaylabel查找字段
function FindField(Data:TDataset;Str:String):TField;
var
  i:integer;
begin
  Result:= nil;
	for i:=0 To Data.Fieldcount-1 Do
	if Data.Fields[i].DisplayLabel = Str Then
	begin
		Result := Data.Fields[i];
		Break;
	end;
end;

//传递SQL语句，对指定DATASET的指定字段赋值
//strSql:SQL语句;
//Ds:要赋值的DATASET；
//strFields:要赋值的字段列表，用';'分开
//blnFill: 逻辑型参数（默认为False），当为True时无记录即对字段列表均赋空值
//有记录返回真值，无记录返回假值
function SetFieldValue(strSql:string; Ds: TDataSet; strFields: string; blnFill: Boolean = False):boolean;
var
  strFieldName: string;
  i: integer;
  dsTmp: TCLientDataSet;
begin
  dsTmp := CurDs;
  with dsTmp do
  begin
    CommandText := strSql;
    Open;
    if IsEmpty then
    begin
      if blnFill then
        while strFields <> '' do
        begin
          if Pos(';', strFields) <> 0 then
          begin
            strFieldName := copy(strFields, 1, Pos(';', strFields)-1);
            strFields := copy(strFields, Pos(';', strFields)+1, length(strFields));
          end else
          begin
            strFieldName := strFields;
            strFields := '';
          end;
          if not (ds.State in [Dsinsert,Dsedit]) then
            ds.Edit;
          if ds.FieldByName(strFieldName) is TNumericField then
            ds.FieldByName(strFieldName).Value := 0;
          if ds.FieldByName(strFieldName) is TStringField then
            ds.FieldByName(strFieldName).Value := '';
        end;
      Close;
      Result := False;
      exit;
    end;
  end;
	i := 0;
  while strFields <> '' do
  begin
		if Pos(';', strFields) <> 0 then
    begin
      strFieldName := copy(strFields, 1, Pos(';', strFields)-1);
			strFields := copy(strFields, Pos(';', strFields)+1, length(strFields));
    end else
    begin
			strFieldName := strFields;
      strFields := '';
    end;
    if not (ds.State in [Dsinsert,Dsedit]) then
      ds.Edit;
    ds.FieldByName(strFieldName).Value := dsTmp.Fields[i].Value;
    inc(i);
  end;
  dsTmp.Close;
  Result := True;