acutils.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit acUtils;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, sConst, IniFiles
  {$IFDEF TNTUNICODE},TntSysUtils, {$IFNDEF D2006}TntWideStrings{$ELSE}WideStrings{$ENDIF}, TntClasses{$ENDIF};

{$IFNDEF NOTFORHELP}
type
{$IFDEF TNTUNICODE}
  TacSearchRec  = TSearchRecW;
  TacStrings    = TWideStrings;
  TacStringList = TTntStringList;
  TacFileStream = TTntFileStream;
{$else}
  TacSearchRec  = TSearchRec;
  TacStrings    = TStrings;
  TacStringList = TStringList;
  TacFileStream = TFileStream;
{$ENDIF}

{$IFNDEF ALITE}
{ Serviced, used for debugging}
procedure Alert; overload;
procedure Alert(const s : string); overload;
procedure Alert(i : integer); overload;
{ Qustom request}
function CustomRequest(const s : string):boolean;
{ Request for item deleting}
function DeleteRequest:boolean;
{ Show message S with icon mtWarning}
procedure ShowWarning(const S:string);
{ Show message S with icon mtError}
procedure ShowError(const s:string);
{$ENDIF}
function IsNTFamily : boolean;
function MakeCacheInfo(Bmp : TBitmap; x : integer = 0; y : integer = 0) : TCacheInfo;
{ Add N chars C to string S}
function AddChar(C: Char; const S: string; N: Integer): string;
function AddCharR(C: Char; const S: string; N: Integer): string;
{ Returns formated string, represented float value}
function FormatFloatStr(const S: string; Thousands: Boolean): string;
function GetCaptionFontSize : integer;
function CheckLimits(Value, MinValue, MaxValue : integer) : integer; //overload;
//function CheckLimits(Value : real; MinValue, MaxValue : integer) : integer; overload;
function IntToByte(Value : integer) : byte;

function HexToInt(HexStr : string) : Int64;

procedure GetIniSections(IniList, SectionsList : TStringList);
procedure GetIniSection(const Section: string; Sections, Strings: TStrings);
function ReadIniString(IniList, SectionsList : TStringList; const Section, Ident, Default: string): string;
function ReadIniInteger(IniList, SectionsList : TStringList; const Section, Ident: string; Default: Longint): Longint;

function StringToFloat(S : String) : Extended;
function MakeMessage(Msg, WParam, LParam, Rsult : longint) : TMessage;
{ Returns percent i2 of i1}
function SumTrans(i1, i2 : integer): integer;
{ Returns max value from i1 and i2}
function Maxi(i1, i2 : integer) : integer;
{ Returns min value from i1 and i2}
function Mini(i1, i2 : integer) : integer;
{ Set value to Minvalue or Maxvalue if it not placed between them}
function LimitIt(Value, MinValue, MaxValue : integer): integer;
{ Returns True if Value is valid float}
function IsValidFloat(const Value: string; var RetValue: Extended): Boolean;

function RectIsVisible(const ParentRect, Rect : TRect) : boolean;
function RectInRect( BigRect, SmallRect : TRect) : boolean;
function RotateRect( R : TRect) : TRect;
{ Offset point}
function OffsetPoint( p: TPoint; x,y : integer): TPoint;
{ Returns width of rectangle}
function WidthOf(const r: TRect): integer;
{ Returns height of rectangle}
function HeightOf(const r: TRect): integer;
{ Returns string s1 if L, else return s2}
function iff(L : boolean; const s1, s2 : string) : string;
{ Returns TObject o1 if L, else return o2}
function iffo(L : boolean; o1, o2 : TObject) : TObject;
{ Returns integer o1 if L, else return o2}
function iffi(L : boolean; i1, i2 : integer) : integer;
{ Returns True if SubString included in s. If CaseInsensitive then function non-Casesensitive}
function SubStrInclude(const SubString, s : string; CaseInsensitive : boolean) : boolean;
{ Returns position of word number N in string S. WordDelims - chars, word delimiters}
function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer;
{ Returns count of words in string S. WordDelims - chars, word delimiters}
function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
{ Returns number of word W in string S. WordDelims - chars, word delimiters}
function GetWordNumber(const W, S: string; const WordDelims: TSysCharSet): integer;
{ Returns string with length N, filled by character C}
function MakeStr(C: Char; N: Integer): string;
{ Replace substring Srch in string S by substring Replace}
function ReplaceStr(const S, Srch, Replace: string): string;
{ Returns False if S include EmptyChars only}
function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
{ Convert OEM string OemStr to Ansi string}
function OemToAnsiStr(const OemStr: string): string;
{ Returns True if word W included in string S. WordDelims - chars, word delimiters}
function IsWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean;
function IsIDERunning: boolean;

{$ENDIF}

