From: bobs@dragons.nest.nl (Bob Swart)
unit TrimStr; {$B-} { File: TrimStr Author: Bob Swart [100434,2072] Purpose: routines for removing leading/trailing spaces from strings, and to take parts of left/right of string (a la Basic). Version: 2.0 LTrim() - Remove all spaces from the left side of a string RTrim() - Remove all spaces from the right side of a string Trim() - Remove all extraneous spaces from a string RightStr() - Take a certain portion of the right side of a string LeftStr() - Take a certain portion of the left side of a string MidStr() - Take the middle portion of a string } interface Const Space = #$20; function LTrim(Const Str: String): String; function RTrim(Str: String): String; function Trim(Str: String): String; function RightStr(Const Str: String; Size: Word): String; function LeftStr(Const Str: String; Size: Word): String; function MidStr(Const Str: String; Size: Word): String; implementation function LTrim(Const Str: String): String; var len: Byte absolute Str; i: Integer; begin i := 1; while (i <= len) and (Str[i] = Space) do Inc(i); LTrim := Copy(Str,i,len) end {LTrim}; function RTrim(Str: String): String; var len: Byte absolute Str; begin while (Str[len] = Space) do Dec(len); RTrim := Str end {RTrim}; function Trim(Str: String): String; begin Trim := LTrim(RTrim(Str)) end {Trim}; function RightStr(Const Str: String; Size: Word): String; var len: Byte absolute Str; begin if Size > len then Size := len; RightStr := Copy(Str,len-Size+1,Size) end {RightStr}; function LeftStr(Const Str: String; Size: Word): String; begin LeftStr := Copy(Str,1,Size) end {LeftStr}; function MidStr(Const Str: String; Size: Word): String; var len: Byte absolute Str; begin if Size > len then Size := len; MidStr := Copy(Str,((len - Size) div 2)+1,Size) end {MidStr}; end.
From: jbui@scd.hp.com (Joseph Bui)
For Mid$, use Copy(S: string; start, length: byte): string;Here are some functions I wrote that come in handy for me. Way down at the bottom is a trim() function that you can modify into TrimRight$ and TrimLeft$. Also, they all take pascal style strings, but you can modify them to easily null terminated.
const BlackSpace = [#33..#126]; { squish() returns a string with all whitespace not inside single quotes deleted. } function squish(const Search: string): string; var Index: byte; InString: boolean; begin InString:=False; Result:=''; for Index:=1 to Length(Search) do begin if InString or (Search[Index] in BlackSpace) then AppendStr(Result, Search[Index]); InString:=((Search[Index] = '''') and (Search[Index - 1] <> '\')) xor InString; end; end; { before() returns everything before the first occurance of Find in Search. If Find does not occur in Search, Search is returned. } function before(const Search, Find: string): string; var index: byte; begin index:=Pos(Find, Search); if index = 0 then Result:=Search else Result:=Copy(Search, 1, index - 1); end; { after() returns everything after the first occurance of Find in Search. If Find does not occur in Search, a null string is returned. } function after(const Search, Find: string): string; var index: byte; begin index:=Pos(Find, Search); if index = 0 then Result:='' else Result:=Copy(Search, index + Length(Find), 255); end; { RPos() returns the index of the first character of the last occurance of Find in Search. Returns 0 if Find does not occur in Search. Like Pos() but searches in reverse. } function RPos(const Find, Search: string): byte; var FindPtr, SearchPtr, TempPtr: PChar; begin FindPtr:=StrAlloc(Length(Find)+1); SearchPtr:=StrAlloc(Length(Search)+1); StrPCopy(FindPtr,Find); StrPCopy(SearchPtr,Search); Result:=0; repeat TempPtr:=StrRScan(SearchPtr, FindPtr^); if TempPtr <> nil then if (StrLComp(TempPtr, FindPtr, Length(Find)) = 0) then begin Result:=TempPtr - SearchPtr + 1; TempPtr:=nil; end else TempPtr:=#0; until TempPtr = nil; end; { inside() returns the string between the most inside nested Front ... Back pair. } function inside(const Search, Front, Back: string): string; var Index, Len: byte; begin Index:=RPos(Front, before(Search, Back)); Len:=Pos(Back, Search); if (Index > 0) and (Len > 0) then Result:=Copy(Search, Index + 1, Len - (Index + 1)) else Result:=''; end; { leftside() returns what is to the left of inside() or Search. } function leftside(const Search, Front, Back: string): string; begin Result:=before(Search, Front + inside(Search, Front, Back) + Back); end; { rightside() returns what is to the right of inside() or Null. } function rightside(const Search, Front, Back: string): string; begin Result:=after(Search, Front + inside(Search, Front, Back) + Back); end; { trim() returns a string with all right and left whitespace removed. } function trim(const Search: string): string; var Index: byte; begin Index:=1; while (Index <= Length(Search)) and not (Search[Index] in BlackSpace) do Index:=Index + 1; Result:=Copy(Search, Index, 255); Index:=Length(Result); while (Index > 0) and not (Result[Index] in BlackSpace) do Index:=Index - 1; Result:=Copy(Result, 1, Index); end;
From: stidolph@magnet.com (David Stidolph)
There are many times when you need to compare two strings, but want to use wild cards in the match - all last names that begin with 'St', etc. The following is a piece of code I got from Sean Stanley in Tallahassee Florida in C. I translated it into Delphi an am uploading it here for all to use. I have not tested it extensivly, but the original function has been tested quite thoughly.I would love feedback on this routine - or peoples changes to it. I want to forward them to Sean to get him to release more tidbits like this.
{ This function takes two strings and compares them. The first string can be anything, but should not contain pattern characters (* or ?). The pattern string can have as many of these pattern characters as you want. For example: MatchStrings('David Stidolph','*St*') would return True. Orignal code by Sean Stanley in C Rewritten in Delphi by David Stidolph } function MatchStrings(source, pattern: String): Boolean; var pSource: Array [0..255] of Char; pPattern: Array [0..255] of Char; function MatchPattern(element, pattern: PChar): Boolean; function IsPatternWild(pattern: PChar): Boolean; var t: Integer; begin Result := StrScan(pattern,'*') <> nil; if not Result then Result := StrScan(pattern,'?') <> nil; end; begin if 0 = StrComp(pattern,'*') then Result := True else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then Result := False else if element^ = Chr(0) then Result := True else begin case pattern^ of '*': if MatchPattern(element,@pattern[1]) then Result := True else Result := MatchPattern(@element[1],pattern); '?': Result := MatchPattern(@element[1],@pattern[1]); else if element^ = pattern^ then Result := MatchPattern(@element[1],@pattern[1]) else Result := False; end; end; end; begin StrPCopy(pSource,source); StrPCopy(pPattern,pattern); Result := MatchPattern(pSource,pPattern); end;
Thomas Scheffczyk <SCHEFFCZYK@islay.verwaltung.uni-mainz.de>
I don't know if this will help you, but the following (simple) functions helped me handling substrings. Perhaps you can use them to seperate the text for each field (for i := 1 to NumToken do ...) and store it seperatly in the database-fields.
function GetToken(aString, SepChar: String; TokenNum: Byte):String; { parameters: aString : the complete string SepChar : a single character used as separator between the substrings TokenNum: the number of the substring you want result : the substring or an empty string if the are less then 'TokenNum' substrings } var Token : String; StrLen : Byte; TNum : Byte; TEnd : Byte; begin StrLen := Length(aString); TNum := 1; TEnd := StrLen; while ((TNum <= TokenNum) and (TEnd <> 0)) do begin TEnd := Pos(SepChar,aString); if TEnd <> 0 then begin Token := Copy(aString,1,TEnd-1); Delete(aString,1,TEnd); Inc(TNum); end else begin Token := aString; end; end; if TNum >= TokenNum then begin GetToken1 := Token; end else begin GetToken1 := ''; end; end; function NumToken(aString, SepChar: String):Byte; { parameters: aString : the complete string SepChar : a single character used as separator between the substrings result : the number of substrings } var RChar : Char; StrLen : Byte; TNum : Byte; TEnd : Byte; begin if SepChar = '#' then begin RChar := '*' end else begin RChar := '#' end; StrLen := Length(aString); TNum := 0; TEnd := StrLen; while TEnd <> 0 do begin Inc(TNum); TEnd := Pos(SepChar,aString); if TEnd <> 0 then begin aString[TEnd] := RChar; end; end; NumToken1 := TNum; end;
function CopyColumn( const s_string: string; c_fence: char; i_index: integer ): string; var i, i_left: integer; begin result := EmptyStr; if i_index = 0 then begin exit; end; i_left := 0; for i := 1 to Length( s_string ) do begin if s_string[ i ] = c_fence then begin Dec( i_index ); if i_index = 0 then begin result := Copy( s_string, i_left + 1, i - i_left - 1 ); exit; end else begin i_left := i; end; end; end; Dec( i_index ); if i_index = 0 then begin result := Copy( s_string, i_left + 1, Length( s_string )); end; end;
From: michael@quinto.ruhr.de (Michael Bialas)
Does anyone know a fast algorithm that replaces all occurences of any substring sub1 to any string sub2 in any string str.This should do the job:
function ReplaceSub(str, sub1, sub2: String): String; var aPos: Integer; rslt: String; begin aPos := Pos(sub1, str); rslt := ''; while (aPos <> 0) do begin rslt := rslt + Copy(str, 1, aPos - 1) + sub2; Delete(str, 1, aPos + Length(sub1)); aPos := Pos(sub1, str); end; Result := rslt + str; end;
Erik Sperling Johansen <erik@info-pro.no>
function LowCase(ch : CHAR) : CHAR; begin case ch of 'A'..'Z' : LowCase := CHR (ORD(ch)+31); else LowCase := ch; end; end; function Proper (source, separators : STRING) : STRING; var LastWasSeparator : BOOLEAN; ndx : INTEGER; begin LastWasSeparator := TRUE; ndx := 1; while (ndx<=Length(source)) do begin if LastWasSeparator then source[ndx] := UpCase(source[ndx]) else source[ndx] := LowCase(source[ndx]); LastWasSeparator := Pos(source[ndx], separators)>0; inc(ndx); end; Result := source; end;
From: "Cleon T. Bailey" <baileyct@ionet.net>
Function TfrmLoadProtocolTable.ToMixCase(InString: String): String; Var I: Integer; Begin Result := LowerCase(InString); Result[1] := UpCase(Result[1]); For I := 1 To Length(InString) - 1 Do Begin If (Result[I] = ' ') Or (Result[I] = '''') Or (Result[I] = '"') Or (Result[I] = '-') Or (Result[I] = '.') Or (Result[I] = '(') Then Result[I + 1] := UpCase(Result[I + 1]); End; End;
From: "Paul Motyer" <paulm@linuxserver.pccity.com.au>
Both Tim Stannard's and Cleon T. Bailey's functions will bomb in D2 if sent an empty string (where accessing InString[1] causes an access violation, the second attempt will do the same if the last character is in the set.try this instead:
function proper(s:string):string; var t:string; i:integer; newWord:boolean; begin if s='' then exit; s:=lowercase(s); t:=uppercase(s); newWord:=true; for i:=1 to length(s) do begin if newWord and (s[i] in ['a'..'z']) then begin s[i]:=t[i]; newWord:=false; continue; end; if s[i] in ['a'..'z',''''] then continue; newWord:=true; end; result:=s; end;
{ This code came from Lloyd's help file! }
Soundex function--determines whether two words sound alike. Written after reading an article in PC Magazine about the Soundex algorithm. Pass the function a string. It returns a Soundex value string. This value can be saved in a database or compared to another Soundex value. If two words have the same Soundex value, then they sound alike (more or less).Note that the Soundex algorithm ignores the first letter of a word. Thus, "won" and "one" will have different Soundex values, but "Won" and "Wunn" will have the same values.
Soundex is especially useful in databases when one does not know how to spell a last name.
Function Soundex(OriginalWord: string): string; var Tempstring1, Tempstring2: string; Count: integer; begin Tempstring1 := ''; Tempstring2 := ''; OriginalWord := Uppercase(OriginalWord); {Make original word uppercase} Appendstr(Tempstring1, OriginalWord[1]); {Use the first letter of the word} for Count := 2 to length(OriginalWord) do {Assign a numeric value to each letter, except the first} case OriginalWord[Count] of 'B','F','P','V': Appendstr(Tempstring1, '1'); 'C','G','J','K','Q','S','X','Z': Appendstr(Tempstring1, '2'); 'D','T': Appendstr(Tempstring1, '3'); 'L': Appendstr(Tempstring1, '4'); 'M','N': Appendstr(Tempstring1, '5'); 'R': Appendstr(Tempstring1, '6'); {All other letters, punctuation and numbers are ignored} end; Appendstr(Tempstring2, OriginalWord[1]); {Go through the result removing any consecutive duplicate numeric values.} for Count:=2 to length(Tempstring1) do if Tempstring1[Count-1]<>Tempstring1[Count] then Appendstr(Tempstring2,Tempstring1[Count]); Soundex:=Tempstring2; {This is the soundex value} end;
Function SoundAlike(Word1, Word2: string): boolean; begin if (Word1 = '') and (Word2 = '') then result := True else if (Word1 = '') or (Word2 = '') then result := False else if (Soundex(Word1) = Soundex(Word2)) then result := True else result := False; end;
vk_LButton = $01; vk_RButton = $02; vk_Cancel = $03; vk_MButton = $04; { NOT contiguous with L & RBUTTON } vk_Back = $08; vk_Tab = $09; vk_Clear = $0C; vk_Return = $0D; vk_Shift = $10; vk_Control = $11; vk_Menu = $12; vk_Pause = $13; vk_Capital = $14; vk_Escape = $1B; vk_Space = $20; vk_Prior = $21; vk_Next = $22; vk_End = $23; vk_Home = $24; vk_Left = $25; vk_Up = $26; vk_Right = $27; vk_Down = $28; vk_Select = $29; vk_Print = $2A; vk_Execute = $2B; vk_SnapShot = $2C; { vk_Copy = $2C not used by keyboards } vk_Insert = $2D; vk_Delete = $2E; vk_Help = $2F; { vk_A thru vk_Z are the same as their ASCII equivalents: 'A' thru 'Z' } { vk_0 thru vk_9 are the same as their ASCII equivalents: '0' thru '9' } vk_NumPad0 = $60; vk_NumPad1 = $61; vk_NumPad2 = $62; vk_NumPad3 = $63; vk_NumPad4 = $64; vk_NumPad5 = $65; vk_NumPad6 = $66; vk_NumPad7 = $67; vk_NumPad8 = $68; vk_NumPad9 = $69; vk_Multiply = $6A; vk_Add = $6B; vk_Separator = $6C; vk_Subtract = $6D; vk_Decimal = $6E; vk_Divide = $6F; vk_F1 = $70; vk_F2 = $71; vk_F3 = $72; vk_F4 = $73; vk_F5 = $74; vk_F6 = $75; vk_F7 = $76; vk_F8 = $77; vk_F9 = $78; vk_F10 = $79; vk_F11 = $7A; vk_F12 = $7B; vk_F13 = $7C; vk_F14 = $7D; vk_F15 = $7E; vk_F16 = $7F; vk_F17 = $80; vk_F18 = $81; vk_F19 = $82; vk_F20 = $83; vk_F21 = $84; vk_F22 = $85; vk_F23 = $86; vk_F24 = $87; vk_NumLock = $90; vk_Scroll = $91;
{ This code came from Lloyd's help file! }
Function HundredAtATime(TheAmount:Integer):String; var TheResult : String; Begin TheResult := ''; TheAmount := Abs(TheAmount); While TheAmount > 0 do Begin If TheAmount >= 900 Then Begin TheResult := TheResult + 'Nine hundred '; TheAmount := TheAmount - 900; End; If TheAmount >= 800 Then Begin TheResult := TheResult + 'Eight hundred '; TheAmount := TheAmount - 800; End; If TheAmount >= 700 Then Begin TheResult := TheResult + 'Seven hundred '; TheAmount := TheAmount - 700; End; If TheAmount >= 600 Then Begin TheResult := TheResult + 'Six hundred '; TheAmount := TheAmount - 600; End; If TheAmount >= 500 Then Begin TheResult := TheResult + 'Five hundred '; TheAmount := TheAmount - 500; End; If TheAmount >= 400 Then Begin TheResult := TheResult + 'Four hundred '; TheAmount := TheAmount - 400; End; If TheAmount >= 300 Then Begin TheResult := TheResult + 'Three hundred '; TheAmount := TheAmount - 300; End; If TheAmount >= 200 Then Begin TheResult := TheResult + 'Two hundred '; TheAmount := TheAmount - 200; End; If TheAmount >= 100 Then Begin TheResult := TheResult + 'One hundred '; TheAmount := TheAmount - 100; End; If TheAmount >= 90 Then Begin TheResult := TheResult + 'Ninety '; TheAmount := TheAmount - 90; End; If TheAmount >= 80 Then Begin TheResult := TheResult + 'Eighty '; TheAmount := TheAmount - 80; End; If TheAmount >= 70 Then Begin TheResult := TheResult + 'Seventy '; TheAmount := TheAmount - 70; End; If TheAmount >= 60 Then Begin TheResult := TheResult + 'Sixty '; TheAmount := TheAmount - 60; End; If TheAmount >= 50 Then Begin TheResult := TheResult + 'Fifty '; TheAmount := TheAmount - 50; End; If TheAmount >= 40 Then Begin TheResult := TheResult + 'Fourty '; TheAmount := TheAmount - 40; End; If TheAmount >= 30 Then Begin TheResult := TheResult + 'Thirty '; TheAmount := TheAmount - 30; End; If TheAmount >= 20 Then Begin TheResult := TheResult + 'Twenty '; TheAmount := TheAmount - 20; End; If TheAmount >= 19 Then Begin TheResult := TheResult + 'Nineteen '; TheAmount := TheAmount - 19; End; If TheAmount >= 18 Then Begin TheResult := TheResult + 'Eighteen '; TheAmount := TheAmount - 18; End; If TheAmount >= 17 Then Begin TheResult := TheResult + 'Seventeen '; TheAmount := TheAmount - 17; End; If TheAmount >= 16 Then Begin TheResult := TheResult + 'Sixteen '; TheAmount := TheAmount - 16; End; If TheAmount >= 15 Then Begin TheResult := TheResult + 'Fifteen '; TheAmount := TheAmount - 15; End; If TheAmount >= 14 Then Begin TheResult := TheResult + 'Fourteen '; TheAmount := TheAmount - 14; End; If TheAmount >= 13 Then Begin TheResult := TheResult + 'Thirteen '; TheAmount := TheAmount - 13; End; If TheAmount >= 12 Then Begin TheResult := TheResult + 'Twelve '; TheAmount := TheAmount - 12; End; If TheAmount >= 11 Then Begin TheResult := TheResult + 'Eleven '; TheAmount := TheAmount - 11; End; If TheAmount >= 10 Then Begin TheResult := TheResult + 'Ten '; TheAmount := TheAmount - 10; End; If TheAmount >= 9 Then Begin TheResult := TheResult + 'Nine '; TheAmount := TheAmount - 9; End; If TheAmount >= 8 Then Begin TheResult := TheResult + 'Eight '; TheAmount := TheAmount - 8; End; If TheAmount >= 7 Then Begin TheResult := TheResult + 'Seven '; TheAmount := TheAmount - 7; End; If TheAmount >= 6 Then Begin TheResult := TheResult + 'Six '; TheAmount := TheAmount - 6; End; If TheAmount >= 5 Then Begin TheResult := TheResult + 'Five '; TheAmount := TheAmount - 5; End; If TheAmount >= 4 Then Begin TheResult := TheResult + 'Four '; TheAmount := TheAmount - 4; End; If TheAmount >= 3 Then Begin TheResult := TheResult + 'Three '; TheAmount := TheAmount - 3; End; If TheAmount >= 2 Then Begin TheResult := TheResult + 'Two '; TheAmount := TheAmount - 2; End; If TheAmount >= 1 Then Begin TheResult := TheResult + 'One '; TheAmount := TheAmount - 1; End; End; HundredAtATime := TheResult; End; Function Real2CheckAmount(TheAmount:Real):String; Var IntVal : LongInt; TmpVal : Integer; TmpStr, RetVal : String; begin TheAmount := Abs(TheAmount); { cents} TmpVal := Round(Frac(TheAmount) * 100); IntVal := Trunc(TheAmount); TmpStr := HundredAtATime(TmpVal); If TmpStr = '' Then TmpStr := 'Zero '; RetVal := TmpStr + 'cents'; If IntVal > 0 Then RetVal := 'dollars and ' + RetVal; { hundreds } TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000); IntVal := Trunc((IntVal * 1.0) / 1000.0); TmpStr := HundredAtATime(TmpVal); RetVal := TmpStr + RetVal; { thousands } TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000); IntVal := Trunc((IntVal * 1.0) / 1000.0); TmpStr := HundredAtATime(TmpVal); If TmpStr <> '' Then RetVal := TmpStr + 'Thousand ' + RetVal; { millions } TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000); IntVal := Trunc((IntVal * 1.0) / 1000.0); TmpStr := HundredAtATime(TmpVal); If TmpStr <> '' Then RetVal := TmpStr + 'Million ' + RetVal; { billions } TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000); IntVal := Trunc((IntVal * 1.0) / 1000.0); TmpStr := HundredAtATime(TmpVal); If TmpStr <> '' Then RetVal := TmpStr + 'Billion ' + RetVal; Real2CheckAmount := RetVal; end;
Hmmm... What about this.... and some nice recursion too!!!..:)))
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) num: TEdit; spell: TEdit; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } function trans9(num: integer): string; function trans19(num: integer): string; function trans99(num: integer): string; function IntToSpell(num: integer): string; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} function TForm1.IntToSpell(num: integer): string; var spell: string; hspell: string; hundred: string; thousand: string; tthousand: string; hthousand: string; million: string; begin if num ≶ 10 then spell := trans9(num); {endif} if (num < 20) and (num > 10) then spell := trans19(num); {endif} if (((num < 100) and (num > 19)) or (num = 10)) then begin hspell := copy(IntToStr(num),1,1) + '0'; spell := trans99(StrToInt(hspell)); hspell := copy(IntToStr(num),2,1); spell := spell + ' ' + IntToSpell(StrToInt(hspell)); end; if (num < 1000) and (num > 100) then begin hspell := copy(IntToStr(num),1,1); hundred := IntToSpell(StrToInt(hspell)); hspell := copy(IntToStr(num),2,2); hundred := hundred + ' hundred and ' + IntToSpell(StrToInt(hspell)); spell := hundred; end; if (num < 10000) and (num > 1000) then begin hspell := copy(IntToStr(num),1,1); thousand := IntToSpell(StrToInt(hspell)); hspell := copy(IntToStr(num),2,3); thousand := thousand + ' thousand ' + IntToSpell(StrToInt(hspell)); spell := thousand; end; if (num < 100000) and (num > 10000) then begin hspell := copy(IntToStr(num),1,2); tthousand := IntToSpell(StrToInt(hspell)); hspell := copy(IntToStr(num),3,3); tthousand := tthousand + ' thousand ' + IntToSpell(StrToInt(hspell)); spell := tthousand; end; if (num < 1000000) and (num > 100000) then begin hspell := copy(IntToStr(num),1,3); hthousand := IntToSpell(StrToInt(hspell)); hspell := copy(IntToStr(num),4,3); hthousand := hthousand + ' thousand and ' + IntToSpell(StrToInt(hspell)); spell := hthousand; end; if (num < 10000000) and (num > 1000000) then begin hspell := copy(IntToStr(num),1,1); million := IntToSpell(StrToInt(hspell)); hspell := copy(IntToStr(num),2,6); million := million + ' million and ' + IntToSpell(StrToInt(hspell)); spell := million; end; IntToSpell := spell; end; function TForm1.trans99(num: integer): string; var spell: string; begin case num of 10 : spell := 'ten'; 20 : spell := 'twenty'; 30 : spell := 'thirty'; 40 : spell := 'fourty'; 50 : spell := 'fifty'; 60 : spell := 'sixty'; 70 : spell := 'seventy'; 80 : spell := 'eighty'; 90 : spell := 'ninty'; end; trans99 := spell; end; function TForm1.trans19(num: integer): string; var spell: string; begin case num of 11 : spell := 'eleven'; 12 : spell := 'twelve'; 13 : spell := 'thirteen'; 14 : spell := 'fourteen'; 15 : spell := 'fifteen'; 16 : spell := 'sixteen'; 17 : spell := 'seventeen'; 18 : spell := 'eighteen'; 19 : spell := 'nineteen'; end; trans19 := spell; end; function TForm1.trans9(num: integer): string; var spell : string; begin case num of 1 : spell := 'one'; 2 : spell := 'two'; 3 : spell := 'three'; 4 : spell := 'four'; 5 : spell := 'five'; 6 : spell := 'six'; 7 : spell := 'seven'; 8 : spell := 'eight'; 9 : spell := 'nine'; end; trans9 := spell; end; procedure TForm1.Button1Click(Sender: TObject); var numb: integer; begin spell.text := IntToSpell(StrToInt(num.text)); end;
procedure RemoveInvalid(what, where: string): string; // what is the string to be removed, where is the string to be removed from var tstr: string; begin tstr:=where; while pos(what, tstr)>0 do tstr:=copy(tstr,1,pos(what,tstr)-1) + copy(tstr,pos(what,tstr)+length(tstr),length(tstr)); Result:=tstr; end;
NewStr:=RemoveInvalid('<invalid>','This <invalid> is my string andI wan to remove the word <invalid>');
Use Pascal's DELETE...
using your example string, you could use code like....
Target:='<invalid>'; While POS(Target,string)>0 do begin P := POS(Target,string); DELETE(string,P,Length(Target)); end;
This is a unit where I have gathered lots of this type of routines.
Some of the function names are in swedish, but maybe you can figure out what they are doing.
The one you need is called stringreplaceall which takes three parameters, the string, what to search for and what to replace with and it return the changed string. But beware if you are changing something to something that contains the first. You must do it in two passes or you will end up in an endless loop.
So if you have text containing the word Joe and you like all occurances to be changed to Joey you need to first do something like: text := stringreplaceall (text,'Joe','Joeey'); and then text := stringreplaceall (text,'Joeey','Joey');
unit sparfunc; interface uses sysutils,classes; function antaltecken (orgtext,soktext : string) : integer; function beginsWith (text,teststreng : string):boolean; function endsWith (text,teststreng : string):boolean; function hamtastreng (text,strt,slut : string):string; function hamtastrengmellan (text,strt,slut : string):string; function nastadelare (progtext : string):integer; function rtf2sgml (text : string) : string; Function sgml2win(text : String) : String; Function sgml2mac(text : String) : String; Function sgml2rtf(text : string) : String; function sistamening(text : string) : string; function stringnthfield (text,delim : string; vilken : integer) : string; function stringreplace (text,byt,mot : string) : string; function stringreplaceall (text,byt,mot : string) : string; function text2sgml (text : string) : string; procedure SurePath (pathen : string); procedure KopieraFil (infil,utfil : string); function LasInEnTextfil (filnamn : string) : string; implementation function LasInEnTextfil (filnamn : string) : string; var infil : textfile; temptext, filtext : string; begin filtext := ''; //Öppna angiven fil och läs in den try assignfile (infil,filnamn); //Koppla en textfilsvariabel till pathname reset (infil); //Öppna filen while not eof(infil) do begin //Så länge vi inte nått slutet readln (infil,temptext); //Läs in en rad filtext := filtext+temptext; //Lägg den till variabeln SGMLTEXT end; // while finally //slutligen closefile (infil); //Stäng filen end; //try result := filtext; end; procedure KopieraFil (infil,utfil : string); var InStream : TFileStream; OutStream : TFileStream; begin InStream := TFileStream.Create(infil,fmOpenRead); try OutStream := TFileStream.Create(utfil,fmOpenWrite or fmCreate); try OutStream.CopyFrom(InStream,0); finally OutStream.Free; end; finally InStream.Free; end; end; procedure SurePath (pathen : string); var temprad,del1 : string; antal : integer; begin antal := antaltecken (pathen,'\'); if antal<3 then createdir(pathen) else begin if pathen[length(pathen)] <> '\' then pathen := pathen+'\'; pathen := stringreplace(pathen,'\','/'); del1 := copy(pathen,1,pos('\',pathen)); pathen := stringreplace(pathen,del1,''); del1 := stringreplace(del1,'/','\'); createdir (del1); while pathen <> '' do begin temprad := copy(pathen,1,pos('\',pathen)); pathen := stringreplace(pathen,temprad,''); del1 := del1+ temprad; temprad := ''; createdir(del1); end; end; end; function antaltecken (orgtext,soktext : string) : integer; var i,traffar,soklengd : integer; begin traffar := 0; soklengd := length(soktext); for i := 1 to length(orgtext) do begin if soktext = copy(orgtext,i,soklengd) then traffar := traffar +1; end; result := traffar; end; function nastadelare (progtext : string):integer; var i,j : integer; begin i := pos('.',progtext); j := pos('!',progtext); if (j<i) and (j>0) then i := j; j := pos('!',progtext); if (j<i) and (j>0) then i := j; j := pos('?',progtext); if (j<i) and (j>0) then i := j; result := i; end; function stringnthfield (text,delim : string; vilken : integer) : string; var start,slut,i : integer; temptext : string; begin start := 0; if vilken >0 then begin temptext := text; if vilken = 1 then begin start := 1; slut := pos (delim,text); end else begin for i:= 1 to vilken -1 do begin start := pos(delim,temptext)+length(delim); temptext := copy(temptext,start,length(temptext)); end; slut := pos (delim,temptext); end; if start >0 then begin if slut = 0 then slut := length(text); result := copy (temptext,1,slut-1); end else result := text; end else result := text; end; function StringReplaceAll (text,byt,mot : string ) :string; {Funktion för att byta ut alla förekomster av en sträng mot en annan sträng in en sträng. Den konverterade strängen returneras. Om byt finns i mot måste vi gå via en temporär variant!!!} var plats : integer; begin While pos(byt,text) > 0 do begin plats := pos(byt,text); delete (text,plats,length(byt)); insert (mot,text,plats); end; result := text; end; function StringReplace (text,byt,mot : string ) :string; {Funktion för att byta ut den första förekomsten av en sträng mot en annan sträng in en sträng. Den konverterade strängen returneras.} var plats : integer; begin if pos(byt,text) > 0 then begin plats := pos(byt,text); delete (text,plats,length(byt)); insert (mot,text,plats); end; result := text; end; function hamtastreng (text,strt,slut : string):string; {Funktion för att hämta ut en delsträng ur en annan sträng. Om start och slut finns i text så returneras en sträng där start ingår i början och fram till tecknet före slut.} var stplats,slutplats : integer; resultat : string; begin resultat :=''; stplats := pos(strt,text); if stplats >0 then begin text := copy (text,stplats,length(text)); slutplats := pos(slut,text); if slutplats >0 then begin resultat := copy(text,1,slutplats-1); end; end; result := resultat; end; function hamtastrengmellan (text,strt,slut : string):string; {Funktion för att hämta ut en delsträng ur en annan sträng. Om start och slut finns i text så returneras en sträng där start ingår i början och fram till tecknet före slut.} var stplats,slutplats : integer; resultat : string; begin resultat :=''; stplats := pos(strt,text); if stplats >0 then begin text := copy (text,stplats+length(strt),length(text)); slutplats := pos(slut,text); if slutplats >0 then begin resultat := copy(text,1,slutplats-1); end; end; result := resultat; end; function endsWith (text,teststreng : string):boolean; {Kollar om en sträng slutar med en annan sträng. Returnerar true eller false.} var textlngd,testlngd : integer; kollstreng : string; begin testlngd := length(teststreng); textlngd := length (text); if textlngd > testlngd then begin kollstreng := copy (text,(textlngd+1)-testlngd,testlngd); if kollstreng = teststreng then result := true else result := false; end else result := false; end; function beginsWith (text,teststreng : string):boolean; {Funktion för att kolla om text börjar med teststreng. Returnerar true eller false.} var textlngd,testlngd : integer; kollstreng : string; begin testlngd := length(teststreng); textlngd := length (text); if textlngd >= testlngd then begin kollstreng := copy (text,1,testlngd); if kollstreng = teststreng then result := true else result := false; end else result := false; end; function sistamening(text : string) : string; //Funktion för att ta fram sista meningen i en sträng. Söker på !?. var i:integer; begin i :=length(text)-1; while (copy(text,i,1)<> '.') and (copy(text,i,1)<> '!') and (copy(text,i,1)<> '?') do begin dec(i); if i =1 then break end; if i>1 then result := copy(text,i,length(text)) else result := ''; end; Function text2sgml(text : String) : String; {Funktion som byter ut alla ovanliga tecken mot entiteter. Den färdiga texten returneras.} begin text := stringreplaceall (text,'&','##amp;'); text := stringreplaceall (text,'##amp','&'); text := stringreplaceall (text,'å','å'); text := stringreplaceall (text,'Å','Å'); text := stringreplaceall (text,'ä','ä'); text := stringreplaceall (text,'Ä','Ä'); text := stringreplaceall (text,'á','á'); text := stringreplaceall (text,'Á','Á'); text := stringreplaceall (text,'à','à'); text := stringreplaceall (text,'À','À'); text := stringreplaceall (text,'æ','æ'); text := stringreplaceall (text,'Æ','&Aelig;'); text := stringreplaceall (text,'Â','Â'); text := stringreplaceall (text,'â','â'); text := stringreplaceall (text,'ã','ã'); text := stringreplaceall (text,'Ã','Ã'); text := stringreplaceall (text,'ç','ç'); text := stringreplaceall (text,'Ç','Ç'); text := stringreplaceall (text,'é','é'); text := stringreplaceall (text,'É','É'); text := stringreplaceall (text,'ê','ê'); text := stringreplaceall (text,'Ê','Ê'); text := stringreplaceall (text,'ë','ë'); text := stringreplaceall (text,'Ë','Ë'); text := stringreplaceall (text,'è','è'); text := stringreplaceall (text,'È','È'); text := stringreplaceall (text,'î','î'); text := stringreplaceall (text,'Î','Î'); text := stringreplaceall (text,'í','í'); text := stringreplaceall (text,'Í','Í'); text := stringreplaceall (text,'ì','ì'); text := stringreplaceall (text,'Ì','Ì'); text := stringreplaceall (text,'ï','ï'); text := stringreplaceall (text,'Ï','Ï'); text := stringreplaceall (text,'ñ','ñ'); text := stringreplaceall (text,'Ñ','Ñ'); text := stringreplaceall (text,'ö','ö'); text := stringreplaceall (text,'Ö','Ö'); text := stringreplaceall (text,'ò','ò'); text := stringreplaceall (text,'Ò','Ò'); text := stringreplaceall (text,'ó','ó'); text := stringreplaceall (text,'Ó','Ó'); text := stringreplaceall (text,'ø','ø'); text := stringreplaceall (text,'Ø','Ø'); text := stringreplaceall (text,'Ô','Ô'); text := stringreplaceall (text,'ô','ô'); text := stringreplaceall (text,'õ','õ'); text := stringreplaceall (text,'Õ','Õ'); text := stringreplaceall (text,'ü','ü'); text := stringreplaceall (text,'Ü','Ü'); text := stringreplaceall (text,'ú','ú'); text := stringreplaceall (text,'Ú','Ú'); text := stringreplaceall (text,'Ù','Ù'); text := stringreplaceall (text,'ù','ù'); text := stringreplaceall (text,'û','û'); text := stringreplaceall (text,'Û','Û'); text := stringreplaceall (text,'ý','ý'); text := stringreplaceall (text,'Ý','Ý'); text := stringreplaceall (text,'ÿ','ÿ'); text := stringreplaceall (text,'|',' '); result := text; End; Function sgml2win(text : String) : String; {Funktion som ersätter alla entiteter mot deras tecken i windows. Den färdiga strängen returneras.} begin text := stringreplaceall (text,'á','á'); text := stringreplaceall (text,'Á','Á'); text := stringreplaceall (text,'æ','æ'); text := stringreplaceall (text,'&Aelig;','Æ'); text := stringreplaceall (text,'à','à'); text := stringreplaceall (text,'À','À'); text := stringreplaceall (text,'å','å'); text := stringreplaceall (text,'Å','Å'); text := stringreplaceall (text,'ä','ä'); text := stringreplaceall (text,'Ä','Ä'); text := stringreplaceall (text,'Â' ,'Â'); text := stringreplaceall (text,'â' ,'â'); text := stringreplaceall (text,'ã','ã'); text := stringreplaceall (text,'Ã','Ã'); text := stringreplaceall (text,'ç','ç'); text := stringreplaceall (text,'Ç','Ç'); text := stringreplaceall (text,'é','é'); text := stringreplaceall (text,'É','É'); text := stringreplaceall (text,'è','è'); text := stringreplaceall (text,'È','È'); text := stringreplaceall (text,'ê' ,'ê'); text := stringreplaceall (text,'Ê' ,'Ê'); text := stringreplaceall (text,'ë' ,'ë'); text := stringreplaceall (text,'Ë' ,'Ë'); text := stringreplaceall (text,'î' ,'î'); text := stringreplaceall (text,'Î' ,'Î'); text := stringreplaceall (text,'í','í'); text := stringreplaceall (text,'Í','Í'); text := stringreplaceall (text,'ì','ì'); text := stringreplaceall (text,'Ì','Ì'); text := stringreplaceall (text,'ï' ,'ï'); text := stringreplaceall (text,'Ï' ,'Ï'); text := stringreplaceall (text,'ñ','ñ'); text := stringreplaceall (text,'Ñ','Ñ'); text := stringreplaceall (text,'ò','ò'); text := stringreplaceall (text,'Ò','Ò'); text := stringreplaceall (text,'ó','ó'); text := stringreplaceall (text,'Ó','Ó'); text := stringreplaceall (text,'ö','ö'); text := stringreplaceall (text,'Ö','Ö'); text := stringreplaceall (text,'ø','ø'); text := stringreplaceall (text,'Ø','Ø'); text := stringreplaceall (text,'Ô' ,'Ô'); text := stringreplaceall (text,'ô' ,'ô'); text := stringreplaceall (text,'õ','õ'); text := stringreplaceall (text,'Õ','Õ'); text := stringreplaceall (text,'ü','ü'); text := stringreplaceall (text,'Ü','Ü'); text := stringreplaceall (text,'ú','ú'); text := stringreplaceall (text,'Ú','Ú'); text := stringreplaceall (text,'û' ,'û'); text := stringreplaceall (text,'Û' ,'Û'); text := stringreplaceall (text,'Ù','Ù'); text := stringreplaceall (text,'ù','ù'); text := stringreplaceall (text,'ý','ý'); text := stringreplaceall (text,'Ý','Ý'); text := stringreplaceall (text,'ÿ' ,'ÿ'); text := stringreplaceall (text,' ','|'); text := stringreplaceall (text,'&','&'); result := text; End; Function sgml2mac(text : String) : String; {Funktion som ersätter alla entiteter mot deras tecken i mac. Den färdiga strängen returneras.} begin text := stringreplaceall (text,'á',chr(135)); text := stringreplaceall (text,'Á',chr(231)); text := stringreplaceall (text,'æ',chr(190)); text := stringreplaceall (text,'&Aelig;',chr(174)); text := stringreplaceall (text,'à',chr(136)); text := stringreplaceall (text,'À',chr(203)); text := stringreplaceall (text,'å',chr(140)); text := stringreplaceall (text,'Å',chr(129)); text := stringreplaceall (text,'Ä',chr(128)); text := stringreplaceall (text,'ä',chr(138)); text := stringreplaceall (text,'Â' ,chr(229)); text := stringreplaceall (text,'â' ,chr(137)); text := stringreplaceall (text,'ã',chr(139)); text := stringreplaceall (text,'Ã',chr(204)); text := stringreplaceall (text,'ç',chr(141)); text := stringreplaceall (text,'Ç',chr(130)); text := stringreplaceall (text,'é',chr(142)); text := stringreplaceall (text,'É',chr(131)); text := stringreplaceall (text,'è',chr(143)); text := stringreplaceall (text,'È',chr(233)); text := stringreplaceall (text,'ê' ,chr(144)); text := stringreplaceall (text,'Ê' ,chr(230)); text := stringreplaceall (text,'ë' ,chr(145)); text := stringreplaceall (text,'Ë' ,chr(232)); text := stringreplaceall (text,'î' ,chr(148)); text := stringreplaceall (text,'Î' ,chr(235)); text := stringreplaceall (text,'í' ,chr(146)); text := stringreplaceall (text,'Í' ,chr(234)); text := stringreplaceall (text,'ì' ,chr(147)); text := stringreplaceall (text,'Ì' ,chr(237)); text := stringreplaceall (text,'ï' ,chr(149)); text := stringreplaceall (text,'Ï' ,chr(236)); text := stringreplaceall (text,'ñ',chr(150)); text := stringreplaceall (text,'Ñ',chr(132)); text := stringreplaceall (text,'ò',chr(152)); text := stringreplaceall (text,'Ò',chr(241)); text := stringreplaceall (text,'ó',chr(151)); text := stringreplaceall (text,'Ó',chr(238)); text := stringreplaceall (text,'Ô' ,chr(239)); text := stringreplaceall (text,'ô' ,chr(153)); text := stringreplaceall (text,'ø',chr(191)); text := stringreplaceall (text,'Ø',chr(175)); text := stringreplaceall (text,'õ',chr(155)); text := stringreplaceall (text,'Õ',chr(239)); text := stringreplaceall (text,'ö',chr(154)); text := stringreplaceall (text,'Ö',chr(133)); text := stringreplaceall (text,'ü',chr(159)); text := stringreplaceall (text,'Ü',chr(134)); text := stringreplaceall (text,'ú',chr(156)); text := stringreplaceall (text,'Ú',chr(242)); text := stringreplaceall (text,'û' ,chr(158)); text := stringreplaceall (text,'Û' ,chr(243)); text := stringreplaceall (text,'Ù',chr(244)); text := stringreplaceall (text,'ù',chr(157)); text := stringreplaceall (text,'ý','y'); text := stringreplaceall (text,'ÿ' ,chr(216)); text := stringreplaceall (text,'Ÿ' ,chr(217)); text := stringreplaceall (text,' ',' '); text := stringreplaceall (text,'&',chr(38)); result := text; End; Function sgml2rtf(text : string) : String; {Funktion för att byta ut sgml-entiteter mot de koder som gäller i RTF-textrutorna.} begin text := stringreplaceall (text,'}','#]#'); text := stringreplaceall (text,'{','#[#'); text := stringreplaceall (text,'\','HSALSKCAB'); text := stringreplaceall (text,'HSALSKCAB','\\'); text := stringreplaceall (text,'æ','\'+chr(39)+'c6'); text := stringreplaceall (text,'&Aelig;','\'+chr(39)+'e6'); text := stringreplaceall (text,'á','\'+chr(39)+'e1'); text := stringreplaceall (text,'Á','\'+chr(39)+'c1'); text := stringreplaceall (text,'à','\'+chr(39)+'e0'); text := stringreplaceall (text,'À','\'+chr(39)+'c0'); text := stringreplaceall (text,'å','\'+chr(39)+'e5'); text := stringreplaceall (text,'Å','\'+chr(39)+'c5'); text := stringreplaceall (text,'Â','\'+chr(39)+'c2'); text := stringreplaceall (text,'â','\'+chr(39)+'e2'); text := stringreplaceall (text,'ã','\'+chr(39)+'e3'); text := stringreplaceall (text,'Ã','\'+chr(39)+'c3'); text := stringreplaceall (text,'ä','\'+chr(39)+'e4'); text := stringreplaceall (text,'Ä','\'+chr(39)+'c4'); text := stringreplaceall (text,'ç','\'+chr(39)+'e7'); text := stringreplaceall (text,'Ç','\'+chr(39)+'c7'); text := stringreplaceall (text,'é','\'+chr(39)+'e9'); text := stringreplaceall (text,'É','\'+chr(39)+'c9'); text := stringreplaceall (text,'è','\'+chr(39)+'e8'); text := stringreplaceall (text,'È','\'+chr(39)+'c8'); text := stringreplaceall (text,'ê','\'+chr(39)+'ea'); text := stringreplaceall (text,'Ê','\'+chr(39)+'ca'); text := stringreplaceall (text,'ë','\'+chr(39)+'eb'); text := stringreplaceall (text,'Ë','\'+chr(39)+'cb'); text := stringreplaceall (text,'î','\'+chr(39)+'ee'); text := stringreplaceall (text,'Î','\'+chr(39)+'ce'); text := stringreplaceall (text,'í','\'+chr(39)+'ed'); text := stringreplaceall (text,'Í','\'+chr(39)+'cd'); text := stringreplaceall (text,'ì','\'+chr(39)+'ec'); text := stringreplaceall (text,'Ì','\'+chr(39)+'cc'); text := stringreplaceall (text,'ï' ,'\'+chr(39)+'ef'); text := stringreplaceall (text,'Ï' ,'\'+chr(39)+'cf'); text := stringreplaceall (text,'ñ','\'+chr(39)+'f1'); text := stringreplaceall (text,'Ñ','\'+chr(39)+'d1'); text := stringreplaceall (text,'ö','\'+chr(39)+'f6'); text := stringreplaceall (text,'Ö','\'+chr(39)+'d6'); text := stringreplaceall (text,'ó','\'+chr(39)+'f3'); text := stringreplaceall (text,'Ó','\'+chr(39)+'d3'); text := stringreplaceall (text,'ò','\'+chr(39)+'f2'); text := stringreplaceall (text,'Ò','\'+chr(39)+'d2'); text := stringreplaceall (text,'ø','\'+chr(39)+'f8'); text := stringreplaceall (text,'Ø','\'+chr(39)+'d8'); text := stringreplaceall (text,'Ô','\'+chr(39)+'d4'); text := stringreplaceall (text,'ô','\'+chr(39)+'f4'); text := stringreplaceall (text,'õ','\'+chr(39)+'f5'); text := stringreplaceall (text,'Õ','\'+chr(39)+'d5'); text := stringreplaceall (text,'ú','\'+chr(39)+'fa'); text := stringreplaceall (text,'Ú','\'+chr(39)+'da'); text := stringreplaceall (text,'û','\'+chr(39)+'fb'); text := stringreplaceall (text,'Û','\'+chr(39)+'db'); text := stringreplaceall (text,'Ù','\'+chr(39)+'d9'); text := stringreplaceall (text,'ù','\'+chr(39)+'f9'); text := stringreplaceall (text,'ü','\'+chr(39)+'fc'); text := stringreplaceall (text,'Ü','\'+chr(39)+'dc'); text := stringreplaceall (text,'ý','\'+chr(39)+'fd'); text := stringreplaceall (text,'Ý','\'+chr(39)+'dd'); text := stringreplaceall (text,'ÿ','\'+chr(39)+'ff'); text := stringreplaceall (text,'£','\'+chr(39)+'a3'); text := stringreplaceall (text,'#]#','\}'); text := stringreplaceall (text,'#[#','\{'); text := stringreplaceall (text,' ','|'); text := stringreplaceall (text,'&','&'); result := text; End; function rtf2sgml (text : string) : string; {Funktion för att konvertera en RTF-rad till SGML-text.} var temptext : string; start : integer; begin text := stringreplaceall (text,'&','##amp;'); text := stringreplaceall (text,'##amp','&'); text := stringreplaceall (text,'\'+chr(39)+'c6','æ'); text := stringreplaceall (text,'\'+chr(39)+'e6','&Aelig;'); text := stringreplaceall (text,'\'+chr(39)+'e5','å'); text := stringreplaceall (text,'\'+chr(39)+'c5','Å'); text := stringreplaceall (text,'\'+chr(39)+'e4','ä'); text := stringreplaceall (text,'\'+chr(39)+'c4','Ä'); text := stringreplaceall (text,'\'+chr(39)+'e1','á'); text := stringreplaceall (text,'\'+chr(39)+'c1','Á'); text := stringreplaceall (text,'\'+chr(39)+'e0','à'); text := stringreplaceall (text,'\'+chr(39)+'c0','À'); text := stringreplaceall (text,'\'+chr(39)+'c2','Â'); text := stringreplaceall (text,'\'+chr(39)+'e2','â'); text := stringreplaceall (text,'\'+chr(39)+'e3','ã'); text := stringreplaceall (text,'\'+chr(39)+'c3','Ã'); text := stringreplaceall (text,'\'+chr(39)+'e7','ç'); text := stringreplaceall (text,'\'+chr(39)+'c7','Ç'); text := stringreplaceall (text,'\'+chr(39)+'e9','é'); text := stringreplaceall (text,'\'+chr(39)+'c9','É'); text := stringreplaceall (text,'\'+chr(39)+'e8','è'); text := stringreplaceall (text,'\'+chr(39)+'c8','È'); text := stringreplaceall (text,'\'+chr(39)+'ea','ê'); text := stringreplaceall (text,'\'+chr(39)+'ca','Ê'); text := stringreplaceall (text,'\'+chr(39)+'eb','ë'); text := stringreplaceall (text,'\'+chr(39)+'cb','Ë'); text := stringreplaceall (text,'\'+chr(39)+'ee','î'); text := stringreplaceall (text,'\'+chr(39)+'ce','Î'); text := stringreplaceall (text,'\'+chr(39)+'ed','í'); text := stringreplaceall (text,'\'+chr(39)+'cd','Í'); text := stringreplaceall (text,'\'+chr(39)+'ec','ì'); text := stringreplaceall (text,'\'+chr(39)+'cc','Ì'); text := stringreplaceall (text,'\'+chr(39)+'ef','ï'); text := stringreplaceall (text,'\'+chr(39)+'cf','Ï'); text := stringreplaceall (text,'\'+chr(39)+'f1','ñ'); text := stringreplaceall (text,'\'+chr(39)+'d1','Ñ'); text := stringreplaceall (text,'\'+chr(39)+'f3','ó'); text := stringreplaceall (text,'\'+chr(39)+'d3','Ó'); text := stringreplaceall (text,'\'+chr(39)+'f2','ò'); text := stringreplaceall (text,'\'+chr(39)+'d2','Ò'); text := stringreplaceall (text,'\'+chr(39)+'d4','Ô'); text := stringreplaceall (text,'\'+chr(39)+'f4','ô'); text := stringreplaceall (text,'\'+chr(39)+'f5','õ'); text := stringreplaceall (text,'\'+chr(39)+'d5','Õ'); text := stringreplaceall (text,'\'+chr(39)+'f8','ø'); text := stringreplaceall (text,'\'+chr(39)+'d8','Ø'); text := stringreplaceall (text,'\'+chr(39)+'f6','ö'); text := stringreplaceall (text,'\'+chr(39)+'d6','Ö'); text := stringreplaceall (text,'\'+chr(39)+'fc','ü'); text := stringreplaceall (text,'\'+chr(39)+'dc','Ü'); text := stringreplaceall (text,'\'+chr(39)+'fa','ú'); text := stringreplaceall (text,'\'+chr(39)+'da','Ú'); text := stringreplaceall (text,'\'+chr(39)+'fb','û'); text := stringreplaceall (text,'\'+chr(39)+'db','Û'); text := stringreplaceall (text,'\'+chr(39)+'d9','Ù'); text := stringreplaceall (text,'\'+chr(39)+'f9','ù'); text := stringreplaceall (text,'\'+chr(39)+'fd','ý'); text := stringreplaceall (text,'\'+chr(39)+'dd','Ý'); text := stringreplaceall (text,'\'+chr(39)+'ff','ÿ'); text := stringreplaceall (text,'|',' '); text := stringreplaceall (text,'\'+chr(39)+'a3','£'); text := stringreplaceall (text,'\}','#]#'); text := stringreplaceall (text,'\{','#[#'); if (beginswith (text, '{\rtf1\')) or (beginswith (text, '{\colortbl\')) then begin result := ''; exit; end; //text := stringreplaceall (text,'{\fonttbl',''); {Skall alltid tas bort} //temptext := hamtastreng (text,'{\rtf1','{\f0');{Skall alltid tas bort} //text := stringreplace (text,temptext,''); //temptext := hamtastreng (text,'{\f0','{\f1');{Skall alltid tas bort} //text := stringreplace (text,temptext,''); //temptext := hamtastreng (text,'{\f1','{\f2');{Skall alltid tas bort} //text := stringreplace (text,temptext,''); //text := stringreplaceall (text,'{\f2\fswiss\fprq2 System;}}','');{Skall alltid tas bort} //text := stringreplaceall (text,'{\colortbl\red0\green0\blue0;}','');{Skall alltid tas bort} {I version 2.01 av Delphi finns inte \cf0 med i RTF-rutan. Tog därför bort det efter \fs16 och la istället en egen tvätt av \cf0.} //temptext := hamtastreng (text,'{\rtf1','\deflang'); //text := stringreplace (text,temptext,''); {Hämta och radera allt från start till deflang} text := stringreplaceall (text,'\cf0',''); temptext := hamtastreng (text,'\deflang','\pard');{Plocka från deflang till pard för att få } text := stringreplace (text,temptext,'');{oavsett vilken lang det är. Norska o svenska är olika} text := stringreplaceall (text,'\ltrpar',''); text := stringreplaceall (text,'\ql',''); text := stringreplaceall (text,'\ltrch',''); {Här skall vi plocka bort fs och flera olika siffror beroende på vilka alternativ vi godkänner.} //text := stringreplaceall (text,'\fs16','');{8 punkter} //text := stringreplaceall (text,'\fs20','');{10 punkter} {Nu städar vi istället bort alla tvåsiffriga fontsize.} while pos ('\fs',text) >0 do begin //application.processmessages; start := pos ('\fs',text); Delete(text,start,5); end; while pos ('\f',text) >0 do begin //application.processmessages; start := pos ('\f',text); Delete(text,start,3); end; text := stringreplaceall (text,'\pard\li200-200{\*\pn\pnlvlblt\pnf1\pnindent200{\pntxtb\'+chr(39)+'b7}}\plain ','</P><UL>'); text := stringreplaceall (text,'{\pntext\'+chr(39)+'b7\tab}','<LI>'); text := stringreplaceall (text, '\par <LI>','<LI>'); text := stringreplaceall (text, '\par <UL>','<UL>'); text := stringreplaceall (text,'\pard\plain ','<P>'); text := stringreplaceall (text,'\par \plain\b\ul ','</P><MELLIS>'); text := stringreplaceall (text,'\plain\b\ul ','</P><MELLIS>'); text := stringreplaceall (text,'\plain','</MELLIS>'); text := stringreplaceall (text,'\par }','</P>'); if (pos ('\par \tab ',text)>0) or (pos ('<P>\tab ',text)>0) then begin text := stringreplaceall (text,'\par \tab ','<TR><TD>'); text := stringreplaceall (text,'<P>\tab ','<TR><TD>'); text := stringreplaceall (text,'\tab ','</TD><TD>'); end else begin text := stringreplaceall (text,'\tab ',''); end; text := stringreplaceall (text,'\par ','</P><P>'); text := stringreplaceall (text,'#]#','}'); text := stringreplaceall (text,'#[#','{'); text := stringreplaceall (text,'\\','\'); if pos('<TD>',text)>0 then text := text+'</TD></TR>'; if pos('<LI>',text)>0 then text := text+'</LI>'; result := text; end; end.