c_define.pas

经典的酒店管理系统

function AddDH(DH: string) : string;
function GetMc(const AMc: string): string;
function GetSjdm(ATime: TDateTime): string;
function GetSjdm1(ATime: TDateTime): string;

function DoCopyDir(sDirName,sToDirName: string) : Boolean;
function CopyDir(sDirName,sToDirName: string) : Boolean;
function DoRemoveDir(sDirName: string) : Boolean;
function DeleteDir(sDirName: string) : Boolean;

procedure PrintLb(APrintStru: TPrintStru;ADBGrid: TDBGrid);
procedure PrintLb1(APrintStru: TPrintStru;ADBGrid: TDBGridEh);

function GetPYIndexChar( hzchar:string):char;
function GetIndexStr(hzchar:Widestring):string;

implementation

uses C_Sysprint, C_HotelData;

//产生汉字串的拼音开头大写字母（常用汉字，用时需确定是否产生大写字母）
//此函数嵌套了GetPYIndexChar()函数
function GetPYIndexChar( hzchar:string):char;
begin
  case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
    $B0A1..$B0C4 : result := 'A';
    $B0C5..$B2C0 : result := 'B';
    $B2C1..$B4ED : result := 'C';
    $B4EE..$B6E9 : result := 'D';
    $B6EA..$B7A1 : result := 'E';
    $B7A2..$B8C0 : result := 'F';
    $B8C1..$B9FD : result := 'G';
    $B9FE..$BBF6 : result := 'H';
    $BBF7..$BFA5 : result := 'J';
    $BFA6..$C0AB : result := 'K';
    $C0AC..$C2E7 : result := 'L';
    $C2E8..$C4C2 : result := 'M';
    $C4C3..$C5B5 : result := 'N';
    $C5B6..$C5BD : result := 'O';
    $C5BE..$C6D9 : result := 'P';
    $C6DA..$C8BA : result := 'Q';
    $C8BB..$C8F5 : result := 'R';
    $C8F6..$CBF9 : result := 'S';
    $CBFA..$CDD9 : result := 'T';
    $CDDA..$CEF3 : result := 'W';
    $CEF4..$D188 : result := 'X';
    $D1B9..$D4D0 : result := 'Y';
    $D4D1..$D7F9 : result := 'Z';
  else
    result := char(0);
  end;
end;

//GetPYIndexChar()函数
//产生汉字的拼音开头大写字母（常用汉字，用时需确定是否产生大写字母）
function GetIndexStr(hzchar:Widestring):string;
var
    i:      integer;
    tStr:   WideString;
begin
    for i := 1 to length(hzchar) do
    begin
        tStr := GetPYIndexChar(hzchar[i]);
        if tStr = #0 then
            result := result + UPPERCASE(hzchar[i])
        else
            result := result + LOWERCASE(tStr);
    end
end;
procedure PrintLb(APrintStru: TPrintStru;ADBGrid: TDBGrid);
var
  I,Pos     : Integer;
  AColumns  : TStringList;
  APosition : TStringList;
  AFields   : TStringList;
begin
  AColumns := TStringList.Create;
  try
    APosition := TStringList.Create;
    try
      AFields := TStringList.Create;
      try
        Pos := 10;
        for I:= 0 to ADBGrid.Columns.Count-1 do
        begin
          AColumns.Add(ADBGrid.Columns[I].Title.Caption);
          AFields.Add(ADBGrid.Columns[I].FieldName);
          APosition.Add(IntToStr(Pos));
          Pos := Pos + ADBGrid.Columns[i].Width;
        end;

        APrintStru.AColumns := AColumns;
        APrintStru.AFields  := AFields;
        APrintStru.APosition:= APosition;
        if Pos > 730 then
          APrintStru.AFs      := PRN_LandScape
        else
          APrintStru.AFs      := PRN_Portrait;
        SysPrint(APrintStru);
      finally
        AFields.Free;
      end;
    finally
      APosition.Free;
    end;
  finally
    AColumns.Free;
  end;
end;

procedure PrintLb1(APrintStru: TPrintStru;ADBGrid: TDBGridEh);
var
  I,Pos     : Integer;
  AColumns  : TStringList;
  APosition : TStringList;
  AFields   : TStringList;
