paslib.pas

在工作中积累的一些函数

begin
    AList.Clear();
    LastNode := nil;
    for I := 0 to Strings.Count - 1 do
    begin
        CurrNode := New(PLayerItem);
        CurrNode.LayerParent := nil;
        CurrNode.LayerSub := TList.Create;

        CurrNode.LayerOrd := spStrName(Strings[I]);
        CurrNode.LayerName := spStrValue(Strings[I]);

        if LastNode = nil then
            AList.Add(CurrNode)
        else begin
            Relate := spGetOrdNumRelations(CurrNode.LayerOrd, LastNode.LayerOrd);
            case Relate of
                odNext, odSameLevel:
                    begin
                        if LastNode.LayerParent <> nil then
                            LastNode.LayerParent.LayerSub.Add(CurrNode) else
                            AList.Add(CurrNode);

                        CurrNode.LayerParent := LastNode.LayerParent;
                    end;
                odChild, odChildLevel:
                    begin
                        LastNode.LayerSub.Add(CurrNode);
                        CurrNode.LayerParent := LastNode;
                    end;
                odParentLevel:
                    begin
                        nLevel1 := spGetOrdNumLevel(LastNode.LayerOrd);
                        nLevel2 := spGetOrdNumLevel(CurrNode.LayerOrd);

                        while nLevel2 < nLevel1 do
                        begin
                            Dec(nLevel1);
                            if LastNode <> nil then
                                LastNode := LastNode.LayerParent;
                        end;

                        if (LastNode <> nil) and (LastNode.LayerParent <> nil) then
                        begin
                            LastNode.LayerParent.LayerSub.Add(CurrNode);
                            CurrNode.LayerParent := LastNode.LayerParent;
                        end
                        else begin
                            AList.Add(CurrNode);
                            CurrNode.LayerParent := nil;
                        end;
                    end;
            else begin
                    AList.Add(CurrNode);
                    CurrNode.LayerParent := nil;
                end;
            end;
        end;

        LastNode := CurrNode;
    end;
end;

procedure spAddOrdListToTree(AList: TList; ATree: TTreeView; const nImageIndex: Longint);

    procedure AddSubNodeToTree(AParentNode: TTreeNode; ASubList: TList);
    var
        I           : Longint;
        subNode     : TTreeNode;
        AItem       : PLayerItem;
    begin
        for I := 0 to ASubList.Count - 1 do
        begin
            AItem := PLayerItem(ASubList.Items[I]);
            if AItem <> nil then
            begin
                subNode := ATree.Items.AddChild(AParentNode,
                    '[' + AItem.LayerOrd + '] ' + AItem.LayerName);
                subNode.ImageIndex := nImageIndex;
                subNode.SelectedIndex := nImageIndex;
                subNode.StateIndex := -1;

                if (AItem.LayerSub <> nil) and (AItem.LayerSub.Count > 0) then
                    AddSubNodeToTree(subNode, AItem.LayerSub);
            end;
        end;
    end;

begin
    AddSubNodeToTree(nil, AList);
end;

function spCharSpan(const S: string; const ch: string): Longint;
var
    I, J            : Longint;
begin
    Result := 0;
    for I := 1 to Length(S) do
        for J := 1 to Length(ch) do
            if (S[I] = ch[J]) then
            begin
                Result := I;
                Exit;
            end;
end;


function spStrName(const s: string; const ch: char = '='): string;
var
    I               : Longint;
begin
    Result := '';
    for I := 1 to Length(s) + 1 do
    begin
        if (I = Length(s) + 1) or (s[I] = ch) then
        begin
            Result := Copy(s, 1, I - 1);
            Break;
        end;
    end;
end;

function spStrValue(const s: string; const ch: char = '='): string;
var
    I               : Longint;
begin
    Result := '';
    for I := 1 to Length(s) do
    begin
        if s[I] = ch then
        begin
            Result := Copy(s, I + 1, MaxInt);
            Break;
        end;
    end;
end;

function spSignToInt(const ch: char): Longint;
begin
    Result := 1;
    if ch = '-' then Result := -1;
end;


function spIsAlpha(const ch: char): Boolean;
begin
    Result := ch in ['A'..'Z', 'a'..'z'];
end;

function spIsDigit(const ch: char): Boolean;
begin
    Result := ch in ['0'..'9'];
end;

function spIsOdd(const N: Longint): Boolean;
begin
    Result := Odd(N);
end;

function spIsZero(V: double): Boolean;
begin
    Result := (V < 0.000001) and (V > -0.000001);
end;


function spStrToInt(const S: string): Longint;
begin
    Result := gc_strtol(PChar(S));
end;

function spStrToIntEx(const S: string; var EndStr: string): Longint;
var
    Code            : Longint;
begin
    EndStr := '';
    Val(S, Result, Code);
    if Code > 0 then EndStr := Copy(S, Code, MaxInt);
end;

function spStrToFloat(const S: string): double;
var
    EndStr          : string;
begin
    Result := spStrToFloatEx(S, EndStr);
end;

function spStrToFloatEx(const S: string; var EndStr: string): double;
var
    Head            : string;
    Code            : Longint;
begin
    EndStr := '';
    Val(S, Result, Code);

    if Code > 0 then
    begin
        EndStr := Copy(S, Code, MaxInt);
        Head := Copy(S, 1, Code - 1);
        Val(Head, Result, Code);

        if (EndStr <> '') and (EndStr[1] = '%') then
        begin
            Result := Result / 100;
            Delete(EndStr, 1, 1);
        end;
    end;
end;


function spReverseSign(const ch: char): char;
begin
    if ch = '+' then
        Result := '-' else
        Result := '+';
end;


function spFormatFloat(V: double; const nDec: Word = 2): double;
const
    PREC_MASK       : array[0..6] of string = ('0', '0.0', '0.00', '0.000', '0.0000',
        '0.00000', '0.000000');
begin
    Result := StrToFloat(FormatFloat(PREC_MASK[nDec], V));
end;

function spFormatFloatToSz(V: double; nDec: Word; const bAllowNull: Boolean = False): string;
const
    PREC_MASK       : array[0..6] of string = ('0', '0.0', '0.00', '0.000', '0.0000',
        '0.00000', '0.000000');
begin
    Result := FormatFloat(PREC_MASK[nDec], V);
    if not bAllowNull and (V = 0) then
        Result := '';
end;


function spFindToken(const S: string; var szMatch: string; Pattern: array of string): Longint;
var
    I, nOffset      : Longint;
begin
    Result := -1;
    szMatch := '';
    for I := Low(Pattern) to High(Pattern) do
    begin
        nOffset := Pos(Pattern[I], S);
        if nOffset > 0 then
        begin
            Result := nOffset;
            szMatch := Pattern[I];
            Break;
        end;
    end;
end;


function spIsSectionStr(const S: string): Boolean;
begin
    Result := False;
    if (S <> '') and (S[1] = '[') and (S[Length(S)] = ']') then
        Result := True;
end;

procedure spExtractSymbolText(S: string; Symbol: Char; var Args: array of string;
    nDouble: Integer; const bIngoreCase: Boolean = True);
var
    Head, Tail      : PChar;
    upSymbol, loSymbol: Char;
    Item            : string;
    EOS             : Boolean;
    Index, MinIndex, MaxIndex: Integer;
    nCount          : Integer;
begin
    MinIndex := Low(Args);
    MaxIndex := High(Args);
    for Index := MinIndex to MaxIndex do
        Args[Index] := '';

    Head := PChar(S);
    Tail := Head;
    upSymbol := spUpCase(Symbol);
    loSymbol := spLoCase(Symbol);
    Index := MinIndex;

    repeat
        while not ((Tail^ in [Symbol, #0])
            or (bIngoreCase and (Tail^ in [upSymbol, loSymbol, #0]))) do
            Inc(Tail);

        nCount := 0;
        while (Tail^ <> #0) and (nCount < nDouble - 1) do
        begin
            Inc(Tail);
            Inc(nCount);
        end;

        if (Tail^ in [Symbol, #0])
            or (bIngoreCase and (Tail^ in [upSymbol, loSymbol, #0])) then
        begin
            if Tail^ <> #0 then
                SetString(Item, Head, Tail - Head - (nDouble - 1))
            else
                SetString(Item, Head, Tail - Head);

            Args[Index] := Item;
            Inc(Index);
        end;

        if (Tail^ <> #0) and ((Tail^ = Symbol)
            or (bIngoreCase and (Tail^ in [upSymbol, loSymbol]))) then
        begin
            Inc(Tail);
            Head := Tail;
        end;

        EOS := (Tail^ = #0) or (Index > MaxIndex);
    until EOS;

end;

procedure spExtractTextByToken(const S: string; const charset: string;
    Strings: Tstrings; const bIncludeToken: Boolean = True);
var
    I, nLastPos     : Longint;
    Item            : string;
begin
    Strings.Clear;
    nLastPos := 1;

    for I := 1 to Length(S) + 1 do
    begin
        if (I = Length(S) + 1) or (Pos(S[I], charset) > 0) then
        begin
            Item := Copy(S, nLastPos, I - nLastPos);

            Strings.Add(Item);

            nLastPos := I + 1;
        end;
    end;
    {
    var
        BUFFER_SIZE  : Longint;
        buffer : Pchar;
        head : Pchar;
        tail : Pchar;
        copy_size : Longint;
    begin
            BUFFER_SIZE := 1024;
            buffer := Pchar(BUFFER_SIZE);

            head := Pchar(S);
            tail := CharNext(head);

            Strings.Clear();
            while tail <> nil do
            begin
                    if (Pos(tail, charset) > 0) or (tail = '#0') then
                    begin
                           // strnset(buffer, '#0', BUFFER_SIZE);
                            copy_size := tail - head;
                           // strncpy(buffer, head, copy_size);
                            if buffer = nil then
                                    Strings.Add('')
                            else    Strings.Add(buffer);

                            if not bIncludeToken then
                                    head := CharNext(tail)
                            else    head := tail;
                    end;