{ Returns string with proper cases of first characters in words. WordDelims - chars, word delimiters}
function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
{ Returns True if value placed berween i1 and i2}
function Between(Value, i1, i2 : integer) : boolean;
function BoolToStr(b : boolean) : string;
{ Change values of i1 and i2}
procedure Changei(var i1, i2 : integer);
{ Corrects string for SQL-operations}
function CorrectString(const s : string) : string;
{ Rounds value F up to two chars after a point}
function CurRound(f : real) : real;
{ Delay in milliseconds}
procedure Delay(MSecs: Integer);
{ Returns string with deleted spaces}
function DelRSpace(const S: string): string;
{ Returns string with deleted leading spaces}
function DelBSpace(const S: string): string;
{ Returns string with deleted last spaces}
function DelESpace(const S: string): string;
{ Returns string with deleted chars Chr}
function DelChars(const S: string; Chr: Char): string;
{ Returns substring from position Pos}
function ExtractSubStr(const S: string; var Pos: Integer; const Delims: TSysCharSet): string;
{ Returns word number N from string S. WordDelims - chars, word delimiters}
function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;
function GetCents(Value : Extended) : smallint;
function HasProperty(Component : TObject; PropName: String ): Boolean;
function GetIntProp(Component: TObject; PropName: String): Integer;
procedure SetIntProp(Component: TObject; PropName: String; Value: Integer);
function GetObjProp(Component: TObject; PropName: String): TObject;
procedure SetObjProp(Component: TObject; PropName: String; Value: TObject);
function CheckSetProp(Component: TObject; PropName, Value: String): Boolean;
function SetSetPropValue(Component: TObject; PropName, ValueName: String; Value : boolean): Boolean;

{ ************************************** }

{ String-handling procedures and function }

function acSameText(const S1,S2: ACString): Boolean;

{ File-handling procedures and functions }
function GetSystemDir: ACString;
function GetAppName: ACString;
function GetAppPath: ACString;
function NormalDir(const DirName: ACString): ACString;
function GetFileSize(const FileName: ACString): Int64; overload;
procedure CopyFiles(const SrcMask, SrcDir: ACString; DstDir: ACString);
function ClearDir(const Path: ACString; Delete: Boolean): Boolean;
procedure GetDirs(const Path : ACString; Items : TacStrings);

function acCreateDir(const DirName: ACString): Boolean;
function acRemoveDir(const DirName: ACString): Boolean;
function acDeleteFile(const FileName: ACString): Boolean;
function acCopyFile(const ExistingFileName, NewFileName: ACString; bFailIfExists: Boolean): Boolean;
function acFileSetAttr(const FileName: ACString; Attr: Cardinal): Integer;
function acFileGetAttr(const FileName: ACString): Cardinal;
function acFindFirst(const Path: ACString; Attr: Integer; var F: TacSearchRec): Integer;
function acFindNext(var F: TacSearchRec): Integer;
procedure acFindClose(var F: TacSearchRec);

{ Returns True if FileName is valid}
function ValidFileName(const FileName: ACString): Boolean;
{ Returns True if directory Name is exists. DEPRECATED. Use standard DirectoryExists }
function DirExists(const Name: ACString): Boolean;
{ Returns long file name from short}
function ShortToLongFileName(const ShortName: ACString): ACString;
{ Returns long path from short}
function ShortToLongPath(ShortName: ACString): ACString;
{ Returns short file name from long}
function LongToShortFileName(const LongName: ACString): ACString;
{ Returns short path from long}
function LongToShortPath(LongName: ACString): ACString;
function GetIconForFile(const FullFileName: ACString; Flag : integer): TIcon;
{$IFDEF TNTUNICODE}
{$MESSAGE WARN 'System.Delete great works with WideString in latest Delphi versions!}
procedure DeleteW(var s : WideString; index , count : integer);
{$ENDIF}

implementation

uses
  {$IFDEF TNTUNICODE} TntSystem, TntWindows, TntWideStrUtils,{$ENDIF}
  {$IFNDEF ALITE}sDialogs, {$ENDIF} Dialogs, Math, ShellAPI, TypInfo;

{$IFDEF TNTUNICODE}
procedure DeleteW(var s : WideString; index , count : integer);
{var tg : WideString;
    i : integer;
}
begin
  System.Delete(S, index, count);
{
  tg := '';
  for i := 1 to index - 1 do tg := tg + s[i];
  for i := index + count to length(s) do tg := tg + s[i];
  s := tg;
}
end;
{
procedure DeleteW(var s : WideString; index , count : integer);
var tg : WideString;
    i : integer;
begin
  tg := '';
  for i := 1 to index - 1 do tg := tg + s[i];
  for i := index + count to length(s) do tg := tg + s[i];
  s := tg;
end;
!!!}
{$ENDIF}

function GetCaptionFontSize : integer;
var
  NonClientMetrics: TNonClientMetrics;
begin
  NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0)
    then Result := NonClientMetrics.lfCaptionFont.lfHeight
    else Result := 0;
end;

function CheckLimits(Value, MinValue, MaxValue : integer) : integer;
begin
  if Value < MinValue then Result := MinValue else if Value > MaxValue then Result := MaxValue else Result := Value;
end;

function IntToByte(Value : integer) : byte;
begin
  case Value of
    Low(Integer) .. -1 : Result := 0;
    $FF .. High(Integer) : Result := $FF
    else Result := Value
  end;
end;

function IsDebuggerPresent(): Boolean; external 'kernel32.dll';

function HexToInt(HexStr : string) : Int64;
var
  i : byte;
begin
  if HexStr = '' then begin
    Result := 0;
    Exit;
  end;
  HexStr := UpperCase(HexStr);
  if HexStr[length(HexStr)] = 'H' then Delete(HexStr,length(HexStr),1);
  Result := 0;
  for i := 1 to length(HexStr) do begin
    Result := Result shl 4;
    if HexStr[i] in ['0'..'9']
      then Result := Result + (byte(HexStr[i]) - 48)
      else if HexStr[i] in ['A'..'F'] then Result := Result + (byte(HexStr[i]) - 55) else begin
        Result := 0;
        break;
      end;
  end;
end;

procedure GetIniSections(IniList, SectionsList : TStringList);
var
  I: Integer;
  S: string;
  Strings: TStrings;