begin
  AColumns := TStringList.Create;
  try
    APosition := TStringList.Create;
    try
      AFields := TStringList.Create;
      try
        Pos := 10;
        for I:= 0 to ADBGrid.Columns.Count-1 do
        begin
          AColumns.Add(ADBGrid.Columns[I].Title.Caption);
          AFields.Add(ADBGrid.Columns[I].FieldName);
          APosition.Add(IntToStr(Pos));
          Pos := Pos + ADBGrid.Columns[i].Width;
        end;

        APrintStru.AColumns := AColumns;
        APrintStru.AFields  := AFields;
        APrintStru.APosition:= APosition;
        if Pos > 730 then
          APrintStru.AFs      := PRN_LandScape
        else
          APrintStru.AFs      := PRN_Portrait;
        SysPrint(APrintStru);
      finally
        AFields.Free;
      end;
    finally
      APosition.Free;
    end;
  finally
    AColumns.Free;
  end;
end;

function DoCopyDir(sDirName,sToDirName: string) : Boolean;
var
  hFindFile    : Cardinal;
  t,tFile      : string;
  sCurDir      : string[255];
  FindFileData : WIN32_FIND_DATA;
begin
  sCurDir := GetCurrentDir;
  ChDir(sDirName);
  hFindFile := FindFirstFile('*.*',FindFileData);
  if hFindFile <> INVALID_HANDLE_VALUE then
  begin
    if not DirectoryExists(sToDirName) then
      ForceDirectories(sToDirName);
    Repeat
      tFile := FindFileData.cFileName;
      if (tFile='.') or (tFile='..') then
        Continue;
      if FindFileData.dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY then
      begin
        t := sToDirName + '\' + tFile;
        if not DirectoryExists(t) then
          ForceDirectories(t);
        if sDirName[Length(sDirName)]<>'\' then
          DoCopyDir(sDirName+'\'+tFile,t)
        else
          DoCopyDir(sDirName+tFile,sToDirName+tFile);
      end
      else
      begin
        t := sToDirName + '\' + tFile;
        CopyFile(PChar(tFile),PChar(t),False);
      end;
    until FindNextFile(hFindFile,FindFileData)=False;
    Windows.FindClose(hFindFile)
  end
  else
  begin
    ChDir(sCurDir);
    Result := False;
    Exit;
  end;
  ChDir(sCurDir);
  Result := True;
end;

function CopyDir(sDirName,sToDirName: string) : Boolean;
begin
  if Length(sDirName)<=0 then
  begin
    Result := False;
    Exit;
  end;
  Result := DoCopyDir(sDirName,sToDirName);
end;

function DoRemoveDir(sDirName: string) : Boolean;
var
  hFindFile : Cardinal;
  tFile     : string;
  sCurrDir  : string;
  bEmptyDir : Boolean;
  FindFileData : WIN32_FIND_DATA;
begin
  Result := True;
  bEmptyDir := True;
  sCurrDir  := GetCurrentDir;
  SetLength(sCurrDir,Length(sCurrDir));
  ChDir(sDirName);
  hFindFile := FindFirstFile('*.*',FindFileData);
  if hFindFile <> INVALID_HANDLE_VALUE then
  begin
    Repeat
      tFile := FindFileData.cFileName;
      if (tFile='.') or (tFile='..') then
      begin
        bEmptyDir := bEmptyDir and True;
        Continue;
      end;
      bEmptyDir := False;
      if FindFileData.dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY then
      begin
        if sDirName[Length(sDirName)] <> '\' then
          DoRemoveDir(sDirName+'\'+tFile)
        else
          DoRemoveDir(sDirName+tFile);
        Result := RemoveDirectory(PChar(tFile));
      end
      else
      begin
        Result := DeleteFile(PChar(tFile));
      end;
    until FindNextFile(hFindFile,FindFileData)=False;
    Windows.FindClose(hFindFile);
  end
  else
  begin
    ChDir(sCurrDir);
    Result := False;
    Exit;
  end;
  if bEmptyDir then
  begin
    ChDir('..');
    RemoveDirectory(PChar(sDirName));
  end;
  ChDir(sCurrDir);
end;

function DeleteDir(sDirName: string) : Boolean;
begin
  if Length(sDirName)<=0 then
  begin
    Result := False;
    Exit;
  end;
  Result := DoRemoveDir(sDirName) and RemoveDir(sDirName);
end;


function GetSjdm(ATime: TDateTime): string;
begin
  if (ATime>EnCodeTime(5,0,0,0))and(ATime<EnCodeTime(10,0,0,0)) then
    Result := Morning
  else
  if (ATime>EnCodeTime(10,0,0,0))and(ATime<EnCodeTime(16,0,0,0)) then
    Result := Noon
  else
    Result := Night;
end;

function GetSjdm1(ATime: TDateTime): string;
begin
  if (ATime>EnCodeTime(7,0,0,0))and(ATime<EnCodeTime(12,0,0,0)) then
    Result := '上午'
  else
  if (ATime>EnCodeTime(12,0,0,0))and(ATime<EnCodeTime(18,0,0,0)) then
    Result := '下午'
  else
    Result := '晚上';
end;

function GetMc(const AMc: string): string;
var
  p: Integer;
begin
  p := Pos('|',AMc);
  //if p=0 then
    //Result := AMc
  //else
    Result := Copy(AMc,p+1,Length(AMc)-p);

end;

function CheckDdsj(ATime: TDateTime): Integer;
var
  HH,NN,SS: Word;
begin
  HotelData.GetYssj(HH,NN,SS);
  Result:= BQJ_ZC;

  if (ATime>EnCodeTime(HH,NN,SS,0))or(ATime<EnCodeTime(6,0,0,0)) then
      if (ATime>EnCodeTime(5,30,0,0))and(ATime<EnCodeTime(6,0,0,0)) then
        Result:= BQJ_BJ
      else
        Result:= BQJ_QJ;
end;

function CheckLdsj(ADTime,ALTime: TDateTime;AKfbz: string): Integer;
begin
  Result:= BQJ_ZC;
  if AKfbz=KFBZ_DT then
  begin
    if (ADTime<EnCodeTime(6,0,0,0))or(ADTime>EnCodeTime(23,0,0,0)) then
      Result:= BQJ_QJ
    else if (ADTime>=EnCodeTime(6,0,0,0))and(ALTime<=EnCodeTime(18,0,0,0)) then
      Result:= BQJ_BJ
    else
      Result:= BQJ_QJ;
  end;
  if AKfbz=KFBZ_FT then
  begin
    if (ALTime>EnCodeTime(12,0,0,0))and(ALTime<=EnCodeTime(18,0,0,0)) then
      Result:= BQJ_BJ
    else if ALTime>EnCodeTime(18,0,0,0) then
      Result:= BQJ_QJ;
  end;
end;

function GetDtfj(ADTime,ALTime: TDateTime;AKfbz: string;ASjfj: Currency): Currency;
var
  ABqj: Integer;
begin
  Result := 0;
  ABqj := CheckLdsj(ADTime,ALTime,AKfbz);
  case ABqj of
    BQJ_QJ: Result := ASjfj;
    BQJ_BJ: Result := ASjfj/2;
  end;
end;

procedure ShowWarning(AMessage: string);
begin
  Application.MessageBox(PChar(AMessage),'警告',MB_OK);
end;

procedure ShowInfo(AMessage: string);
begin
  Application.MessageBox(PChar(AMessage),'提示',MB_OK);
end;

function Confirm(AMessage: string): Boolean;
begin
  Result := Application.MessageBox(PChar(AMessage),'警告',MB_YESNO) = IDYES;
end;

function AddDH(DH: string) : string;
var
  d,s:string;
  n:integer;
begin
  d:= Copy(DH,2,8);
  s:= Copy(DH,10,3);
  n:= StrToInt(s)+1;
  if d <> FormatDateTime('yyyymmdd',Date) then
  begin
    d:= FormatDateTime('yyyymmdd',Date);
    n:= 1;
  end;
  if (n>0) and (n<10) then s:= '00';
  if (n>9) and (n<100) then s:= '0';
  if (n>99) and (n<1000) then s:= '';
  s:= s+IntToStr(n);
  Result:= d+s;
end;

end.