skypublic.pas

delphi常使用函数,你了解她的常识用函数吗? 请在这里查看你需要的函数类,提供的比较全面

unit SkyPublic;

interface

uses
  Windows,SysUtils,Classes,Controls,Dialogs,ShellApi,Menus,StdCtrls,
  registry,Forms,Graphics,Math,DateUtils;

type
  TQuarter = 1..4;

  TChinaNumFormat = (cnfBig,cnfSmall,cnfArab);

  TChinaBigFormat = (cbfFull,cbfBlank);

  TNumChar='0'..'9';

  TStringArray = array of string;

  TCharSet = set of Char;

  TFontRecord = record
    CharSet:Byte;
    Color:Integer;
    Name:string;
    Size:Integer;
    Style:Byte;
    PixelsPerInch:Integer;
    Pitch:0..2;
    Height:Integer;
  end;

const
  CR = #13;
  LF = #10;
  NumCharSet=['0'..'9'];
  NameCharSet = ['A'..'Z','a'..'z','0'..'9','_'];

var
  MimaFileName:string;
  PositionMima:array [0..2] of Integer = (91,92,93);

{*****************************类操作******************************}
{显示类及其继承信息函数}
function ShowClassName(Obj:TObject):string;
procedure GetClassInfos(Obj:TComponent;StrList:TStringList);
procedure SaveClassInfos(Obj:TComponent;FileName:string);

{*****************************文件操作******************************}
{建文件夹}
function CreateDirs(APath:string):Boolean;
{拷贝}
function FileCopy(From, Dest: string;S:Integer=0;Dialog:Boolean=True):Boolean;
{移动}
procedure FileMove(From, Dest: string);
{删除}
procedure FileDelete(ADirName: string);
{更名}
function FileRename(From, Dest: string):Boolean;

{***************************控件操作********************************}
{TStrings，在Combobox中添加或者删除一个字符串}
procedure StringsOperation(ComboBox:TComboBox;IsAdd:Boolean;No:string='');

{***************************日期操作********************************}
{返回头尾日期}
procedure GetHeadTailDate(const SelfDate:TDate;var HeadDate,TailDate:TDate);overload;
procedure GetHeadTailDate(const Year,Month:Integer;var HeadDate,TailDate:TDate);overload;
{返回一月有多少天}
function ReturnHowDay(const AYear,AMonth:word):Word;
{返回季度头尾日期}
procedure GetQuarter(AYear:Word;AQuarter:TQuarter;var HeadDate,TailDate:TDate);overload;
procedure GetQuarter(SelfDate:TDate;var HeadDate,TailDate:TDate);overload;
procedure GetAccYearMonth(ADate:TDateTime;var Y,M:Word);

