个人收集及编写的一个通用函数集.pas

个人收集及编写的一个通用函数集

(*//
标题:UC函数单元
说明:通用函数
日期:2002-10-25
设计:Zswang
扩展：HongzhiK
扩展目期：2003-4-18
版权:Longmaster
//*)

//*******Begin 修改日志*******//
(*
扩展：HongzhiK
扩展目期：2003-6-28
内容:
    增加了快速字符串处理单元。大量的字符串处理函数。
*)
//*******End 修改日志*******//

unit FuncUnit;

interface
{$I Head.inc}
uses Windows, SysUtils, Graphics, Classes, registry, Forms, StdCtrls, Consts,
Dialogs, Controls, ShlObj;

type
  TFileVersionInfomation = record
    rCommpanyName: string;
    rFileDescription: string;
    rFileVersion: string;
    rInternalName: string;
    rLegalCopyright: string;
    rLegalTrademarks: string;
    rOriginalFileName: string;
    rProductName: string;
    rProductVersion: string;
    rComments: string;
    rVsFixedFileInfo: VS_FIXEDFILEINFO;
    rDefineValue: string;
  end;
  
const
  cBoolChar: array[Boolean] of Char = ('F', 'T');
  cFrame = 1;
function HexToStr(mHex: string): string;
function StrToHex(mStr: string): string;

function StrLeft(const mStr: string; mDelimiter: string): string;
function StrRight(const mStr: string; mDelimiter: string): string;
function ListCount(mList: string; mDelimiter: string = ','): Integer;
function ListValue(mList: string; mIndex: Integer; mDelimiter: string = ','): string;

function SubStrConut(mStr: string; mSub: string): Integer;

function WideStringToLines(mStr: WideString): string;

function StringToDisplay(mString: string): string;
function DisplayToString(mDisplay: string): string;

function GetFileVersionInfomation(mFileName: TFileName;
  var nFileVersionInfomation: TFileVersionInfomation;
  mDefineName: string = ''): Boolean;


function IsFocusd(mHandle: THandle): Boolean; { 返回窗体是否具有焦点 }

function StrToSet(mStr: string): TSysCharSet;

type
  TOnOff     = (TofOff,TofOn);
  TCharSegmentSet = set of 0{1}..7;
  TCharSegment = TCharSegmentSet;


//////////////自定义新涵数hongzhiK-start////////////////////////////////////////////////////
//显示数字在一个框里,类似于显示出电子表效果，超酷
//强列推建
procedure ShowDigiInRect(Canvas: TCanvas; mRect: TRect; str : string);
//////////////快速位图翻转函数////////////////////////////////////////////////////
function Turnbmp1(mSource: TBitmap; Rotate: integer): Boolean;
function BitmapRotate90(mSource: TBitmap): Boolean;
function BitmapRotate180(mSource: TBitmap): Boolean;
function BitmapRotate270(mSource: TBitmap): Boolean;
//////////////快速位图翻转函数////////////////////////////////////////////////////
//*************************四国军棋内部用的*******************************************//
  function Turnbmp(mSource: TBitmap; Rotate: integer): Boolean;
{$IFNDEF K_CB5}
  procedure DrawBlockFrameSiGuo(vleft,vtop,vright,vbuttom : integer; Canvas:TCanvas);overload;//画小块的边框
  procedure DrawBlockFrameSiGuo(mRect : TRect; Canvas:TCanvas); overload;//画小块的边框
//*************************四国军棋内部用的*******************************************//
  ///////////////////////////////////////几个画块函数公用//////////////
  procedure DrawBlockFrameSmall(vleft,vtop,vright,vbuttom : integer; DrawColor : TColor;Canvas:TCanvas);overload;//画小块的边框
  procedure DrawBlockFrameSmall(mRect : TRect; DrawColor : TColor;Canvas:TCanvas); overload;//画小块的边框

  procedure DrawBlockFrameOnner(vleft,vtop,vright,vbuttom : integer; DrawColor : TColor;Canvas:TCanvas);overload;//画小块的边框
  procedure DrawBlockFrameOnner(mRect : TRect; DrawColor : TColor;Canvas:TCanvas); overload;//画小块的边框
  procedure DrawBlockFrameInner(vleft,vtop,vright,vbuttom : integer; DrawColor : TColor;Canvas:TCanvas);overload;//画小块的边框
  procedure DrawBlockFrameInner(mRect : TRect; DrawColor : TColor;Canvas:TCanvas); overload;//画小块的边框
  ///////////////////////////////////////几个画块函数//////////////
{$ENDIF}
  function GetColorA(chint : boolean; vcolor : TColor) : TColor;  //改变阴影的函数
  function GetColor(chint : boolean; vcolor : TColor) : TColor;  //改变阴影的函数主要用于方块中
//////////////////几个字串转换函数///////////////////////////////////

  function GetSubStr(Str : string; index : integer):string;
//  procedure StrToUser(str : string; var FUser : TVCLUser);
//  function UserToStr(FUser : TVCLUser): string;
  function StrBinToStr(strbin: string): string; //二进制转为字串
  function StrToStrBin(str: string): string; //字串转为二进制
//////////////////几个字串转换函数///////////////////////////////////
/////////////////////////新定义////////////////////////////
    //写入
  function mMove(i : integer):string;overload;
  function mMove(i : int64):string;overload;
  function mMove(i : boolean):string;Overload;
  function mMove(i : Word):string;Overload;
  function mMove(i : Byte):string;Overload;
  function mMove(p : Pchar; Size: integer): string;Overload;
  //读出
  procedure mMove(var i : integer; var Source: string);overload;
  procedure mMove(var i : int64; var Source: string);overload;
  procedure mMove(var i : boolean; var Source: string);overload;
  procedure mMove(var i : Word; var Source: string);overload;
  procedure mMove(var i : Byte; var Source: string);overload;
  function InputBoxEx(const ACaption, APrompt, ADefault: string): string;
  function MaskForm(const imask : Byte): Byte;

//////////////自定义新涵数hongzhiK-end;////////////////////////////////////////////////////
(*****************************又是几个新收集函数****************************************)


(*****************************又是几个新收集函数****************************************)
////////////////////快速字符串////////////////////////////////////
const
  cHexChars = '0123456789ABCDEF';

Type
  TFastPosProc = function (const aSource, aFind; const aSourceLen, aFindLen : integer) : Pointer;
  TFastPosIndexProc = function (const aSourceString, aFindString : String; const aSourceLen, aFindLen, StartPos : Integer) : Integer;

procedure FastCharMove(const Source; var Dest; Count : Integer);
function FastCharPos(const aSource : String; const C: Char; StartPos : Integer) : Integer;
function FastCharPosNoCase(const aSource : String; C: Char; StartPos : Integer) : Integer;
function FastPos(const aSourceString, aFindString : String; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
function FastPosNoCase(const aSourceString, aFindString : String; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
function FastPosBack(const aSourceString, aFindString : String; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
function FastPosBackNoCase(const aSourceString, aFindString : String; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
function FastReplace(const aSourceString : String; const aFindString, aReplaceString : String;
  CaseSensitive : Boolean = False) : String;
function SmartPos(const SearchStr,SourceStr : String;
                  const CaseSensitive : Boolean = TRUE;
                  const StartPos : Integer = 1;
                  const ForwardSearch : Boolean = TRUE) : Integer;

//pointer routines, which are faster
function FastmemPos(const aSource, aFind; const aSourceLen, aFindLen : integer) : Pointer;
function FastmemPosNC(const aSource, aFind; const aSourceLen, aFindLen : integer) : Pointer;

function Decrypt(const S: String; Key: Word): String;
function Encrypt(const S: String; Key: Word): String;
function ExtractHTML(S : String) : String;
function ExtractNonHTML(S : String) : String;
function CopyStr(const aSourceString : String; aStart, aLength : Integer) : String;
function GetValue(ValueName, Text : String) : String;
function HexToInt(aHex : String) : int64;
function LeftStr(const aSourceString : String; Size : Integer) : String;
function StringMatches(Value, Pattern : String) : Boolean;
function MissingText(Pattern, Source : String; SearchText : String = '?') : String;
function RandomFileName(aFilename : String) : String;
function RandomStr(aLength : Longint) : String;
function ReverseStr(const aSourceString : String) : String;
function RightStr(const aSourceString : String; Size : Integer) : String;
function RGBToColor(aRGB : String) : TColor;
function StringCount(const aSourceString, aFindString : String; Const CaseSensitive : Boolean = TRUE) : Integer;
function UniqueFilename(aFilename : String) : String;
function URLToText(aValue : String) : String;
function WordAt(Text : String; Position : Integer) : String;

procedure Split(aValue : String; aDelimiter : Char; Result : TStrings);

////////////////////快速字符串////////////////////////////////////
////////////////////新的字符串涵 数收集////////////////////////////////////
{================= String Utils =================}

function slash(value:string):string;
{ensures that value has '\' as last character (for directory strings)}

function capfirst(value:string):string;
{Capitalise first character of each word, lowercase remaining chars}
{example: capfirst('bOrLANd delPHi FOR windOWs') = 'Borland Delphi For Windows'}

function striptags(value:string):string;
{strip HTML tags from value}
{example: striptags('<TR><TD Align="center">Hello World</TD>') = 'Hello World'}

function replace(str,s1,s2:string;casesensitive:boolean):string;
{replace all incidences of s1 in str with s2}
{example: replace('We know what we want','we','I',false) = 'I Know what I want'}

function CopyFromChar(s:string;c:char;l:integer):string;
{copy l characters from string s starting at first incidence of c}
{example: Copyfromchar('Borland Delphi','a',3) = 'and'}


{================= System Utils =================}
function getwinsysdir:string;
{returns Windows System Path (inc drive)}
{example: getwinsysdir = 'C:\WINDOWS\SYSTEM\'}

function getwindir:string;
{returns windows directory path (inc Drive)}
{example: getwindir = 'C:\WINDOWS\'}

function getinstalldir:string;
{returns install directory of EXE using this library}
{example: getinstalldir = 'C:\PROGRAM FILES\BORLAND\DELPHI\DEMOS\'}

function getregvalue(root:integer;key,value:string):string;
{reads a registry value}
{example: getregvalue(HKEY_LOCAL_MACHINE,'network\logon\','username') = 'Eddie Bond'}

function getfiledate(filename:string):Tdatetime;
{returns a file's date in TDateTime format}


{================= Arithmetic Utils =================}

function StrToFloatDef(const s:string;def:Extended):Extended;
{converts S into a number. If S is invalid, returns the number passed in Def.}
{example: strtofloatdef('$10.25',0) = 0}

function VolSphere(radius:single):extended;
{volume of sphere of given radius}

function AreaSphere(radius:single):extended;
{surface area of sphere of given radius}

function VolCylinder(radius,height:single):extended;
{volume of cylinder of given radius and height}

function AreaCylinder(radius,height:single):extended;
{surface area of cylinder of given radius and height}

function MinExt(const A:array of Extended):Extended;
{returns minimum value of an array of extended}

function MaxExt(const A:array of Extended):Extended;
{returns maximum value of an array of extended}

function MinInteger(const A:array of Integer):Integer;
{returns minimum value of an array of integers}

function MaxInteger(const A:array of integer):Integer;
{returns maximum value of an array of integers}

function InverseSum(const a:array of single):single;
{solves formulae of type 1/r = 1/a + 1/b +...1/n (eg electrical resistance in parallel)}

{================= Financial Utils =================}

function MarkUp(profit:single):single;
{returns markup percentage required to return a profit of profit percent}
{example: MarkUp(25) = 20 }

function SellingPrice(net:double;markup:single):double;
{returns selling price after adding markup percent to net}
{example: SellingPrice(199.50,22.5) = 244.3875}

function NetPrice(gross:double;taxrate:single):double;
{returns the net value of an item of gross value containing tax at taxrate percent}
{example: NetPrice(199.99,17.5) = 170.204255319149}
////////////////////新的字符串涵 数收集////////////////////////////////////
//==============================系统路径======================================//
Function GetApplicationExeName: string;
Function GetApplicationShortExeName: string;
Function GetWindowsDir: string;  //c:\winnt
Function GetSystemDir: string;  //c:\winnt\system32
Function GetTempDir: string;  //应用程序的路径 如D:/winnt/temp
Function GetApplicationPath:String; //应用程序的路径 如D:/feng/
Function GetApplicationDir:String; //应用程序的路径 如D:/feng
Function GetCurrentDir: string;  //应用程序的路径 如D:/feng
function GetProgramsDir: string;//程序组目录
function GetMy_DocumentsDir: string;//我的文档       //如C:\My Documents
function GetFavoritesDir: string;
function GetSystemFolderDir(mFolder: Integer): string;
//==============================系统路径======================================//
var
  vModuleVersionInfomation: TFileVersionInfomation;

implementation

uses Math;

function IsFocusd(mHandle: THandle): Boolean;
var
  vHandle: THandle;
begin
  vHandle := GetFocus;
  while (mHandle <> vHandle) and (vHandle <> 0) do
    vHandle := GetParent(vHandle);
  Result := mHandle = vHandle;
end;

function StrToSet(mStr: string): TSysCharSet;
var
  I: Integer;
begin
  Result := [];
  for I := 1 to Length(mStr) do
    Include(Result, mStr[I]);
end; { StrToSet }

function HexToStr(mHex: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(mHex) div 2 do
    Result := Result + Chr(StrToIntDef('$' + Copy(mHex, I * 2 - 1, 2), 0));
end; { HexToStr }

function StrToHex(mStr: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(mStr) do
    Result := Format('%s%.2x', [Result, Ord(mStr[I])]);
end; { StrToHex }

function StrLeft(const mStr: string; mDelimiter: string): string;
{ 返回左分隔字符串 }
begin
  Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);
end; { StrLeft }

function StrRight(const mStr: string; mDelimiter: string): string;
begin
  if Pos(mDelimiter, mStr) > 0 then
    Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt)
  else Result := '';
end; { StrRight }

function ListCount(mList: string; mDelimiter: string = ','): Integer;
{ 返回列表数 }
var
  I, L: Integer;
begin
  Result := 0;
  if mList = '' then Exit;
  L := Length(mList);
  I := Pos(mDelimiter, mList);
  while I > 0 do begin
    mList := Copy(mList, I + Length(mDelimiter), L);
    I := Pos(mDelimiter, mList);
    Inc(Result);
  end;
  Inc(Result);
end; { ListCount }

function ListValue(mList: string; mIndex: Integer; mDelimiter: string = ','): string;
{ 返回列表指定位置的元素 }
var
  I, L, K: Integer;
begin
  L := Length(mList);
  I := Pos(mDelimiter, mList);
  K := 0;
  Result := '';
  while (I > 0) and (K <> mIndex) do begin
    mList := Copy(mList, I + Length(mDelimiter), L);
    I := Pos(mDelimiter, mList);
    Inc(K);
  end;
  if K = mIndex then Result := StrLeft(mList + mDelimiter, mDelimiter);
end; { ListValue }

function SubStrConut(mStr: string; mSub: string): Integer;
{ 返回子字符串出现的次数 }
begin
  Result := Length(mStr) - Length(StringReplace(mStr, mSub, '', [rfReplaceAll]));
end; { SubStrConut }

function WideStringToLines(mStr: WideString): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(mStr) do
    Result := Result + #13#10 + mStr[I];
  Delete(Result, 1, 2);
end; { WideStringToLines }

function StringToDisplay(mString: string): string;
var
  I: Integer;
  S: string;
begin
  Result := '';
  S := '';
  for I := 1 to Length(mString) do
    if mString[I] in [#32..#127] then
      S := S + mString[I]
    else begin
      if S <> '' then begin
        Result := Result + QuotedStr(S);
        S := '';
      end;
      Result := Result + Format('#$%x', [Ord(mString[I])]);
    end;
  if S <> '' then Result := Result + QuotedStr(S);
end; { StringToDisplay }

function DisplayToString(mDisplay: string): string;
var
  I: Integer;
  S: string;
  B: Boolean;
begin
  Result := '';
  B := False;
  mDisplay := mDisplay;
  for I := 1 to Length(mDisplay) do
    if B then case mDisplay[I] of
      '''': begin
        if S <> '' then Result := Result + StringReplace(S, '''''', '''', [rfReplaceAll]);
          if Copy(mDisplay, I + 1, 1) = '''' then Result := Result + '''';
          S := '';
          B := False;
        end;
      else S := S + mDisplay[I];
      end
    else case mDisplay[I] of
      '#', '''': begin
        if S <> '' then Result := Result + Chr(StrToIntDef(S, 0));