MG: started lclproc.pas

git-svn-id: trunk@2350 -

.gitattributes

@@ -609,6 +609,7 @@ lcl/languages/lcl.po svneol=native#text/plain
 lcl/lazqueue.pp svneol=native#text/pascal
 lcl/lcllinux.pp svneol=native#text/pascal
 lcl/lclmemmanager.pas svneol=native#text/pascal
+lcl/lclproc.pas svneol=native#text/pascal
 lcl/lclstrconsts.pas svneol=native#text/pascal
 lcl/lcltype.pp svneol=native#text/pascal
 lcl/lmessages.pp svneol=native#text/pascal

lcl/lclproc.pas

@@ -0,0 +1,69 @@
+{
+ /***************************************************************************
+                                  lclproc.pas
+                                  -----------
+                             Component Library Code
+
+
+ ***************************************************************************/
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.LCL, included in this distribution,                 *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+
+  Useful helper functions.
+}
+unit LCLProc;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LCLType;
+
+Function DeleteAmpersands(var Str : String) : Longint;
+
+
+implementation
+
+
+Function DeleteAmpersands(var Str : String) : Longint;
+// Replace all &x with x
+// and return the position of the first ampersand letter in the resulting Str.
+// double ampersands && are converted to a single & and are ignored.
+var
+  SrcPos, DestPos, SrcLen: Integer;
+begin
+  Result:=-1;
+  SrcLen:=length(Str);
+  SrcPos:=1;
+  DestPos:=1;
+  while SrcPos<=SrcLen do begin
+    if (Str[SrcPos]='&') and (SrcPos<SrcLen) then begin
+      // & found
+      inc(SrcPos); // skip &
+      if (Str[SrcPos]<>'&') and (Result<1) then
+        Result:=DestPos;
+    end;
+    if DestPos<SrcPos then
+      Str[DestPos]:=Str[SrcPos];
+    inc(SrcPos);
+    inc(DestPos);
+  end;
+  if DestPos<SrcPos then
+    SetLength(Str,DestPos-1);
+end;
+
+
+end.
+