delphi 开发使用的基类D

unit Common;

interface

uses Classes, Windows, Forms, SysUtils, StdCtrls, Grids, Types, Registry,
  Messages, ShellAPI, Graphics;

type
  TCommon = class(TComponent)
  public
    function GetAppPath: string; // 取应用程序当前路径
    function GetTempDirectory: string; //取得操作系统临时目录的位置
    function DelFolder(const AsFolder: string): Boolean; //删除一个文件夹
    function DoubleToSingle(ADoubleStr: string): string;//将全角变成半角
    function JudgeAnsiChar(AStr: string): Boolean; //判断一个字符串是否为全英文字符
    function FillDigit(AText: string; ADigitCount: Integer): string;//设置字符的长度,如果不足补0
    function IfListExist(AString: TStrings; AFindString: string): Boolean;  //查找在列表中是否存在
    procedure QueryPress(Sender: TObject; var Key: Char);// 限制在查询输入框中不能输入单引号及双引号}
    procedure PressNumber(Sender: TObject; var Key: Char);// 限制只能输入数字、退格、TAB及回车键
    procedure PressFloat(Sender: TObject; var Key: Char);// 限制只能输入数字、退格、TAB及回车键和小数点

    procedure ShowInfo(AHelpString: string);  // 弹出 MessageBox 对话框(普通的对话框)
    procedure ShowError(AHelpString: string); // 弹出 MessageBox 对话框(显示错误的对话框)
    function IfShowOk(AHelpString: string): Boolean; // 弹出 MessageBox 对话框(有两个选项的选择对话框)
    function IfShowYesNoCancel(AHelpString: string): Integer; // 弹出 MessageBox 对话框(有三个选项的选择对话框)
    procedure ShowIconInfo(AInfoStr: string; AIconFlag: LongInt);  //弹一个可选择图标的提示框
    function ShowIconOKCancel(AInfoStr: string; AIconFlag: LongInt): Boolean;  //弹出可选择图标MessageBox 对话框(有两个选项的选择对话框)
    function ShowIconYesNoCancel(AInfoStr: string; AIconFlag: LongInt): Integer;  //弹出可选择图标的 MessageBox 对话框(有三个选项的选择对话框)

    procedure IdentityCard(AIdentity: string; var ASex: string;
              var ABirthDay: TDateTime; var AErrorCount: Integer);  //身份证的验证和属性分解
    procedure SetSgPos(ASg: TStringGrid; ACol, ARow: Integer; ARect: TRect; APos: string); //改变StringGrid内容的位置

    function EncryptStr(AStr: string): string; //加密字符串
    function DecodeStr(AStr: string): string; //解密字符串
    function ExistName(AName: string; AStringList: TStrings): Boolean;

    procedure ComboBoxLength(AComboBox: TComboBox);
    procedure ShowSql(ASqlText: string);
    function GetTimeString(AiTime: Integer): string;
    procedure DoTip(AifShow: Boolean; AStr: string = '');  //弹出数据处理提示框(过渡窗口)
  end;

const
  cCheck = '√';

var
  Common: TCommon;
  SDGsSkin, SDGsUseSkin: string;
  SDGiYear, SDGiMonth, SDGiDay: Word;
  SDGdtStart, SDGdtEnd: TDateTime;

implementation

uses afrmSqlMemo, afrmTip;

{ TCommon }

function TCommon.GetAppPath: string;
begin
  Result := ExtractFilePath(Application.ExeName);
end;

//弹一个可改变提示图标的对话框
procedure TCommon.ShowIconInfo(AInfoStr: string; AIconFlag: Integer);
begin
  Application.MessageBox(Pchar(AInfoStr), PChar('系统提示：'), AIconFlag + MB_OK);
end;

// 弹出可选择图标MessageBox对话框(有两个选项的选择对话框)
function TCommon.ShowIconOKCancel(AInfoStr: string;
  AIconFlag: Integer): Boolean;
begin
  if Application.MessageBox(Pchar(AInfoStr), PChar('系统提示：'),
    MB_OKCANCEL + MB_DEFBUTTON1  + AIconFlag ) = IDOK then
    Result := True
  else
    Result := False;
end;

//弹出可选择图标的 MessageBox对话框(有三个选项的选择对话框)
function TCommon.ShowIconYesNoCancel(AInfoStr: string;
  AIconFlag: Integer): Integer;
begin
  Result := 3;
  case Application.MessageBox(Pchar(AInfoStr), PChar('系统提示：'),
    MB_YESNOCANCEL + MB_DEFBUTTON1 + AIconFlag) of
    IDOK:
      Result := 1;
    IDNO:
      Result := 2;
    IDCANCEL:
      Result := 3;
  end;
end;

procedure TCommon.ShowInfo(AHelpString: string);
begin
  Application.MessageBox(Pchar(AHelpString), PChar('系统提示：'), MB_ICONEXCLAMATION + MB_OK);
end;

procedure TCommon.ShowError(AHelpString: string);
begin
  Application.MessageBox(Pchar(AHelpString), PChar('系统提示：'), MB_ICONERROR + MB_OK);
end;

function TCommon.IfShowOk(AHelpString: string): Boolean;
begin
  if Application.MessageBox(Pchar(AHelpString), PChar('系统提示：'),
    MB_OKCANCEL + MB_ICONEXCLAMATION + MB_DEFBUTTON1) = IDOK then
    Result := True
  else
    Result := False;
end;

function TCommon.IfShowYesNoCancel(AHelpString: string): Integer;
begin
  Result := 3;
  case Application.MessageBox(Pchar(AHelpString), PChar('系统提示：'),
    MB_YESNOCANCEL + MB_ICONEXCLAMATION + MB_DEFBUTTON1) of
    6:
      Result := 1;
    7:
      Result := 2;
    2:
      Result := 3;
  end;
end;

//身份证的验证和属性分解
procedure TCommon.IdentityCard(AIdentity: string; var ASex: string;
  var ABirthDay: TDateTime; var AErrorCount: Integer);
var
  iCharCount, iSex: Integer;
  sYear, sMonth, sDay, sBirthDay: string;
begin
  iCharCount := Length(AIdentity);
  if iCharCount <> 18 then
    if iCharCount <> 15 then
    begin
      Common.ShowInfo('您的身份证合法位数应该是15或18位，请检查！');
      AErrorCount := 9; // 9代表身份证验证出错
    end;

  if iCharCount = 18 then //18位身份证的判断
  begin
    if Pos('x', Copy(AIdentity, 1, 17)) > 0 then
    begin
      Common.ShowInfo('您的身份证格式不对，x只能是最后一位，请检查！');
      AErrorCount := 9; // 9代表身份证验证出错
    end
    else if Pos('X', Copy(AIdentity, 1, 17)) > 0 then
    begin
      Common.ShowInfo('您的身份证格式不对，x只能是最后一位，请检查！');
      AErrorCount := 9; // 9代表身份证验证出错
    end;

    sYear := Copy(AIdentity, 7, 4);
    sMonth := Copy(AIdentity, 11, 2);
    sDay := Copy(AIdentity, 13, 2);
    sBirthDay := sYear + '-' + sMonth + '-' + sDay;
    try
      ABirthDay := StrToDate(sBirthDay);
    except
      Common.ShowInfo('身份证的出生日期编码有误，请检查！');
      AErrorCount := 9;
    end;

    iSex := StrToInt(Copy(AIdentity, 17, 1));
    if iSex mod 2 = 0 then
      ASex := '1'
    else
      ASex := '0';
  end
  else if iCharCount = 15 then //18位身份证的判断
  begin
    sYear := Copy(AIdentity, 7, 2);
    sMonth := Copy(AIdentity, 9, 2);
    sDay := Copy(AIdentity, 11, 2);
    sBirthDay := '19' + sYear + '-' + sMonth + '-' + sDay;
    try
      ABirthDay := StrToDate(sBirthDay);
    except
      Common.ShowInfo('身份证的出生日期编码有误，请检查！');
      AErrorCount := 9;
    end;

    iSex := StrToInt(Copy(AIdentity, 15, 1));
    if iSex mod 2 = 0 then
      ASex := '1'
    else
      ASex := '0';
  end;
end;

//改变StringGrid内容的位置
procedure TCommon.SetSgPos(ASg: TStringGrid; ACol, ARow: Integer;
  ARect: TRect; APos: string);
var
  TmpPchar: array[0..2047] of Char;
  RectX: TRect;
