umdmmain.~pas

完整的一个用于考勤排班功能的程序

unit umdmMain;

interface

uses
  SysUtils, Classes, DB, ADODB, IniFiles, Forms, Printers, Graphics,
  Windows, ComCtrls;
 function CompressDataBase(SouceFile: string): Boolean;
 function CompressMDB(SouceFile, DestFile: string): Boolean;


const
  cAPPEND  = 1;
  cEDIT    = 2;

type
  TIniRecord = record

    UnitName   : string;
    UnitMan    : string;
    UnitTel    : string;
    UnitFax    : string;
    UnitAddr   : string;
    PrintBase  : Boolean;
    PrintBill  : Boolean;
    BillString : string;

    EmployeeTC : Boolean;
    GoodTC     : Boolean;
    ServiceTC   : Boolean;
    IntTrunc   : Boolean;
    DayTime    : TDateTime;
    AdvRate      : Integer;
    UserRate     : Integer;

    BigestLogs : Integer;
    ClearHalf  : Boolean;
    BakDir     : string;
    AutoBak    : Boolean;
  end;

type
  TOperator = record
    No      : Integer;
    Name    : string;
    TypeNo  : Integer;
    Code    : string;
  end;



type
  TdmMain = class(TDataModule)
    cntMain: TADOConnection;
    qryQuery: TADOQuery;
    qryUpdate: TADOQuery;
    qryDelete: TADOQuery;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);

  private
    procedure InitDataBase(DataFile: string);
  public
    procedure ReadIni;
    procedure WriteIni;
    procedure ExecUpdate(SQLstr: string);
    procedure ExecDelete(SQLstr: string);
    function GetMaxNo(aTableName: string; aFieldName: string): Integer;
    function GetValue(const aTableName, rFieldName, bFieldName, bVaule: string; IsString: Boolean): string;
    function DeleteLastChar(str: string): string;
    function LRAlignment(const SourceStr: string;
                         StrSize, LOrR: Integer): string;
    function CenterAlignment(Const SourceStr: string; StrSize: Integer): string;

    procedure PrintCheckByNo(CheckNo: string);
    function GetLineByNo(iNo: Integer): string;
  end;

var
  dmMain: TdmMain;
  AppPath: string;
  Operator : TOperator;
  IniRecord: TIniRecord;
//GetDeviceCaps(Printer.Handle,LOGPIXELSX)
implementation


{$R *.dfm}

{ TdmMain }

//读系统参数
procedure TdmMain.ReadIni;
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create(AppPath + 'Option.ini');
  try
    with ini do
    begin
      IniRecord.UnitName  := ReadString('UnitInfo','UnitName','');
      IniRecord.UnitMan   := ReadString('UnitInfo','UnitMan','');
      IniRecord.UnitTel   := ReadString('UnitInfo','UnitTel','');
      IniRecord.UnitFax   := ReadString('UnitInfo','UnitFax','');
      IniRecord.UnitAddr  := ReadString('UnitInfo','UnitAddr','');
      IniRecord.PrintBase := ReadBool('UnitInfo','PrintBase',True);
      IniRecord.PrintBill := ReadBool('UnitInfo','PrintBill',True);
      IniRecord.BillString:= ReadString('UnitInfo','BillString','');

      IniRecord.EmployeeTC:= ReadBool('Business','EmployeeTC',True);
      IniRecord.GoodTC    := ReadBool('Business','GoodTC',True);
      IniRecord.ServiceTC  := ReadBool('Business','ServiceTC',True);
      IniRecord.IntTrunc  := ReadBool('Business','IntTrunc',True);
      IniRecord.DayTime   := ReadTime('Business','DayTime',StrToTime('3:00:00'));
      IniRecord.AdvRate     := ReadInteger('Business','AdvRate',60);
      IniRecord.UserRate    := ReadInteger('Business','UserRate',90);

      IniRecord.BigestLogs:= ReadInteger('DataOption','BigestLogs',1000);
      IniRecord.ClearHalf := ReadBool('DataOption','ClearHalf',True);
      IniRecord.BakDir    := ReadString('DataOption','BakDir','');
      IniRecord.AutoBak   := ReadBool('DataOption','AutoBak',True);
    end;
  finally
    Ini.Free;
  end;
end;

