Upper the first letter of each word

If we will agree, that the word is a characters set between the spaces then you can try this:

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  Str: string;
begin
  Label2.Caption:='';
  Str:=' '+Edit1.Text;
  i:=1;
  repeat
    if Str[i]<>' ' then
      Label2.Caption:=Label2.Caption+Str[i];
    if Str[i]=' ' then
    begin
      if (Str[i+1]<>' ') then
      begin
        Label2.Caption:=Label2.Caption+Str[i]+AnsiUpperCase(Str[i+1]);
        Inc(i);
      end
      else
        Label2.Caption:=Label2.Caption+Str[i];
    end;
    Inc(i);
  until i>Length(Str)+1;
  Str:=Label2.Caption;
  Delete(Str, 1, 1);
  Label2.Caption:=Str;
end;

Sort of array of string type

Posted in Algorithms

Use for sorting strings this algorithm: You should run along an array several times and compare each element of this array with next element and invert this strings if it necessary. For comparing strings use CompareStr function. This example shows sorting of names of months.

var
  mas: array[1..12] of string = (
    'January',
    'February',
    'March',
    'April',
    'May',
    'June',
    'July',
    'August',
    'September',
    'October',
    'November',
    'December');
...
procedure TForm1.Button2Click(Sender: TObject);
var
  Str: string;
  Num: Integer;
  Check: Boolean;
begin
  repeat
    Check:=False;
    Num:=1;
    repeat
      if CompareStr(mas[Num], mas[Num+1])>0 then
      begin
        Str:=mas[Num];
        mas[Num]:=mas[Num+1];
        mas[Num+1]:=Str;
        Check:=True;
      end;
      Inc(Num);
    until(Num>11);
  until(Check=False);
end;

Set limit for string

Posted in Algorithms

You can set limit for the string, when you define a variable of string type. But it will variable of ShortString type, if you will set a limitation for the string.

procedure TForm1.Button1Click(Sender: TObject);
var
  MyStr: string[60];
begin
  MyStr:='This string must contain not more 60 symbols';
  Label1.Caption:=MyStr;
end;

Replace substring to any string

Posted in Algorithms

Use Replace function to replace SubStr string to Str string in Dest string. In other words, if you have Dest is '1234567890' and SubStr is '345' and Str is 'ABCDE', then you will receive Dest as '12ABCDE67890' This function use Pos function, Delete and Insert procedures.

function Replace(Dest, SubStr, Str: string): string;
var
  Position: Integer;
begin
  Position:=Pos(SubStr, Dest);
  Delete(Dest, Position, Length(SubStr));
  Insert(Str, Dest, Position);
  Result:=Dest;
end;

Get RichEdit's word count

Posted in Algorithms

Use CountInLine function which describe in a private chapter. This function carry out word count for one string only. Calling CountInLine for all lines of document, and you will get total word count of the document.

...
  private
    function CounInLine(Str: string): Integer;
...
procedure TForm1.Button1Click(Sender: TObject);
var
  CountWord, i: Integer;
begin
  CountWord:=0;
  with RichEdit1 do
  begin
    for i:=0 to Lines.Count-1 do
      CountWord:=CountWord+CountInLine(Lines.Strings[i]);
  end;
  Label1.Caption:='Word count = '+IntToStr(CountWord);
end;

function TForm1.CountInLine(Str: string): Integer;
var
  Count,Inter: Integer;
  TimeStr,Symbol: string;
begin
  Symbol:='!@#$%^&*()~[]{}":?<>,.|\/*';
  Count:=0;
  while Length(Str)>0 do
  begin
    if Pos(' ',Str)=1 then Delete(Str,1,1)
    else
    begin
      TimeStr:=Copy(Str,1,Pos(' ',Str)-1);
      try
        Inter:=StrToInt(TimeStr);
        Count:=Count-1;
      except
        on EConvertError do Count:=Count;
      end;
      if (Length(TimeStr)=1) and (Pos(TimeStr,Symbol)<>0) then 
        Count:=Count-1;
      if TimeStr='' then Str:=''
      else Delete(Str,1,Pos(' ',Str)-1);
      Count:=Count+1;
    end;
  end;
  CountInLine:=Count;
end;

Algorithms

More Articles...