begin
  RectX.Left := ARect.Left + 2;
  RectX.Right := ARect.Right - 2;
  RectX.Top := ARect.Top + 2;
  RectX.Bottom := ARect.Bottom - 2;
  ASg.Canvas.FillRect(RectX);
  StrPCopy(TmpPchar, ASg.Cells[ACol, ARow]);
  if APos = 'Center' then
    DrawText(ASg.Canvas.Handle, TmpPchar, -1, RectX, DT_CENTER or DT_VCENTER or DT_SINGLELINE)
  else if APos = 'Left' then
    DrawText(ASg.Canvas.Handle, TmpPchar, -1, RectX, DT_LEFT or DT_VCENTER or DT_SINGLELINE)
  else if APos = 'Right' then
    DrawText(ASg.Canvas.Handle, TmpPchar, -1, RectX, DT_RIGHT or DT_VCENTER or DT_SINGLELINE);
end;

//取得临时目录的位置
function TCommon.GetTempDirectory: string;
var
  sTemp: array[0..255] of char;
begin
  GetTempPath(255, @sTemp);
  Result := StrPas(sTemp);
end;

function TCommon.DoubleToSingle(ADoubleStr: string): string;//将全角变成半角
var
  I: Integer;
  Single: Char;
  sStr: string;
begin
  Result := '';
  I := 1;
  sStr := ADoubleStr;
  while I <= length(ADoubleStr) do
  begin
    Single := sStr[i];
    if  Ord(Single) > 128 then
    begin
      Single := sStr[i + 1];
      Result := Result + Chr(Ord(single) - 128);
      Inc(I, 2);
    end
    else begin
      Result:= Result + Copy(ADoubleStr, i, 1);
      Inc(i, 1);
    end;
  end;
end;

//删除一个文件夹
function TCommon.DelFolder(const AsFolder: string): Boolean;
var
  fsIni: TSHFILEOPSTRUCT;
