Vitaly Nevzorov
Профиль
Группа: Экс. модератор
Сообщений: 10964
Регистрация: 25.3.2002
Где: Chicago
Репутация: нет
Всего: 207
|
| Цитата | | Есть ли понятие делегата? |
Если б я ещё знал что это такое... | Цитата | | Есть ли исходники борландовских модулей (System, SysUtils, Forms |
, Есть. Выложить затруднительно, там многие тысячи строк. Вот кусок из SysUtils: | Код | function IsValidIdent(const Ident: string; AllowDots: Boolean): Boolean;
var
I: Integer;
begin
Result := False;
if (Length(Ident) = 0) or not (Ident[1] in Alpha) then Exit;
if AllowDots then
for I := 2 to Length(Ident) do
begin
if not (Ident[I] in AlphaNumericDot) then Exit
end
else
for I := 2 to Length(Ident) do
if not (Ident[I] in AlphaNumeric) then Exit;
Result := True;
end;
function IntToStr(Value: Integer): string;
begin
Result := System.Convert.ToString(Value);
end;
function IntToStr(Value: Int64): string;
begin
Result := System.Convert.ToString(Value);
end;
function UIntToStr(Value: LongWord): string;
begin
Result := System.Convert.ToString(Value);
end;
function UIntToStr(Value: UInt64): string;
begin
Result := System.Convert.ToString(Value);
end;
function IntToHex(Value: Integer; Digits: Integer): string;
begin
FmtStr(Result, '%.*x', [Digits, Value]);
end;
function IntToHex(Value: Int64; Digits: Integer): string;
begin
FmtStr(Result, '%.*x', [Digits, Value]);
end;
function StrToInt(const S: string): Integer;
var
E: Integer;
begin
Val(S, Result, E);
if E <> 0 then ConvertErrorFmt(SInvalidInteger, [S]);
end;
function StrToIntDef(const S: string; Default: Integer): Integer;
begin
if not TryStrToInt(S, Result) then
Result := Default;
end;
function TryStrToInt(const S: string; out Value: Integer): Boolean;
var
E: Integer;
begin
Val(S, Value, E);
Result := E = 0;
end;
function StrToLongWord(const S: string): LongWord;
var
E: Integer;
begin
Val(S, Result, E);
if E <> 0 then ConvertErrorFmt(SInvalidInteger, [S]);
end;
function StrToLongWordDef(const S: string; Default: LongWord): LongWord;
begin
if not TryStrToLongWord(S, Result) then
Result := Default;
end;
function TryStrToLongWord(const S: string; out Value: LongWord): Boolean;
var
E: Integer;
begin
Val(S, Value, E);
Result := E = 0;
end;
function StrToInt64(const S: string): Int64;
var
E: Integer;
begin
Val(S, Result, E);
if E <> 0 then ConvertErrorFmt(SInvalidInteger, [S]);
end;
function StrToInt64Def(const S: string; const Default: Int64): Int64;
begin
if not TryStrToInt64(S, Result) then
Result := Default;
end;
function TryStrToInt64(const S: string; out Value: Int64): Boolean;
var
E: Integer;
begin
Val(S, Value, E);
Result := E = 0;
end;
function StrToUInt64(const S: string): UInt64;
var
E: Integer;
begin
Val(S, Result, E);
if E <> 0 then ConvertErrorFmt(SInvalidInteger, [S]);
end;
function StrToUInt64Def(const S: string; const Default: UInt64): UInt64;
begin
if not TryStrToUInt64(S, Result) then
Result := Default;
end;
function TryStrToUInt64(const S: string; out Value: UInt64): Boolean;
var
E: Integer;
begin
Val(S, Value, E);
Result := E = 0;
end;
function StringReplace(const S, OldPattern, NewPattern: string;
Flags: TReplaceFlags): string;
var
SearchStr, Patt, NewStr: string;
Offset: Integer;
SB: StringBuilder;
begin
if rfIgnoreCase in Flags then
begin
SearchStr := UpperCase(S);
Patt := UpperCase(OldPattern);
end else
begin
SearchStr := S;
Patt := OldPattern;
end;
NewStr := S;
SB := StringBuilder.Create;
while SearchStr <> '' do
begin
Offset := Pos(Patt, SearchStr);
if Offset = 0 then
begin
SB.Append(NewStr);
Break;
end;
SB.Append(NewStr, 0, Offset - 1);
SB.Append(NewPattern);
NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
if not (rfReplaceAll in Flags) then
begin
SB.Append(NewStr);
Break;
end;
SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
end;
Result := SB.ToString;
end;
procedure VerifyBoolStrArray;
begin
if Length(TrueBoolStrs) = 0 then
begin
SetLength(TrueBoolStrs, 2);
TrueBoolStrs[0] := DefaultTrueBoolStr;
TrueBoolStrs[1] := DefaultTrueBoolStr[1];
end;
if Length(FalseBoolStrs) = 0 then
begin
SetLength(FalseBoolStrs, 2);
FalseBoolStrs[0] := DefaultFalseBoolStr;
FalseBoolStrs[1] := DefaultFalseBoolStr[1];
end;
end;
function StrToBool(const S: string; StrOnlyTest: Boolean): Boolean;
begin
if not TryStrToBool(S, Result, StrOnlyTest) then
ConvertErrorFmt(SInvalidBoolean, [S]);
end;
function StrToBoolDef(const S: string; const Default: Boolean; StrOnlyTest: Boolean): Boolean;
begin
if not TryStrToBool(S, Result, StrOnlyTest) then
Result := Default;
end;
function TryStrToBool(const S: string; out Value: Boolean; StrOnlyTest: Boolean): Boolean;
function CompareWith(const aArray: array of string): Boolean;
var
I: Integer;
begin
Result := False;
for I := Low(aArray) to High(aArray) do
if AnsiSameText(S, aArray[I]) then
begin
Result := True;
Break;
end;
end;
var
LResult: Double;
begin
if not StrOnlyTest then
begin
Result := TryStrToFloat(S, LResult);
if Result then
begin
Value := LResult <> 0;
Exit;
end;
end;
VerifyBoolStrArray;
Result := CompareWith(TrueBoolStrs);
if Result then
Value := True
else
begin
Result := CompareWith(FalseBoolStrs);
if Result then
Value := False;
end;
end;
const
cSimpleBoolStrs: array [boolean] of String = ('0', '-1');
function BoolToStr(B: Boolean; UseBoolStrs: Boolean = False): string;
begin
if UseBoolStrs then
begin
VerifyBoolStrArray;
if B then
Result := TrueBoolStrs[0]
else
Result := FalseBoolStrs[0];
end
else
Result := cSimpleBoolStrs[B];
end;
function Format(const Format: string; const Args: array of const): string;
begin
FmtStr(Result, Format, Args);
end;
function Format(const Format: string; const Args: array of const;
const FormatSettings: TFormatSettings): string;
begin
FmtStr(Result, Format, Args, FormatSettings);
end;
function Format(const Format: string; const Args: array of const;
Provider: IFormatProvider): string;
begin
FmtStr(Result, Format, Args, Provider);
end;
procedure FmtStr(var Result: string; const Format: string;
const Args: array of const);
var
Buffer: System.Text.StringBuilder;
begin
Buffer := System.Text.StringBuilder.Create(Length(Format) * 2);
FormatBuf(Buffer, Format, Length(Format), Args);
Result := Buffer.ToString;
end;
procedure FmtStr(var Result: string; const Format: string;
const Args: array of const; const FormatSettings: TFormatSettings);
var
Buffer: System.Text.StringBuilder;
begin
Buffer := System.Text.StringBuilder.Create(Length(Format) * 2);
FormatBuf(Buffer, Format, Length(Format), Args, FormatSettings);
Result := Buffer.ToString;
end;
procedure FmtStr(var Result: string; const Format: string;
const Args: array of const; Provider: IFormatProvider);
var
Buffer: System.Text.StringBuilder;
begin
Buffer := System.Text.StringBuilder.Create(Length(Format) * 2);
FormatBuf(Buffer, Format, Length(Format), Args, Provider);
Result := Buffer.ToString;
end;
function FormatBuf(var Buffer: System.Text.StringBuilder; const Format: string;
FmtLen: Cardinal; const Args: array of const): Cardinal;
var
LFormat: NumberFormatInfo;
begin
LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
with LFormat do
begin
CurrencyDecimalSeparator := DecimalSeparator;
CurrencyGroupSeparator := ThousandSeparator;
NumberDecimalSeparator := DecimalSeparator;
NumberGroupSeparator := ThousandSeparator;
CurrencySymbol := CurrencyString;
CurrencyPositivePattern := CurrencyFormat;
CurrencyNegativePattern := NegCurrFormat;
end;
Result := FormatBuf(Buffer, Format, FmtLen, Args, LFormat);
end;
function FormatBuf(var Buffer: System.Text.StringBuilder; const Format: string;
FmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;
var
LFormat: NumberFormatInfo;
begin
LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
with LFormat, FormatSettings do
begin
CurrencyDecimalSeparator := DecimalSeparator;
CurrencyGroupSeparator := ThousandSeparator;
NumberDecimalSeparator := DecimalSeparator;
NumberGroupSeparator := ThousandSeparator;
CurrencySymbol := CurrencyString;
CurrencyPositivePattern := CurrencyFormat;
CurrencyNegativePattern := NegCurrFormat;
end;
Result := FormatBuf(Buffer, Format, FmtLen, Args, LFormat);
end;
function FormatBuf(var Buffer: System.Text.StringBuilder; const Format: string;
FmtLen: Cardinal; const Args: array of const; Provider: IFormatProvider): Cardinal;
procedure Error;
begin
raise System.FormatException.Create(SInvalidFormatString);
end;
var
s, srclen: Cardinal;
argIndex: Cardinal;
precisionStart: Cardinal;
precisionLen: Integer;
fmtSpec: System.Text.StringBuilder;
argStr: string;
begin
s := 1;
argIndex := 0;
srclen := Length(Format);
fmtSpec := System.Text.StringBuilder.Create;
while s <= srclen do
begin
if Format[s] = '%' then
begin
Inc(s);
if s > srclen then break;
if Format[s] = '%' then
begin
Buffer.Append(Format[s]);
Inc(s);
Continue;
end;
fmtSpec.Length := 0;
fmtSpec.Append('{0,');
if Format[s] = '-' then // width might be first
begin
fmtSpec.Append(Char('-'));
Inc(s);
end;
if Format[s] = '*' then
begin
fmtSpec.Append(Args[argIndex]);
Inc(argIndex);
Inc(s);
end
else
begin
while (s < srclen) and System.Char.IsDigit(Format[s]) do
begin
fmtSpec.Append(Format[s]);
Inc(s);
end;
end;
if s > srclen then Error;
if Format[s] = ':' then
begin
Inc(s);
// something got added, it must be the index
if fmtSpec.Length > 3 then
begin
argStr := fmtSpec.ToString(3, fmtSpec.Length - 3);
argIndex := Int32.Parse(argStr);
fmtSpec.Length := 3;
end
// nothing got added, the index then defaults to zero
else
argIndex := 0;
// width follows argIndex
if Format[s] = '-' then
begin
fmtSpec.Append(Char('-'));
Inc(s);
end;
if Format[s] = '*' then
begin
fmtSpec.Append(Args[argIndex]);
Inc(argIndex);
Inc(s);
end
else
begin
while (s < srclen) and System.Char.IsDigit(Format[s]) do
begin
fmtSpec.Append(Format[s]);
Inc(s);
end;
end;
end;
if fmtSpec.Length = 3 then
fmtSpec.Length := 2; // remove comma if no width spec was found
if s > srclen then Error;
if Format[s] = '.' then
begin
Inc(s);
if Format[s] = '*' then
begin
precisionStart := Integer(Args[argIndex]);
precisionLen := -1;
Inc(argIndex);
Inc(s);
end
else
begin
precisionStart := s - 1;
while (s < srclen) and System.Char.IsDigit(Format[s]) do
Inc(s);
precisionLen := s - precisionStart - 1;
end;
end
else
begin
precisionStart := 0;
precisionLen := 0;
end;
fmtSpec.Append(Char(':'));
case Format[s] of
'd', 'D',
'u', 'U': fmtSpec.Append(Char('d'));
'e', 'E',
'f', 'F',
'g', 'G',
'n', 'N',
'x', 'X': fmtSpec.Append(Char(Format[s]));
'm', 'M': fmtSpec.Append(Char('c'));
'p', 'P': fmtSpec.Append(Char('x'));
's', 'S':; // no format spec needed for strings
else
Error;
end;
if precisionLen > 0 then
fmtSpec.Append(Format, precisionStart, precisionLen)
else if precisionLen < 0 then
fmtSpec.Append(precisionStart);
fmtSpec.Append(Char('}'));
Buffer.AppendFormat(Provider, fmtSpec.ToString, [Args[argIndex]]);
Inc(argIndex);
end
else
Buffer.Append(Format[s]);
Inc(s);
end;
Result := Buffer.Length;
end;
function WideFormat(const AFormat: WideString;
const Args: array of const): WideString;
begin
Result := Format(AFormat, Args);
end;
function WideFormat(const AFormat: WideString;
const Args: array of const; const FormatSettings: TFormatSettings): WideString;
begin
Result := Format(AFormat, Args, FormatSettings);
end;
function WideFormat(const AFormat: WideString;
const Args: array of const; Provider: IFormatProvider): WideString;
begin
Result := Format(AFormat, Args, Provider);
end;
procedure WideFmtStr(var AResult: WideString; const AFormat: WideString;
const Args: array of const);
begin
FmtStr(AResult, AFormat, Args);
end;
procedure WideFmtStr(var AResult: WideString; const AFormat: WideString;
const Args: array of const; const FormatSettings: TFormatSettings);
begin
FmtStr(AResult, AFormat, Args, FormatSettings);
end;
procedure WideFmtStr(var AResult: WideString; const AFormat: WideString;
const Args: array of const; Provider: IFormatProvider);
begin
FmtStr(AResult, AFormat, Args, Provider);
end;
function WideFormatBuf(var ABuffer: System.Text.StringBuilder; const AFormat: WideString;
AFmtLen: Cardinal; const Args: array of const): Cardinal;
begin
Result := FormatBuf(ABuffer, AFormat, AFmtLen, Args);
end;
function WideFormatBuf(var ABuffer: System.Text.StringBuilder; const AFormat: WideString;
AFmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;
begin
Result := FormatBuf(ABuffer, AFormat, AFmtLen, Args, FormatSettings);
end;
function WideFormatBuf(var ABuffer: System.Text.StringBuilder; const AFormat: WideString;
AFmtLen: Cardinal; const Args: array of const; Provider: IFormatProvider): Cardinal;
begin
Result := FormatBuf(ABuffer, AFormat, AFmtLen, Args, Provider);
end;
function StrToFloat(const S: string): Extended;
var
Value: Double;
begin
if not TryStrToFloat(S, Value) then
ConvertErrorFmt(SInvalidFloat, [S]);
Result := Value;
end;
function StrToFloat(const S: string; const FormatSettings: TFormatSettings): Extended;
var
Value: Double;
begin
if not TryStrToFloat(S, Value, FormatSettings) then
ConvertErrorFmt(SInvalidFloat, [S]);
Result := Value;
end;
function StrToFloat(const S: string; Provider: IFormatProvider): Extended;
var
Value: Double;
begin
if not TryStrToFloat(S, Value, Provider) then
ConvertErrorFmt(SInvalidFloat, [S]);
Result := Value;
end;
function StrToFloatDef(const S: string; const Default: Extended): Extended;
var
Value: Double;
begin
if TryStrToFloat(S, Value) then
Result := Value
else
Result := Default;
end;
function StrToFloatDef(const S: string; const Default: Extended;
const FormatSettings: TFormatSettings): Extended;
var
Value: Double;
begin
if TryStrToFloat(S, Value, FormatSettings) then
Result := Value
else
Result := Default;
end;
function StrToFloatDef(const S: string; const Default: Extended;
Provider: IFormatProvider): Extended;
var
Value: Double;
begin
if TryStrToFloat(S, Value, Provider) then
Result := Value
else
Result := Default;
end;
function TryStrToFloat(const S: string; out Value: Double): Boolean;
var
LFormat: NumberFormatInfo;
begin
LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
with LFormat do
begin
CurrencyDecimalSeparator := DecimalSeparator;
CurrencyGroupSeparator := ThousandSeparator;
NumberDecimalSeparator := DecimalSeparator;
NumberGroupSeparator := ThousandSeparator;
end;
Result := TryStrToFloat(S, Value, LFormat);
end;
function TryStrToFloat(const S: string; out Value: Double;
const FormatSettings: TFormatSettings): Boolean;
var
LFormat: NumberFormatInfo;
begin
LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
with LFormat, FormatSettings do
begin
CurrencyDecimalSeparator := DecimalSeparator;
CurrencyGroupSeparator := ThousandSeparator;
NumberDecimalSeparator := DecimalSeparator;
NumberGroupSeparator := ThousandSeparator;
end;
Result := TryStrToFloat(S, Value, LFormat);
end;
function TryStrToFloat(const S: string; out Value: Double;
Provider: IFormatProvider): Boolean;
begin
Result := System.Double.TryParse(S, NumberStyles.Float, Provider, Value);
end;
function TryStrToFloat(const S: string; out Value: Single): Boolean;
var
LValue: Double;
begin
Result := TryStrToFloat(S, LValue);
if Result then
Value := LValue;
end;
function TryStrToFloat(const S: string; out Value: Single;
const FormatSettings: TFormatSettings): Boolean;
var
LValue: Double;
begin
Result := TryStrToFloat(S, LValue, FormatSettings);
if Result then
Value := LValue;
end;
function TryStrToFloat(const S: string; out Value: Single;
Provider: IFormatProvider): Boolean;
var
LValue: Double;
begin
Result := TryStrToFloat(S, LValue, Provider);
if Result then
Value := LValue;
end;
function StrToCurr(const S: string): Currency;
begin
if not TryStrToCurr(S, Result) then
ConvertErrorFmt(SInvalidFloat, [S]);
end;
function StrToCurr(const S: string; const FormatSettings: TFormatSettings): Currency;
begin
if not TryStrToCurr(S, Result, FormatSettings) then
ConvertErrorFmt(SInvalidFloat, [S]);
end;
function StrToCurr(const S: string; Provider: IFormatProvider): Currency;
begin
if not TryStrToCurr(S, Result, Provider) then
ConvertErrorFmt(SInvalidFloat, [S]);
end;
function StrToCurrDef(const S: string; const Default: Currency): Currency;
begin
if not TryStrToCurr(S, Result) then
Result := Default;
end;
function StrToCurrDef(const S: string; const Default: Currency;
const FormatSettings: TFormatSettings): Currency;
begin
if not TryStrToCurr(S, Result, FormatSettings) then
Result := Default;
end;
function StrToCurrDef(const S: string; const Default: Currency;
Provider: IFormatProvider): Currency;
begin
if not TryStrToCurr(S, Result, Provider) then
Result := Default;
end;
function TryStrToCurr(const S: string; out Value: Currency): Boolean;
var
LFormat: NumberFormatInfo;
begin
LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
with LFormat do
begin
CurrencyDecimalSeparator := DecimalSeparator;
CurrencyGroupSeparator := ThousandSeparator;
NumberDecimalSeparator := DecimalSeparator;
NumberGroupSeparator := ThousandSeparator;
end;
Result := TryStrToCurr(S, Value, LFormat);
end; |
--------------------
With the best wishes, VitI have done so much with so little for so long that I am now qualified to do anything with nothing Самый большой Delphi FAQ на русском языке здесь: www.drkb.ru |
Delphi - 8. Первые впечатления. Шаг вперёд - 2 шага назад 
Загрузка ...
