sutils.pas

AlphaControls是一个Delphi标准控件的集合

unit sUtils;
{$I sDefs.inc}
{.$I-,R-}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, sConst, ExtCtrls, typinfo, ShlObj, ActiveX, ComObj;

const
  IID_IPersistFile: TGUID = (
    D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));

{ Serviced. Used for debugging}
procedure Alert; overload;
procedure Alert(s : string); overload;
procedure Alert(i : integer); overload;
function BoolToStr(b : boolean) : string;
function MakeMessage(Msg, WParam, LParam, Rsult : longint) : TMessage;
function GetCents(Value : Extended) : smallint;
{ Returns True if value placed berween i1 and i2}
function Between(Value, i1, i2 : integer) : boolean;
{ 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;
{ Change values of i1 and i2}
procedure Changei(var i1, i2 : integer);
{ Returns True if Value is valid float}
function IsValidFloat(const Value: string; var RetValue: Extended): Boolean;
{ Returns formated string, represented float value}
function FormatFloatStr(const S: string; Thousands: Boolean): string;

{ Offset point}
function OffsetPoint(p: TPoint; x,y : integer): TPoint;
{ Returns width of rectangle}
function WidthOf(r: TRect): integer;
{ Returns height of rectangle}
function HeightOf(r: TRect): integer;
{ Returns string s1 if L, else return s2}
function iff(L : boolean; 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(SubString, s : string; CaseInsensitive : boolean) : boolean;
{ Corrects string for SQL-operations}
function CorrectString(s : string) : string;
{ 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 word number N from string S. WordDelims - chars, word delimiters}
function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;
{ 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 proper cases of first characters in words. WordDelims - chars, word delimiters}
function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
{ Returns string with length N, filled by character C}
function MakeStr(C: Char; N: Integer): string;
{ 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;
{ Replace substring Srch in string S by substring Replace}
function ReplaceStr(const S, Srch, Replace: string): string;
{ Returns substring from position Pos}
function ExtractSubstr(const S: string; var Pos: Integer; const Delims: TSysCharSet): string;
{ Returns False if S include EmptyChars only}
function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
{ Add N chars C to string S}
function AddChar(C: Char; const S: string; N: Integer): string;
{ 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;

{ If S - is 'FirstName SecondName LastName', then returns it as 'FirstName S. L.'}
function FIOLongToShort(S:string):string;
{ Returns real value from string with validation}
function StrToFloatR (Field1 : string) : real;
{ Rounds value F up to two chars after a point}
function CurRound(f : real) : real;
{ Returns SQL-string without definition 'WHERE', 'ORDER BY' and 'GROUP BY'}
function GetSelectFromSQL(s : string) : string;

{ Request for item deleting}
function DeleteRequest:boolean;
{ Qustom request}
function CustomRequest(s : string):boolean;
{ Show message S with icon mtWarning}
procedure ShowWarning(S:string);
{ Show message S with icon mtError}
procedure ShowError(s:string);
{ Delay in milliseconds}
procedure Delay(MSecs: Integer);

function GetAppName : string;
function GetAppPath : string;
{ Returns True if FileName is valid}
function ValidFileName(const FileName: string): Boolean;
{ Returns True if directory Name is exists}
function DirExists(Name: string): Boolean;
{ Returns long file name from short}
function ShortToLongFileName(const ShortName: string): string;
{ Returns long path from short}
function ShortToLongPath(const ShortName: string): string;
{ Returns short file name from long}
function LongToShortFileName(const LongName: string): string;
{ Returns short path from long}
function LongToShortPath(const LongName: string): string;
{ Returns True if Delphi IDE is running}
function IsIDERunning: boolean;
procedure CopyFile(const FileName, DestName: string;
  ProgressControl, LabelControlFrom, LabelControlTo: TControl);
procedure CopyFileEx(const FileName, DestName: string;
  OverwriteReadOnly : Boolean; ProgressControl, LabelControlFrom, LabelControlTo: TControl);
function GetFileSize(const FileName: string): Longint;
function ClearDir(const Path: string; Delete: Boolean): Boolean;
function NormalDir(const DirName: string): string;
procedure CopyFiles(SrcDir, DstDir, Masks : string; ProgressControl, LabelControlFrom, LabelControlTo: TControl);
procedure CreateLink(const FileName, DisplayName: string; Folder: Integer);

implementation

uses stdCtrls, sStoreUtils {$IFNDEF ALITE}, sGauge, sCustomComboBox{$ENDIF};

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

procedure Alert;
begin
  ShowWarning('Alert!');
end;

procedure Alert(s : string); overload;
begin
  ShowWarning(s);
end;

procedure Alert(i : integer); overload;
begin
  ShowWarning(IntToStr(i));
//  WriteIniStr(timeToStr(Time), 'Alert', IntToStr(i), 'c:\aaaa.txt');
end;

function BoolToStr(b : boolean) : string;
begin
  if b then Result := 'True' else Result := 'False';
end;

function MakeMessage(Msg, WParam, LParam, Rsult : longint) : TMessage;
begin
  Result.Msg := Msg;
  Result.WParam := WParam;
  Result.WParam := LParam;
  Result.Result := RSult;
end;

function GetCents(Value : Extended) : smallint;
var
  e : extended;
begin
  e := Value;
  Result := Round(Frac(e) * 100);
end;

function iff(L : boolean; s1, s2 : string) : string;
begin
  if l then Result := s1 else Result := s2;
end;
{!
function iff(L : boolean; s1, s2 : integer) : integer; overload;
begin
  if l then Result := s1 else Result := s2;
end;

function iff(L : boolean; s1, s2 : real) : real; overload;
begin
  if l then Result := s1 else Result := s2;
end;
}
function iffo(L : boolean; o1, o2 : TObject) : TObject;
begin
  if l then Result := o1 else Result := o2;
end;

function iffi(L : boolean; i1, i2 : integer) : integer;
begin
  if l then Result := i1 else Result := i2;
end;

function Between(Value, i1, i2 : integer) : boolean;
begin
  Result := (Value >= i1) and (Value <= i2);
end;

function SumTrans(i1, i2 : integer): integer;
begin
  Result := Round(i2 + (100 - i2) * (i1 / 100));
end;

function Maxi(i1, i2 : integer) : integer;
begin
  if i1 > i2 then Result := i1 else Result := i2;
end;

function Mini(i1, i2 : integer) : integer;
begin
  if i1 > i2 then Result := i2 else Result := i1;
end;

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

procedure Changei(var i1, i2 : integer);
var
  i : integer;
begin
  i := i2;
  i2 := i1;
  i1 := i;
end;

function IsValidFloat(const Value: string; var RetValue: Extended): Boolean;
var
  I: Integer;
  Buffer: array[0..63] of Char;
begin
  Result := False;
  for I := 1 to Length(Value) do
    if not (Value[I] in [DecimalSeparator, '-', '+', '0'..'9', 'e', 'E']) then
      Exit;
  Result := TextToFloat(StrPLCopy(Buffer, Value,
    SizeOf(Buffer) - 1), RetValue {$IFDEF WIN32}, fvExtended {$ENDIF});
end;

function FormatFloatStr(const S: string; Thousands: Boolean): string;
var
  I, MaxSym, MinSym, Group: Integer;
  IsSign: Boolean;
begin
  Result := '';
  MaxSym := Length(S);
  IsSign := (MaxSym > 0) and (S[1] in ['-', '+']);
  if IsSign then MinSym := 2
  else MinSym := 1;
  I := Pos(DecimalSeparator, S);
  if I > 0 then MaxSym := I - 1;
  I := Pos('E', AnsiUpperCase(S));
  if I > 0 then MaxSym := Mini(I - 1, MaxSym);
  Result := Copy(S, MaxSym + 1, MaxInt);
  Group := 0;
  for I := MaxSym downto MinSym do begin
    Result := S[I] + Result;
    Inc(Group);
    if (Group = 3) and Thousands and (I > MinSym) then begin
      Group := 0;
      Result := ThousandSeparator + Result;
    end;
  end;
  if IsSign then Result := S[1] + Result;
end;

function OffsetPoint(p: TPoint; x,y : integer): TPoint;
begin
  Result := p;
  inc(Result.x, x);
  inc(Result.y, y);
end;

function WidthOf(r: TRect): integer;
begin
  Result := r.Right - r.Left;
end;

function HeightOf(r: TRect): integer;
begin
  Result := r.Bottom - r.Top;
end;

function SubStrInclude(SubString, s : string; CaseInsensitive : boolean) : boolean;
begin
  if CaseInsensitive then begin
    Result := pos(UpperCase(SubString), UpperCase(s)) > 0;
  end
  else begin
    Result := pos(SubString, s) > 0;
  end;
end;

function CorrectString(s : string) : string;
begin
//  s := DelSpace1(s);
  Result := s;
  Result := ReplaceStr(Result, '''', '`');
  Result := ReplaceStr(Result, '