begin
  FillChar(fsIni, SizeOf(fsIni), 0);
  with fsIni do
  begin
   Wnd := 0;
   wFunc := FO_DELETE;
   pFrom := PChar(AsFolder + #0);
   pTo := #0#0;
   fFlags := FOF_NOCONFIRMATION + FOF_SILENT;
  end;
  Result := (SHFileOperation(fsIni) = 0);
end;

//判断一个字符串是否为全英文字符
function TCommon.JudgeAnsiChar(AStr: string): Boolean;
var
  i: integer;
begin
  Result := True;
  for i := 1 to Length(AStr) do
  begin
    if (Ord(AStr[i]) > 128) then
    begin
      Result := False;
      Break;
    end;
  end;
end;

function TCommon.FillDigit(AText: string; ADigitCount: Integer): string;
var
  i, iCount: Integer;
begin
  Result := AText;
  iCount := ADigitCount - Length(Result);
  if iCount = 0 then Exit;

  for i := 1 to iCount do
    Result := '0' + Result;
end;

function TCommon.IfListExist(AString: TStrings;
  AFindString: string): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to AString.Count - 1 do
  begin
    if AString.Strings[I] = AFindString then
    begin
      Result := True;
      Break;
    end;
  end;
end;

function TCommon.DecodeStr(AStr: string): string;
var
  i, iTemp: Integer;
  arrResult, arrTemp: array of char;
begin
  iTemp := Length(AStr);
  SetLength(arrTemp, iTemp);
  SetLength(arrResult, iTemp);
  for i := 1 to Length(AStr) do
  begin
    arrTemp[i - 1] := AStr[i];
    arrTemp[i - 1] := Chr(Ord(arrTemp[i - 1]) + 2);
  end;
  for i := 0 to High(arrTemp) do
  begin
    arrResult[i] := arrTemp[High(arrTemp) - i];
  end;
  SetLength(arrResult, Length(arrResult) + 1);
  arrResult[Length(arrResult) - 1] := #0;
  Result := string(Pchar(arrResult));
end;

function TCommon.EncryptStr(AStr: string): string;
var
  i, iTemp: Integer;
  arrResult, arrTemp: array of char;
begin
  iTemp := Length(AStr);
  SetLength(arrTemp, iTemp);
  SetLength(arrResult, iTemp);
  for i := 1 to Length(AStr) do
  begin
    arrTemp[i - 1] := AStr[i];
    arrTemp[i - 1] := Chr((Ord(arrTemp[i - 1]) - 2));
  end;
  for i := 0 to High(arrTemp) do
  begin
    arrResult[i] := arrTemp[High(arrTemp) - i];
  end;
  SetLength(arrResult, Length(arrResult) + 1);
  arrResult[Length(arrResult) - 1] := #0;
  Result := string(Pchar(arrResult));
end;

procedure TCommon.PressNumber(Sender: TObject; var Key: Char);
begin
  if (Key in ['0'..'9']) or (Key = #8) or (Key = #13) or (Key = #10) then
  else
    Key := #0;
end;

procedure TCommon.PressFloat(Sender: TObject; var Key: Char);
begin
  if (Key in ['0'..'9']) or (Key = #8) or (Key = #13) or (Key = #10) or (Key = '.') then
  else
    Key := #0;
end;

procedure TCommon.QueryPress(Sender: TObject; var Key: Char);
begin
  if (Key = #34) or (Key = #39) then
    Key := #0;
end;

function TCommon.ExistName(AName: string; AStringList: TStrings): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to AStringList.Count - 1 do
    if AName = AStringList.Strings[I] then
    begin
      Result := True;
      Exit;
    end;
end;

procedure TCommon.ComboBoxLength(AComboBox: TComboBox);
var
  I, iMaxLength: Integer;
begin
  //首先取出ComboBox中长度最大值
  iMaxLength := 0;
  for I := 0 to AComboBox.Items.Count - 1 do
    if Length(Trim(AComboBox.Items[I])) > iMaxLength then
      iMaxLength := Length(AComboBox.Items[I]);
  iMaxLength := iMaxLength * 6 + 30;
  //查找 ComboBox 中最长的字符串
  SendMessage(TComboBox(AComboBox).Handle, CB_SETDROPPEDWIDTH, iMaxLength, 0);
end;

procedure TCommon.DoTip(AifShow: Boolean; AStr: string);
begin
  if frmTip = nil then
    frmTip := TfrmTip.Create(Application);
  frmTip.pnlTip.Caption := '请稍候，正在访问数据库...';
  if trim(AStr) <> '' then
    frmTip.pnlTip.Caption := AStr;
  if AifShow then
    frmTip.Show
  else
    frmTip.Close;
  Application.ProcessMessages;
end;

function TCommon.GetTimeString(AiTime: Integer): string;
var
  iHour, iMineat, iSencond, iTmp: Integer;
  sMineat, sSencond: string;
begin
  iHour := AiTime div 3600;
  iTmp := AiTime mod 3600;
  if iTmp > 60 then
  begin
    iMineat := iTmp div 60;
    iTmp := iTmp mod 60;
  end
  else
    iMineat := 0;
  iSencond := iTmp mod 60;
  if Length(IntToStr(iMineat)) = 1 then
    sMineat := '0' + IntToStr(iMineat)
  else
    sMineat := IntToStr(iMineat);
  if Length(IntToStr(iSencond)) = 1 then
    sSencond := '0' + IntToStr(iSencond)
  else
    sSencond := IntToStr(iSencond);
  Result := IntToStr(iHour) + ':' + sMineat + ':' + sSencond;
end;

procedure TCommon.ShowSql(ASqlText: string);
var
  iStart: Integer;
  iLength: Integer; // 整个字符串的长度
  sTmp, sPos: string;
  iDistance: Integer; // 间隔
begin
  iDistance := 60;
  iLength := Length(ASqlText);
  iStart := 1;
  sTmp := '';
  while iStart < iLength do
  begin
    sTmp := sTmp + Copy(ASqlText, iStart, iDistance);
    iStart := iStart + iDistance;
    sPos := Trim(Copy(ASqlText, iStart, 1));
    while sPos <> '' do
    begin
      sTmp := sTmp + sPos;
      iStart := iStart + 1;
      sPos := Trim(Copy(ASqlText, iStart, 1))
    end;
    sTmp := sTmp + #13#10;
  end;

  try
    frmSqlMemo := TfrmSqlMemo.Create(Application);
    frmSqlMemo.mmSql.Clear;
    frmSqlMemo.mmSql.Lines.Add(sTmp);
    frmSqlMemo.ShowModal;
  finally
    frmSqlMemo.Free;
    frmSqlMemo := nil;
  end;
end;

end.