procedure TdmMain.WriteIni;
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create(AppPath + 'Option.ini');
  try
    with ini do
    begin
      WriteString('UnitInfo','UnitName',IniRecord.UnitName);
      WriteString('UnitInfo','UnitMan',IniRecord.UnitMan);
      WriteString('UnitInfo','UnitTel',IniRecord.UnitTel);
      WriteString('UnitInfo','UnitFax',IniRecord.UnitFax);
      WriteString('UnitInfo','UnitAddr',IniRecord.UnitAddr);
      WriteBool('UnitInfo','PrintBase',IniRecord.PrintBase);
      WriteBool('UnitInfo','PrintBill',IniRecord.PrintBill);
      WriteString('UnitInfo','BillString',IniRecord.BillString);

      WriteBool('Business','EmployeeTC',IniRecord.EmployeeTC);
      WriteBool('Business','GoodTC',IniRecord.GoodTC);
      WriteBool('Business','ServiceTC',IniRecord.ServiceTC);
      WriteBool('Business','IntTrunc',IniRecord.IntTrunc);
      WriteTime('Business','DayTime',IniRecord.DayTime);
      WriteInteger('Business','AdvRate',IniRecord.AdvRate);
      WriteInteger('Business','UserRate',IniRecord.UserRate);

      WriteInteger('DataOption','BigestLogs',IniRecord.BigestLogs);
      WriteBool('DataOption','ClearHalf',IniRecord.ClearHalf);
      WriteString('DataOption','BakDir',IniRecord.BakDir);
      WriteBool('DataOption','AutoBak',IniRecord.AutoBak);
    end;
  finally
    Ini.Free;
  end;
end;

procedure TdmMain.DataModuleCreate(Sender: TObject);
begin
  AppPath := ExtractFilePath(Application.ExeName);
  InitDataBase(AppPath + 'kq.mdb');
//  ReadIni;
end;

procedure TdmMain.InitDataBase(DataFile: string);
var
  Str: string;
