Changeset 541 for cprs/branches/tmg-cprs/CPRS-Lib/ORFn.pas

Timestamp:

Aug 12, 2009, 7:14:16 PM (15 years ago)

Author:

Kevin Toppenberg

Message:

TMG Ver 1.1 Added HTML Support, better demographics editing

File:

• cprs/branches/tmg-cprs/CPRS-Lib/ORFn.pas (modified) (5 diffs)

cprs/branches/tmg-cprs/CPRS-Lib/ORFn.pas

@@ -54 +54 @@
 procedure MixedCaseList(AList: TStrings);
 procedure MixedCaseByPiece(AList: TStrings; ADelim: Char; PieceNum: Integer);
-function Piece(const S: string; Delim: char; PieceNum: Integer): string;
-function Pieces(const S: string; Delim: char; FirstNum, LastNum: Integer): string;
+function Piece(const S: string; Delim: char; PieceNum: Integer): string;  overload;     //kt 8/09 added 'overload'
+function Piece(const S: string; Delim: string; PieceNum: Integer): string; overload;    //kt 8/09
+function PieceNCS(const S: string; Delim: string; PieceNum: Integer): string; overload; //kt 8/09
+function Pieces(const S: string; Delim: char; FirstNum, LastNum: Integer): string; overload;     //kt 8/09 added 'overload'
+function Pieces(const S: string; Delim: string; PieceStart,PieceEnd: Integer): string; overload; //kt 8/09 added
+function PiecesNCS(const S: string; Delim: string; PieceStart,PieceEnd: Integer): string;        //kt 8/09 added
 function ComparePieces(P1, P2: string; Pieces: array of integer; Delim:
                        char = '^'; CaseInsensitive: boolean = FALSE): integer;
@@ -120 +124 @@
 
 uses
+  StrUtils,  //kt 8/09
   ORCtrls, Grids, Chart, CheckLst;
 
@@ -604 +609 @@
 end;
 
-function Piece(const S: string; Delim: char; PieceNum: Integer): string;
+function Piece(const S: string; Delim: char; PieceNum: Integer): string; overload; //kt 8/09 added 'overload;'
 { returns the Nth piece (PieceNum) of a string delimited by Delim }
 var
@@ -623 +628 @@
 end;
 
+function PieceNCS(const S: string; Delim: string; PieceNum: Integer): string; overload;
+//kt 8/09  Name means Piece-Not-Case-Sensitive, meaning match for Delim is not case sensitive.
+//kt 8/09 Added entire function
+var tempS : string;
+begin
+  tempS := AnsiReplaceText(S,Delim,UpperCase(Delim));
+  Result := Piece(tempS,UpperCase(Delim),PieceNum);
+end;
+
+function Piece(const S: string; Delim: string; PieceNum: Integer): string; overload;
+//kt 8/09 Added entire function
+var Remainder : String;
+    PieceLen,p : integer;
+begin
+  Remainder := S;
+  Result := '';
+  PieceLen := Length(Delim);
+  while (PieceNum > 0) and (Length(Remainder) > 0) do begin
+    p := Pos(Delim,Remainder);
+    if p=0 then p := length(Remainder)+1;
+    Result := MidStr(Remainder,1,p-1);
+    Remainder := MidStr(Remainder,p+PieceLen,9999);
+    Dec(PieceNum);
+  end;
+end;
+
+function Pieces(const S: string; Delim: string; PieceStart,PieceEnd: Integer): string; overload;
+//kt 8/09 Added entire function
+var Remainder : String;
+    PieceNum : integer;
+    PieceLen,p : integer;
+begin
+  Remainder := S;
+  Result := '';
+  PieceLen := Length(Delim);
+  PieceNum := PieceStart;
+  while (PieceNum > 1) and (Length(Remainder) > 0) do begin
+    p := Pos(Delim,Remainder);
+    if p=0 then p := length(Remainder)+1;
+    Result := MidStr(Remainder,1,p-1);
+    Remainder := MidStr(Remainder,p+PieceLen,9999);
+    Dec(PieceNum);
+  end;
+  PieceNum := PieceEnd-PieceStart+1;
+  Result := '';
+  while (PieceNum > 0) and (Length(Remainder) > 0) do begin
+    p := Pos(Delim,Remainder);
+    if p=0 then p := length(Remainder)+1;
+    if Result <> '' then Result := Result + Delim;
+    Result := Result + MidStr(Remainder,1,p-1);
+    Remainder := MidStr(Remainder,p+PieceLen,9999);
+    Dec(PieceNum);
+  end;
+end;
+
 function Pieces(const S: string; Delim: char; FirstNum, LastNum: Integer): string;
 { returns several contiguous pieces }
@@ -631 +691 @@
   for PieceNum := FirstNum to LastNum do Result := Result + Piece(S, Delim, PieceNum) + Delim;
   if Length(Result) > 0 then Delete(Result, Length(Result), 1);
+end;
+
+function PiecesNCS(const S: string; Delim: string; PieceStart,PieceEnd: Integer): string;
+//kt 8/09  Name means Pieces-Not-Case-Sensitive, meaning match for Delim is not case sensitive.
+//kt 8/09 Added entire function
+var tempS : string;
+begin
+  tempS := AnsiReplaceText(S,Delim,UpperCase(Delim));
+  Result := Pieces(tempS,UpperCase(Delim),PieceStart,PieceEnd);
 end;