{**************************字符串操作*******************************}
{**************************string Function*******************************}
{得到1个字符在字符串中的个数}
function GetCharNum(const Ch:Char; const Str: string):Integer;
{Ini字符串和String字符串互相转换}
function IniStrToStr(const Str: string): string;
function StrToIniStr(const Str: string): string;
{给字符串加一个'\'}
function AddBackSlash(const S: string): string;
{减少字符串的长度}
procedure DecStrLen(var S: string; DecBy: Integer);
{返回有回车换行的字符串Position位置所在的字符串}
function GetCurLine(const S: string; Position: Integer): string;
{返回给定字符串的内存分配大小}
function GetStrAllocSize(const S: string): Longint;
{ 得到字符串的基准数 }
function GetStrRefCount(const S: string): Longint;
{清除A中指定的字符}
function KillChars(const S: string; A: array of Char; CaseSensitive: Boolean):string;
{ 返回子字符串在字符串中最后一个位置 }
function LastPos(const SubStr, S: string): Integer;
{ 设置字符串的实际长度 }
procedure RealizeLength(var S: string);
{ 移去字符串末尾的'\'}
function RemoveBackSlash(const S: string): string;
{移去字符串空格}
function RemoveSpaces(const S: string): string;
{字符串取反}
function ReverseStr(const S: string): string;
{除去前后回车}
function TrimEnterLeft(S:string):string;
function TrimEnterRight(S:string):string;
function TrimEnter(S:string):string;
{******************************PChar Function***************************}
procedure StrGetCurLine(StartPos, CurPos: PChar; TotalLen: integer;
  var LineStart: PChar; var LineLen: integer);
{ 返回最后一个指定字符串及其以后的字符 }
function StrLastPos(Str1, Str2: PChar): PChar;
{截取第一个指定字符串及其以后的字符,大小写不敏感}
function StrIPos(Str1, Str2: PChar): PChar;
{截取第一个指定字符及其以后的字符,大小写不敏感}
function StrIScan(Str: PChar; Chr: Char): PChar;
{ 字符串取反 }
procedure StrReverse(P: PChar);

{返回中文大写数字}
function GetChinaNum(Num:TNumChar;ChinaNumFormat:TChinaNumFormat=cnfBig):string;
{将数字变成中文大写}
function FloatToChinaBig(Num:Double;ChinaBigFormat:TChinaBigFormat=cbfFull;Blanks:Byte=0):string;
function FloatToChnStr(Value: Real; ClearZero: Boolean; full:Boolean=False): String;
{将数字变成英文}
function FloatToEnglish(Num:Double):string;
{日期用英文}
function DateToEng(ADate:TDate;th:Boolean=False):string;
{取得SQL日期字符串等}
function DateToSQLDateStr(ADate:TDateTime):string;
function StrToSQLDateStr(Str:string):string;
function TimeToSQLTimeStr(ATime:TDateTime):string;
function StrToSQLTimeStr(Str:string):string;
function DateTimeToSQLDateTimeStr(ADateTime:TDateTime):string;
function StrToSQLDateTimeStr(Str:string):string;
{返回有逗号的金额字符串}
function FloatToMoneyStr(Num:Double;const HasSymbol:Boolean=False):string;
{Bool与字符串的转换}
function StrToBool(const Str:string):Boolean;
function BoolToStr(const Bool:Boolean):string;
{判断是否日期等}
function IsDate(const CheckString:string):Boolean;
function IsDateTime(const CheckString:string):Boolean;
function IsTime(const CheckString:string):Boolean;
function IsInteger(const CheckString:string):Boolean;
function IsFloat(const CheckString:string):Boolean;
{多字符串ShowMessage}
procedure ShowMessages(const Strings:array of string);
{新名称}
function NameToNewName(const Str:string):string;
{FloatTo%百分比}
function FloatToRate(Num:Double;Pos:Word):string;
{字体存贮}
procedure FontRecordToFont(FontRecord:TFontRecord;Font:TFont);
function FontToFontRecord(Font:TFont):TFontRecord;
function FontStylesToInt(FontStyles:TFontStyles):Byte;
function IntToFontStyles(FontInteger:Byte):TFontStyles;

{****************************数学*********************************}
{n次方}
function Power(X,Y:Extended):Extended;
{N的阶层}
function Order(N: Word): Extended;//（用Pascal写的N的阶层）
{得到小数点位数}
function GetFloatPointNum(Fl:Double):Integer;
{小数点位数，四舍五入法}
function FloatToNewFloat(AValue:Double):Double;
function FloatToNewFloatN(AValue:Double;N:Word=4):Double;

{******************************系统操作*******************************}
{关闭计算机}
function WinExit (iFlags: integer) : Boolean;
{防止开启多个应用程序}
procedure PreventMany(Name:string);
{得到应用程序的路径}
function GetApplicationDir(AppName:string):string;
{加到启动}
function RegAddToRun(Name,Value:string):Boolean;
procedure DeleteOneItem(Name:string);
{得到Delphi路径}
function GetDelphiDir:string;
{得到系统路径}
function GetSystemDir:string;
{得到windows路径}
function GetWindowsDir:string;
{得到计算机名}
function GetComputerNameD:string;
{设置计算机名}
function SetComputerNameD(Name:string):Boolean;
{执行一个文件}
function ExecuteFile(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer): THandle;

implementation

{显示类及其继承信息函数}
function ShowClassName(Obj:TObject):string;
var
  Str:string;
  K:TClass;
begin
  K:=Obj.ClassType;
  while not K.ClassNameIs('TObject') do
  begin
    Str:=K.ClassParent.ClassName+'——>'+Str;
    K:=K.ClassParent;
  end;
  Result:=Str+Obj.ClassName;
end;

procedure GetClassInfos(Obj:TComponent;StrList:TStringList);
var
  i:Integer;
  S:string;
begin
  StrList.Clear;
  for I:=0 to Obj.ComponentCount-1 do
  begin
    S:='类名：'+Obj.Components[I].ClassName+' '+'名称：'+Obj.Components[I].Name;
    StrList.Add(S);
  end;
end;

procedure SaveClassInfos(Obj:TComponent;FileName:string);
var
  i:Integer;
  S:string;
  StrList:TStringList;
begin
  StrList:=TStringList.Create;
  try
    for I:=0 to Obj.ComponentCount-1 do
    begin
      S:='类名：'+Obj.Components[I].ClassName+' '+'名称：'+Obj.Components[I].Name;
      StrList.Add(S);
    end;
    StrList.SaveToFile(FileName);
  finally
    StrList.Free;
  end;
end;

{建文件夹}
function  CreateDirs(APath:string):Boolean;
var
  CurrentPath:string;
  UsePath:string;
begin
  CurrentPath:=GetCurrentDir;
  UsePath:=Trim(APath);
  if Pos('\',UsePath)=1 then
  begin
    UsePath:=Copy(CurrentPath,1,2)+UsePath;
  end
  else if Pos(':',UsePath)<>2 then UsePath:=CurrentPath+'\'+UsePath;
  Result:=ForceDirectories(UsePath);
end;

{拷贝}{0:如果有同文件名则改名。1：如果同文件名则覆盖。}
function FileCopy(From, Dest: string;S:Integer=0;Dialog:Boolean=True):Boolean;
var
  T: TSHFileOpStruct;
  FromDir:PChar;
  ToDir:PChar;
begin
  GetMem(FromDir,Length(From)+2);
  try
    GetMem(ToDir,Length(Dest)+2);
    try
      FillChar(FromDir^,Length(From)+2,0);
      FillChar(ToDir^,Length(Dest)+2,0);

      StrCopy(FromDir,PChar(From));
      StrCopy(ToDir,PChar(Dest));

      with T do
      begin
        Wnd    :=0;
        wFunc  :=FO_COPY;
        pFrom  :=FromDir;
        pTo    :=ToDir;
        if S=0 then
          fFlags :=FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION
        else fFlags :=FOF_NOCONFIRMATION;
        if not Dialog then
          fFlags:=fFlags or FOF_SILENT;
        fAnyOperationsAborted:=False;
        hNameMappings:=nil;
        lpszProgressTitle:=nil;
        if SHFileOperation(T)=0 then
          Result:=True
        else Result:=False;
      end;
    finally
      FreeMem(ToDir,Length(Dest)+2);
    end;
  finally
    FreeMem(FromDir,Length(From)+2);
  end;
end;

{移动}
procedure FileMove(From, Dest: string);
var
  T: TSHFileOpStruct;
  FromDir:PChar;
  ToDir:PChar;
begin
  GetMem(FromDir,Length(From)+2);
  try
    GetMem(ToDir,Length(Dest)+2);
    try
      FillChar(FromDir^,Length(From)+2,0);
      FillChar(ToDir^,Length(Dest)+2,0);

      StrCopy(FromDir,PChar(From));
      StrCopy(ToDir,PChar(Dest));

      with T do
      begin
        Wnd    :=0;
        wFunc  :=FO_MOVE;
        pFrom  :=FromDir;
        pTo    :=ToDir;
        fFlags :=FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
        fAnyOperationsAborted:=False;
        hNameMappings:=nil;
        lpszProgressTitle:=nil;
        if SHFileOperation(T)<>0 then
          raise Exception.Create('移动文件操作不成功！');
      end;
    finally
      FreeMem(ToDir,Length(Dest)+2);
    end;
  finally
    FreeMem(FromDir,Length(From)+2);
  end;
end;

{删除}
procedure FileDelete(ADirName: string);
var
  SHFileOpStruct:TSHFileOpStruct;
  DirName:PChar;
begin
  Getmem(DirName,Length(ADirName)+2);
  try
    FillChar(Dirname^,Length(ADirName)+2,0);
    StrCopy(DirName,PChar(ADirName));

    with SHFileOpStruct do
    begin
      Wnd:=0;
      wFunc:=FO_DELETE;
      pFrom:=DirName;
      pTo:=nil;
      fFlags :=FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;

      fAnyOperationsAborted:=False;
      hNameMappings:=nil;
      lpszProgressTitle:=nil;
    end;

    if SHfileOperation(SHFileOpStruct)<>0 then
      raise Exception.Create('删除文件操作不成功！');
  finally
    FreeMem(DirName,Length(ADirName)+2);
  end;
end;

{更名}
function FileRename(From, Dest: string):Boolean;
//var
//  T: TSHFileOpStruct;
//  FromDir:PChar;
//  ToDir:PChar;
//  FromDirectory,DestDirectory:string;
begin
  Dest:=ExtractFileName(Dest);
  Result:=RenameFile(From,Dest);
end;

{得到应用程序的路径}
function GetApplicationDir(AppName:string):string;
var
  AppPath:string;
  reg:TRegistry;
  Name:string;
  ExtName:string;
begin
  ExtName:=Copy(AppName,Length(AppName)-3,4);
  if ExtName[1]<>'.' then AppName:=AppName+'.exe';
  Name:='Software\Microsoft\Windows\CurrentVersion\App Paths\'+AppName;
  reg:=TRegistry.Create;
  try
    reg.RootKey:=HKEY_LOCAL_MACHINE;
    reg.OpenKey(Name,False);
    AppPath:=reg.ReadString('path');
    AppPath:=AddBackSlash(AppPath);
    reg.CloseKey;
  finally
    reg.Free;
  end;
  Result:=AppPath;
end;

{加到启动}
function RegAddToRun(Name,Value:string):Boolean;
var
  Reg:TRegistry;
  Values:string;
begin
  Result:=False;
  Reg:=TRegistry.Create;
  try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    Reg.OpenKey('software\microsoft\windows\currentversion\run\',False);
    Values:=Reg.ReadString(Name);
    if Values<>Value then
    begin
      Reg.WriteString(Name,Value);
      Result:=True;
    end;
  finally
    Reg.Free;
  end;
end;
procedure DeleteOneItem(Name:string);
var
  Reg:TRegistry;
begin
  Reg:=TRegistry.Create;
  try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    Reg.OpenKey('software\microsoft\windows\currentversion\run\',False);
    if Reg.ValueExists(Name) then
      Reg.DeleteValue(Name)
  finally
    Reg.Free;
  end;
end;

{得到delphi路径}
function GetDelphiDir:string;
begin
  Result:=GetApplicationDir('Delphi32.exe');
end;

{得到系统路径}
function GetSystemDir:string;
var
  Buffer: array[0..MAX_PATH - 1] of Char;
begin
  SetString(Result, Buffer, GetSystemDirectory(Buffer,SizeOf(Buffer)));
end;

{得到windows路径}
function GetWindowsDir:string;
var
  Buffer: array[0..MAX_PATH - 1] of Char;
begin
  SetString(Result, Buffer, GetWindowsDirectory(Buffer,SizeOf(Buffer)));
end;

{得到计算机名}
function GetComputerNameD:string;
var
  Buffer: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  BSize:Cardinal;
begin
  BSize:=SizeOf(Buffer);
  if  GetComputerName(Buffer,BSize) then
  begin
    Result:=Buffer;
  end
  else Result:='';
end;

{设置计算机名}
function SetComputerNameD(Name:string):Boolean;
begin
  if Length(Name)>MAX_COMPUTERNAME_LENGTH then
  Name:=Copy(Name,1,MAX_COMPUTERNAME_LENGTH);
  Result:=False;
  if SetComputerName(PChar(Name)) then
    Result:=True;
end;

function ExecuteFile(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer): THandle;
var
  zFileName, zParams, zDir: array[0..120] of Char;
begin
  Result := ShellExecute(Application.MainForm.Handle, nil,
    StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
    StrPCopy(zDir, DefaultDir), ShowCmd);
end;

{返回头尾日期}
procedure GetHeadTailDate(const SelfDate:TDate;var HeadDate,TailDate:TDate);overload;
const
  AHeadDay=1;
var
  AYear,AMonth,ATailDay,ASelfDay:Word;
begin
  DecodeDate(SelfDate,AYear,AMonth,ASelfDay);
  ATailDay:=ReturnHowDay(AYear,AMonth);
  HeadDate:=EncodeDate(AYear,AMonth,AHeadDay);
  TailDate:=EncodeDate(AYear,AMonth,ATailDay);
end;