begin
  if FileExists(DataFile) then
  begin
    cntMain.Connected:= False;
      Str:= 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";User ID=Admin;' +
            'Data Source=' + DataFile + ';' +
            'Mode=Share Deny None;Extended Properties="";' +
            'Jet OLEDB:System database="";Jet OLEDB:Registry Path="";' +
            'Jet OLEDB:Database Password="";Jet OLEDB:Engine Type=5;' +
            'Jet OLEDB:Database Locking Mode=1;' +
            'Jet OLEDB:Global Partial Bulk Ops=2;' +
            'Jet OLEDB:Global Bulk Transactions=1;' +
            'Jet OLEDB:New Database Password="";' +
            'Jet OLEDB:Create System Database=False;' +
            'Jet OLEDB:Encrypt Database=False;' +
            'Jet OLEDB:Don''t Copy Locale on Compact=False;' +
            'Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False';
      try
        cntMain.ConnectionString:= Str;
        cntMain.Connected:= True;
      except
        Application.MessageBox('无法连接数据库。','错误',48)
      end;
  end
  else begin
    Application.MessageBox(PChar('数据库文件(' + DataFile +')'
                           + #13 + '不存在！'),'提示',48)
  end;
end;

procedure TdmMain.DataModuleDestroy(Sender: TObject);
begin
  cntMain.Connected := False;
end;

procedure TdmMain.ExecUpdate(SQLstr: string);
begin
  with qryUpdate do
  begin
    if Active then
      Active := False;
    SQL.Clear;
    SQL.Add(SQLstr);
    ExecSQL;
    Active := False;
  end;
end;

procedure TdmMain.ExecDelete(SQLstr: string);
begin
  with qryDelete do
  begin
    if Active then
      Active := False;
    SQL.Clear;
    SQL.Add(SQLstr);
    ExecSQL;
    Active := False;
  end;
end;

//返回最大编号加1
function TdmMain.GetMaxNo(aTableName, aFieldName: string): Integer;
var
  TempInt: Integer;
begin
  Result := 1;
  with qryQuery do
  begin
    if Active then
      Active := False;
    SQL.Clear;
    SQL.Add('select Max(' + aFieldName
                    + ') As MaxRec from ' + aTableName);
    ExecSQL;
    Active := True;
    if RecordCount > 0 then
      TempInt := FieldByName('MaxRec').AsInteger + 1
    else
      TempInt := 1;
    Active := False;
  end;
  Result := TempInt;
end;

//根据一个字段的值返回另字段的值像Lookup
function TdmMain.GetValue(const aTableName, rFieldName, bFieldName,bVaule: string;
  IsString: Boolean): string;
var
  str: string;
begin
  Result := '';
  if IsString then
    str := Chr(39) + bVaule + Chr(39)
  else
    str := bVaule;
  with qryQuery do
  begin
    if Active then
      Active := False;
    SQL.Clear;
    SQL.Add('Select ' + rFieldName +' From ' + aTableName
            + ' Where ' + bFieldName +'='+str);
    Active := True;
    if RecordCount < 1 then
      Result := ''
    else begin
      First;
      Result := FieldByName(rFieldName).AsString;
    end;
    Active := False;
  end;
end;

function TdmMain.DeleteLastChar(str: string): string;
begin
  if Length(str) > 1 then
  begin
    Result := Copy(str,1,Length(str)-1);
  end
  else
    Result := '';
end;
//字符左,右对齐
function TdmMain.LRAlignment(const SourceStr: string;
  StrSize, LOrR: Integer): string;
var
  tmpstr: string;
  I: Integer;
begin

  if Length(SourceStr) >= StrSize then
    Result := SourceStr
  else begin
    tmpstr := '';
    for I := 1 to StrSize - Length(SourceStr) do
      tmpstr := tmpstr + ' ';
    if LOrR = 0 then
      Result := SourceStr + tmpstr
    else
      Result := tmpstr + SourceStr;
  end;
end;
//字符居中
function TdmMain.CenterAlignment(const SourceStr: string;
  StrSize: Integer): string;
var
  I, iLeft, AllSize: Integer;
  ltmpstr, rtmpstr: string;
begin
  if Length(SourceStr) >= StrSize then
    Result := SourceStr
  else begin
    ltmpstr := '';
    rtmpstr := '';
    AllSize := StrSize - Length(SourceStr);
    iLeft := AllSize div 2;
    for I := 1 to iLeft do
      ltmpstr := ltmpstr + ' ';
    for I := 1 to AllSize - iLeft do
      rtmpstr := rtmpstr + ' ';
    Result := ltmpstr + SourceStr + rtmpstr;
  end;
end;

procedure TdmMain.PrintCheckByNo(CheckNo: string);
var
  tmpqry: TADOQuery;
  MyFile: TextFile;
  sItemNo: string;
  sName,sPri: string;
  re: TRichEdit;
begin
  {
  re := TRichEdit.Create(frmMain);
  try
    re.Parent := frmMain;
    re.Visible := False;
    re.Font.Name := '宋体';
    re.Font.Size := 9;
    re.Lines.Add('');
    re.Lines.Add(CenterAlignment('美容美发消费单',36));
    re.Lines.Add('');
    re.Lines.Add(LRAlignment('名      称',20,0)
            + LRAlignment('数量',4,1)
            + LRAlignment('单价',6,1)
            + LRAlignment('金额',6,1));
    re.Lines.Add(GetLineByNo(36));
    tmpqry := TADOQuery.Create(self);
    try
      tmpqry.Connection := cntMain;
      with tmpqry do
      begin
        if Active then
          Active := False;
        SQL.Clear;
        SQL.Add('Select TDITNO,Sum(TDNUM) as nm,Sum(TDHJ) as hj From TDAC'
            + ' Where TDACNO=' + CheckNo
            + ' Group By TDITNO');
        Active := True;
        First;
        while not Eof do
        begin
          sItemNo := FieldByName('TDITNO').AsString;
          sName   := GetValue('BITERM','BINAM','BITNO',sItemNo,False);
          sPri    := GetValue('BITERM','BIPRI','BITNO',sItemNo,False);
          re.Lines.Add(LRAlignment(sName,20,0)
            + LRAlignment(FieldByName('nm').AsString,4,1)
            + LRAlignment(sPri,6,1)
            + LRAlignment(FieldByName('hj').AsString,6,1));
          Next;
        end;
        Active := False;
        re.Lines.Add(GetLineByNo(36));
        SQL.Clear;
        SQL.Add('Select TACCO.*,BMEM.BMNAM From TACCO,BMEM'
              + ' Where (TACCO.TAMNO=BMENO) and (TACNO='+CheckNo+')');
        Active := True;
        re.Lines.Add(LRAlignment('客人:'+FieldByName('BMNAM').AsString,18,0)
             + LRAlignment('消费金额:'+FieldByName('TAPAY').AsString,18,1));
        re.Lines.Add(LRAlignment('优惠:'+FieldByName('TARAT').AsString,18,0)
              + LRAlignment('应收金额:'+FieldByName('TAYSJE').AsString,18,1));
        re.Lines.Add(LRAlignment('收银:'+Operator.Name,18,0));
        re.Lines.Add(LRAlignment(DateTimeToStr(Now),36,0));
        re.Lines.Add(LRAlignment('欢迎光临',36,0));
        Active := False;
      end;
      re.Print('消费单');
    finally
      tmpqry.Free;
    end;
  finally
    re.Free;
  end;
  }
  end;

function TdmMain.GetLineByNo(iNo: Integer): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to iNo do
    Result := Result + '-';
end;

function CompressMDB(SouceFile, DestFile: string): Boolean;
var
  DAO: OLEVariant;
begin
 {
  Result:= False;
  if FileExists(SouceFile) then
  begin
    if FileExists(DestFile) then DeleteFile(PChar(DestFile));
    try
      if Ver = '97' then
        DAO:= CreateOleObject('DAO.DBEngine.35')  // Access97
      else
        DAO:= CreateOleObject('DAO.DBEngine.36'); // Access2000
      DAO.CompactDatabase(SouceFile, DestFile);
      Result:= True;
    except
    end;
  end;
  }
  end;

function CompressDataBase(SouceFile: string): Boolean;
var
  Str: string;
  Tempstr:string;
  begin
  Result := False;
  try
    Str:=AppPath + '~Temp.dat';
    TempStr:= 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";User ID=Admin;' +
            'Data Source=' + Str + ';';

    if SysUtils.FileExists(Str) then SysUtils.DeleteFile(Str);
    //JetEngine1.CompactDatabase(Src,Dest);
    if SysUtils.FileExists(Str) then // 压缩成功
    begin
      SysUtils.DeleteFile(SouceFile);
      CopyFile(PChar(Str), PChar(SouceFile), False);
      Result:= True;
      SysUtils.DeleteFile(Str);
    end;
  except
  end;
end;

end.