?? sutils.pas
字號:
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, '
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -