paslib.pas

在工作中积累的一些函数

{*
 * 标准 pascal 例程库
 *
 * 2001.10.29 by ddev
 *
 * 说明：如果有其它的例程需要在其它的单元内实现，则必须在本单元内建立引用。
 *       也就是说，该单元是所有标准 pascal 例程唯一需要引用的单元文件，包括
 *       有可能的 DLLs 调用。为了防止与现有 DELPHI 中的某些例程发生冲突，要
 *       求所有公开例程必须以小写的“sp”开头，如：spFormatFloat()。例程命名
 *       尽量以 Windows 的标准命名规则--动名词的形式命名函数，并尽可能使用英
 *       文原义命名。
 *
 *}
unit paslib;

interface

uses
    Windows,
    SysUtils,
    Classes,
    comctrls;


function spLoCase(const ch: char): char;
function spUpCase(const ch: char): char;

function spCharFirst(const S: string): char;
function spCharLast(const S: string): char;
function spSlashPath(const S: string): string;
function spFileExists(const FileName: string): Boolean;
function spDetectPath(const S: string; const bFailCreate: Boolean = True): Boolean;
function spStrEval(const Express: string; const dFailResult: double = 0): double;

function spStrComp(const S1, S2: string): Longint;
function spStrIComp(const S1, S2: string): Longint;
function spStrEqual(const S1, S2: string; const bIgnoreCase: Boolean = True): Boolean;

function spCopyInsideTokens(const S: string; const Token1, Token2: char): string;
function spTrimInternalWhiteSpace(const S: string): string;
function spTrimInternalNum(const S: string): string;

function spSignToInt(const ch: char): Longint;

type
    TOrdNumRelations = (odUnknown, odEqual, odPrev, odNext, odParent, odChild,
        odSameLevel, odParentLevel, odChildLevel);

    PLayerItem = ^TLayerItem;
    TLayerItem = record
        LayerOrd: string;
        LayerName: string;
        LayerParent: PLayerItem;
        LayerSub: TList;
    end;

function spGetOrdNumLevel(const S: string): Longint;
function spGetOrdNumLastPart(const S: string): string;
function spGetParentOrdNum(const S: string): string;
function spGetChildOrdNum(const S: string): string;
function spGetNextOrdNum(const S: string): string;
function spGetPrevOrdNum(const S: string): string;
function spGetOrdNumRelations(const S1, S2: string): TOrdNumRelations;
procedure spCreateOrdTree(Strings: TStrings; AList: TList);
procedure spAddOrdListToTree(AList: TList; ATree: TTreeView; const nImageIndex: Longint = -1);

function spCharSpan(const S: string; const ch: string): Longint;
function spStrName(const s: string; const ch: char = '='): string;
function spStrValue(const s: string; const ch: char = '='): string;

function spIsAlpha(const ch: char): Boolean;
function spIsDigit(const ch: char): Boolean;
function spIsOdd(const N: Longint): Boolean;
function spIsZero(V: double): Boolean;


function spStrToInt(const S: string): Longint;
function spStrToIntEx(const S: string; var EndStr: string): Longint;
function spStrToFloat(const S: string): double;
function spStrToFloatEx(const S: string; var EndStr: string): double;

function spReverseSign(const ch: char): char;

function spFormatFloat(V: double; const nDec: Word = 2): double;
function spFormatFloatToSz(V: double; nDec: Word; const bAllowNull: Boolean = False): string;

function spFindToken(const S: string; var szMatch: string; Pattern: array of string): Longint;

function spIsSectionStr(const S: string): Boolean;

procedure spExtractSymbolText(S: string; Symbol: Char; var Args: array of string;
    nDouble: Integer; const bIngoreCase: Boolean = True);

procedure ArrayToStrings(const Arr: array of string; Strings: TStrings);

function spMakeSectionStr(const S: string): string;

function spGetQNumSectNo(const S: string): string;

function ExtractNum(const ANum: string): string;

procedure spExtractTextByToken(const S: string; const charset: string;
    Strings: Tstrings; const bIncludeToken: Boolean = True);

function spTrimInTernalnullityChar(const S: string): string;

procedure spGetReplaceData(const S: string; var A, B: string);
function spReplaceItemName(var S: string; const A, B: string): Boolean;
function IsReplaceKey(const S: string): Boolean;
function SpReplaceItemNamex(var S: string; const A: string): boolean;
function SpPbNameReplace(var s: string; const A, B: string): Boolean;
function GetBData(const V: string): string;

procedure TrimCnvHisThV(var cnvhis: string; const AText: string; const AoldText: string);
procedure spDeleteCnvhis(var cnvhis: string; const AText: string);
procedure spTrimCnvHis(var cnvHis: string; const AText: string);

function IsJssFh(const V:char): boolean;
function IsJssDate(const V:char ): Boolean;
implementation

uses
    FileCtrl,
    Evals,
    gclib;

function spLoCase(const ch: char): char;
asm
{ ->    AL      Character       }
{ <-    AL      Result          }

        CMP     AL,'A'
        JB      @@exit
        CMP     AL,'Z'
        JA      @@exit
        ADD     AL,'a' - 'A'
@@exit:
end;

function spUpCase(const ch: char): char;
asm
{ ->    AL      Character       }
{ <-    AL      Result          }

        CMP     AL,'a'
        JB      @@exit
        CMP     AL,'z'
        JA      @@exit
        SUB     AL,'a' - 'A'
@@exit:
end;

function spCharFirst(const S: string): char;
begin
    Result := #0;
    if S <> '' then Result := S[1];
end;

function spCharLast(const S: string): char;
begin
    Result := #0;
    if S <> '' then Result := S[Length(S)];
end;

function spSlashPath(const S: string): string;
begin
    Result := S;
    if spCharLast(S) <> '\' then
        Result := Result + '\';
end;

function spFileExists(const FileName: string): Boolean;
begin
    Result := False;
    if FileExists(FileName) then
        Result := True;
end;

function spDetectPath(const S: string; const bFailCreate: Boolean = True): Boolean;
begin
    Result := DirectoryExists(S);
    if not Result and bFailCreate then
        Result := ForceDirectories(S);
end;


function spStrEval(const Express: string; const dFailResult: double = 0): double;
begin
    Result := Evals.StrEval(Express, dFailResult);
end;

function spStrComp(const S1, S2: string): Longint;
begin
    Result := StrComp(PChar(S1), PChar(S2));
end;

function spStrIComp(const S1, S2: string): Longint;
begin
    Result := StrIComp(PChar(S1), PChar(S2));
end;

function spStrEqual(const S1, S2: string; const bIgnoreCase: Boolean): Boolean;
begin
    if bIgnoreCase then
        Result := StrIComp(PChar(S1), PChar(S2)) = 0 else
        Result := StrComp(PChar(S1), PChar(S2)) = 0;
end;

function spCopyInsideTokens(const S: string; const Token1, Token2: char): string;
var
    nPos            : Longint;
begin
    Result := '';
    nPos := Pos(Token1, S);
    if nPos > 0 then
    begin
        Result := Copy(S, nPos + Length(Token1), MaxInt);

        nPos := Pos(Token2, Result);
        if nPos > 0 then
            Result := Copy(Result, 1, nPos - 1) else
            Result := '';
    end;
end;

function spTrimInternalWhiteSpace(const S: string): string;
var
    I               : Longint;
begin
    Result := '';
    for I := 1 to Length(S) do
        if S[I] <> #32 then Result := Result + S[I];
end;

function spTrimInternalNum(const S: string): string;
var
    I               : Longint;
begin
    Result := '';
    for I := 1 to Length(S) do
        if (S[I] <> #32) and (S[I] <> '-') then
            Result := Result + S[I];
end;

function spGetOrdNumLevel(const S: string): Longint;
var
    I               : Longint;
begin
    Result := 0;
    for I := 1 to Length(S) do
        if (S[I] = '.') then Inc(Result);
end;

function spGetOrdNumLastPart(const S: string): string;
var
    I, LastPos      : Longint;
begin
    Result := '';
    LastPos := 0;
    for I := 1 to Length(S) do
        if (S[I] = '.') then LastPos := I;

    if LastPos > 0 then
        Result := Copy(S, LastPos + 1, MaxInt);
end;

function spGetParentOrdNum(const S: string): string;
var
    I, LastPos      : Longint;
begin
    Result := '';
    LastPos := 0;
    for I := 1 to Length(S) do
        if (S[I] = '.') then LastPos := I;

    if LastPos > 0 then
        Result := Copy(S, 1, LastPos - 1);
end;

function spGetChildOrdNum(const S: string): string;
begin
    Result := S + '.1';
end;

function spGetNextOrdNum(const S: string): string;
var
    I, LastPos      : Longint;
    ParentPart      : string;
begin
    Result := '';
    LastPos := 0;
    for I := 1 to Length(S) do
        if (S[I] = '.') then LastPos := I;

    if LastPos > 0 then
    begin
        ParentPart := Copy(S, 1, LastPos);
        Result := Copy(S, LastPos + 1, MaxInt);

        Result := ParentPart + IntToStr(StrToInt(Result) + 1);
    end
    else Result := IntToStr(StrToInt(S) + 1);
end;

function spGetPrevOrdNum(const S: string): string;
var
    I, LastPos      : Longint;
    ParentPart      : string;
begin
    Result := '';
    LastPos := 0;
    for I := 1 to Length(S) do
        if (S[I] = '.') then LastPos := I;

    if LastPos > 0 then
    begin
        ParentPart := Copy(S, 1, LastPos);
        Result := Copy(S, LastPos + 1, MaxInt);

        Result := ParentPart + IntToStr(StrToInt(Result) - 1);
    end
    else Result := IntToStr(StrToInt(S) - 1);
end;

{* 判断序号相互关系：
 *
 *      1、相等
 *      2、子结点
 *      3、父结点
 *      4、下一个结点
 *      5、上一个结点
 *      6、同级结点
 *      7、父级结点 ---------- 这是判断关键
 *
 *              a.      1.1.1 - 1.2
 *              b.      1.1.1.1 - 1.2
 *
 *      因此必须计算距离，以定位到是哪一层父
 *}

function spGetOrdNumRelations(const S1, S2: string): TOrdNumRelations;
var
    nLevel1, nLevel2: Longint;
begin
    if S1 = S2 then Result := odEqual
    else if Pos(S1, S2) > 0 then Result := odParent
    else if Pos(S2, S1) > 0 then Result := odChild
    else if spGetPrevOrdNum(S1) = S2 then Result := odNext
    else if spGetPrevOrdNum(S2) = S1 then Result := odPrev
    else begin
        nLevel1 := spGetOrdNumLevel(S1);
        nLevel2 := spGetOrdNumLevel(S2);

        //这儿有可能是误判断，但在这儿假设编号是有序排列
        if nLevel1 < nLevel2 then Result := odParentLevel
        else if nLevel1 > nLevel2 then Result := odChildLevel
        else Result := odSameLevel;
    end;
end;


procedure spCreateOrdTree(Strings: TStrings; AList: TList);
var
    LastNode        : PLayerItem;
    CurrNode        : PLayerItem;
    I               : Longint;
    Relate          : TOrdNumRelations;
    nLevel1,
        nLevel2     : Longint;