acutilities.pas

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

begin
  SectionsList.Clear;
  Strings := nil;
  for I := 0 to IniList.Count - 1 do begin
    S := IniList[I];
    if (S <> '') and (S[1] <> ';') then begin
      if (S[1] = '[') and (S[Length(S)] = ']') then begin
        Strings := TStringList.Create;
        try
          SectionsList.AddObject(Copy(S, 2, Length(S) - 2), Strings);
        except
          Strings.Free;
        end;
      end
      else begin
        if Strings <> nil then Strings.Add(S);
      end;
    end;
  end;
end;

procedure GetIniSection(const Section: string; Sections, Strings: TStrings);
var
  I, J: Integer;
  SectionStrings: TStrings;
begin
  Strings.BeginUpdate;
  try
    Strings.Clear;
    I := Sections.IndexOf(Section);
    if I >= 0 then
    begin
      SectionStrings := TStrings(Sections.Objects[I]);
      for J := 0 to SectionStrings.Count - 1 do
        Strings.Add(SectionStrings.Names[J]);
    end;
  finally
    Strings.EndUpdate;
  end;
end;

function ReadIniString(IniList, SectionsList : TStringList; const Section, Ident, Default: string): string;
var
  I: Integer;
  Strings: TStrings;
begin
  I := SectionsList.IndexOf(Section);
  if I >= 0 then begin
    Strings := TStrings(SectionsList.Objects[I]);
    I := Strings.IndexOfName(Ident);
    if I >= 0 then begin
      Result := Copy(Strings[I], Length(Ident) + 2, Maxint);
      Exit;
    end;
  end;
  Result := Default;
end;

function ReadIniInteger(IniList, SectionsList : TStringList; const Section, Ident: string; Default: Longint): Longint;
var
  IntStr: string;
begin
  IntStr := ReadIniString(IniList, SectionsList, Section, Ident, '');
  if (Length(IntStr) > 2) and (IntStr[1] = '0') and ((IntStr[2] = 'X') or (IntStr[2] = 'x')) then IntStr := '$' + Copy(IntStr, 3, Maxint);
  Result := StrToIntDef(IntStr, Default);
end;

{$IFNDEF ALITE}
procedure Alert;
begin
  ShowWarning('Alert');
end;

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

procedure Alert(i : integer); overload;
begin
  ShowWarning(IntToStr(i));
end;
{$ENDIF}

function StringToFloat(S : String) : Extended;
var
  E: Integer;
begin
   s := Trim(s);
   while Pos(',', S) > 0 do
       S[Pos(',', S)] := '.';
   if Pos('.',s)<0 then Val(S+'.0', Result, E)
                   else Val(S, Result, E);
   if E<>0 then Result:=0;
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.LParam := 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; const s1, s2 : string) : string;
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 RectIsVisible(const ParentRect, Rect : TRect) : boolean;
begin
  Result := (Rect.Bottom > ParentRect.Top) and
              (Rect.Right > ParentRect.Left) and
                (Rect.Left < ParentRect.Right) and
                  (Rect.Top < ParentRect.Bottom) and not IsRectEmpty(Rect);
end;

function RectInRect( BigRect, SmallRect : TRect) : boolean;
begin
  inc(BigRect.Bottom); inc(BigRect.Right);
  Result := PtInRect(BigRect, SmallRect.TopLeft) and PtInRect(BigRect, SmallRect.BottomRight);
end;

function RotateRect(R : TRect) : TRect;
var
  i : integer;
begin
  i := R.left;
  R.left := R.top;
  R.top := i;

  i := R.right;
  R.right := R.bottom;
  R.bottom := i;
  Result := R;
end;

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

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

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

function SubStrInclude(const 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(const s : string) : string;
begin
//  s := DelSpace1(s);
  Result := s;
  Result := ReplaceStr(Result, '''', '`');
  Result := ReplaceStr(Result, '