Version:0.9 StartHTML:0000000105 EndHTML:0000255509 StartFragment:0000001037 EndFragment:0000255493 mXScriptasHTML
//Example of the memo load and save capabilities of the VCL
//Task: Make the 3rd algo too!
//Get the text and write your memo memories, locs=1460 

program String_Functions_For_39;

//uses StringGridTools;

const LEFTBASE = 20;
      TOPBASE = 25; 
      VARRSIZE = 200;


type
  //TThreadSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;
  TmSortArray =  array[0..VARRSIZE] of Integer;

var 
  mymemo: TMemo;
  mpaint, mpaint2, mpaint3: TPaintBox;
  //BubbleSortBox, SelectionSortBox, QuickSortBox: TPaintBox;
  bigstring: string;
  inFrm: TForm;  
  mbtn3: TBitBtn;
  Lstbox: TListbox;
  stat: TStatusbar;
  selectedFile: string;
  BubbleSortArray: TSortArray;
  SelectionSortArray: TSortArray;
  QuickSortArray: TSortArray;
  ArraysRandom: Boolean;
  FA, FB, FI, FJ: Integer;
  ThreadsRunning: byte;


procedure PaintLine(Canvas: TCanvas; I, Len: Integer); forward;


procedure RandomizeArrays;
var
  I: Integer;
begin
   //I:= 0;
   //if b then dialogs.showmessage('this is')
   assert2(high(BubbleSortArray) <= 180, 'array to big');
  //Check(high(BubbleSortArray) <= 170, 'array to big');
  if not ArraysRandom then begin
    Randomize;
    writeln(inttostr(arrsize))
    for I:= 1 to ARRSIZE - 1 do
     //SelectionSortarray[i]:= random(165);
    //writeln(inttostr(i));
    BubbleSortArray[I]:= Random(170);
    SelectionSortArray:= BubbleSortArray;
    QuickSortArray:= BubbleSortArray;
    writeln('just random thread done')
  end;
end;  

procedure PaintRandomArray;
var I: integer;
begin
  mPaint2.Canvas.Pen.Color:= clblue;
  for I:= Low(QuickSortArray) to High(QuickSortArray) do
    PaintLine(mpaint3.Canvas, I, QuickSortArray[I]);
  for I:= Low(SelectionSortArray) to High(SelectionSortArray) do
    PaintLine(mpaint2.Canvas, I, SelectionSortArray[I]);
  mPaint.Canvas.Pen.Color:= clgreen;
  for I:= Low(BubbleSortArray) to High(BubbleSortArray) do
    PaintLine(mpaint.Canvas, I, BubbleSortArray[I])
end;


procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
begin
  canvas.moveTo(0, I * 2 + 1)
  canvas.LineTo(Len, I * 2 + 1)
  //Canvas.PolyLine([Point(0, I * 2 + 1), Point(Len, I * 2 + 1)]);
end;

procedure DoVisualSwap2;
begin
  with mpaint2 do begin
    //invalidate;
    Canvas.Pen.Color:= clBtnFace;
    //Canvas.Pen.Color:= clBlue;
    PaintLine(Canvas, FI, FA);
    PaintLine(Canvas, FJ, FB);
    Canvas.Pen.Color:= clRed;
    PaintLine(Canvas, FI, FB);
    PaintLine(Canvas, FJ, FA);
  end;
end;

procedure DoVisualSwap;
begin
  with mpaint do begin
    //invalidate;
    Canvas.Pen.Color:= clBtnFace;
    //Canvas.Pen.Color:= clBlue;
    PaintLine(Canvas, FI, FA);
    PaintLine(Canvas, FJ, FB);
    Canvas.Pen.Color:= clRed;
    PaintLine(Canvas, FI, FB);
    PaintLine(Canvas, FJ, FA);
  end;
end;


procedure VisualSwap2(A, B, I, J: Integer);
begin
  //symbol rename
  FA:= A; FB:= B;
  FI:= I; FJ:= J;
  //DoVisualSwap;
  DoVisualSwap2;
end;

procedure VisualSwap(A, B, I, J: Integer);
begin
  //symbol rename
  FA:= A;
  FB:= B;
  FI:= I;
  FJ:= J;
  //if bolTHslowmotion then
    //        sysutils.sleep(5);
  DoVisualSwap;
  DoVisualSwap2;
end;
  
procedure TmSelectionSort(var A: TmSortArray);
// syncedit
var
 indx, J, T: Integer;
begin
  for indx := Low(A) to High(A) - 1 do
    for J := High(A) downto indx + 1 do
      if A[indx] > A[J] then begin
        VisualSwap(A[indx], A[J], indx, J);
        //write('debug')
        T:= A[indx];
        A[indx] := A[J];
        A[J] := T;
        //if Terminated then Exit;
      end;
end; 

{ TBubbleSort }
procedure TmBubbleSort(var A: TmSortArray);
var
  I, J, T: Integer;
begin
  for I := High(A) downto Low(A) do
    for J := Low(A) to High(A) - 1 do
      if A[J] > A[J + 1] then begin
        VisualSwap2(A[J], A[J + 1], J, J + 1);
        T := A[J];
        A[J] := A[J + 1];
        A[J + 1] := T;
     end;
end; 



procedure QuickSort(var A: TmSortArray; iLo, iHi: Integer);
  var
    Lo, Hi, Mid, T: Integer;
  begin
    Lo := iLo;
    Hi := iHi;
    // inline variable
    Mid:= A[(Lo + Hi) div 2];
    repeat
      while A[Lo] < Mid
                    do Inc(Lo);
      while A[Hi] > Mid
                    do Dec(Hi);
      if Lo <= Hi then begin
        VisualSwap(A[Lo], A[Hi], Lo, Hi);
        T:= A[Lo];
        A[Lo]:= A[Hi];
        A[Hi]:= T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
    //if Terminated then Exit;
  end;

procedure TmQuickSort(var A: TmSortArray);
begin
  QuickSort(A, Low(A), High(A));
end;

  
Function getRandomText: string;
var i, getback: integer;
begin
  result:= Chr(32)
  for i:= 1 to 1400 do begin
    getback:=  random(58)+65
    if (getback < 91) OR (getback > 96) then
      result:= result + Chr(getback) +Chr(32)
  end;
end;  
  
//Event Handler - Closure  
Procedure GetMediaData(self: TObject);
begin
  if PromptForFileName(selectedFile,
                       'Text files (*.txt)|*.txt','',
                       'Select your mX3 test file',
                       ExePath+'examples\', False)  // Means not a Save dialog !
   then begin
     // Display this full file/path value
     ShowMessage('Selected file = '+selectedFile);
     Stat.simpletext:= selectedFile;
     mymemo.lines.LoadFromFile(selectedFile);
     // Split this full file/path value into its constituent parts
     //writeln('PromptForFileName_28: Res of processpath '+tmp)
   end;
end; 

procedure ThreadDone(Sender: TObject);
begin
  Dec(ThreadsRunning);
  if ThreadsRunning = 0 then begin
    //StartBtn.Enabled:= True;
    //randArray.ArraysRandom:= False;
    Writeln('all threads gone');
  end;
end;


//Event Handler - Closure
procedure BtnStartClick(self: TObject);
begin
  //mymemo.lines.savetofile(ExePath+'\examples\mymemomemoire.txt');
  mymemo.lines.text:= getRandomText;
  mPaint.invalidate;
  mPaint2.invalidate;
  mPaint3.invalidate;
  ThreadsRunning:= 3;
  RandomizeArrays;
  //PaintRandomArray;
 { with TSortThread.Create(mPaint, bubblesortarray) do begin
    slowmotion:= 200;
   end;}
   //marr:= TRandomArray.create;
   //marr.RandomizeArrays(inFrm, false)
    //marr.PaintArray(mPaint) 
    //bubblesortbox
  ProcessMessagesOFF;  
  with TBubbleSort.Create(mpaint, BubbleSortArray) do begin
    bolTHslowmotion:= true;
    slowmotion:= 0;
    //sort
    OnTerminate:= @ThreadDone;
  end;
  //selectionsortbox
  with TSelectionSort.Create(mpaint2, SelectionSortArray) do begin
    bolTHslowmotion:= true;
    slowmotion:= 0;
    //sort
    OnTerminate:= @ThreadDone;
  end;
  //application.ProcessMessages;
  with TQuickSort.Create(mpaint3, QuickSortArray) do begin
    bolTHslowmotion:= true;
    slowmotion:= 0;
    //sort
    OnTerminate:= @ThreadDone;
  end;
  ProcessMessagesON;  
 
  //marr.Free;
  //msort:= TSortThread.Create(mPaint,sortarray)
  //TmSelectionSort(selectionSortArray)
  //TmBubbleSort(bubbleSortArray)

  //mymemo.lines.SaveToFile(selectedFile);
  Stat.simpletext:= ' start has been sorted' ;
end; 

procedure GetRandom(self: TObject);
begin
  //mymemo.lines.savetofile(ExePath+'\examples\mymemomemoire.txt');
  mymemo.lines.text:= getRandomText;
  mPaint.invalidate;
  mPaint2.invalidate;
  mPaint3.invalidate;
  RandomizeArrays;
  PaintRandomArray;
end; 


procedure BtnSortClick(self: TObject);
begin
  //mymemo.lines.savetofile(ExePath+'\examples\mymemomemoire.txt');
  //RandomizeArrays(inFrm);
  //PaintRandomArray;
  mPaint.invalidate;
  mPaint2.invalidate;
  mPaint3.invalidate;

  //TmSelectionSort(selectionSortArray)
  //TmBubbleSort(bubbleSortArray)
  //mymemo.lines.SaveToFile(selectedFile);
  //Stat.simpletext:= selectedFile+ ' has been saved' ;
end; 


procedure JCLStringsTester;
var tester, tester2: string;
    testeransi: ansistring;
    stl: TStringlist;
begin

{template s}
  tester:= 'this is HEX in the BOX';
  tester2:= 'this is MAX in the TEX';
 //ReplaceFirst(const SourceStr, FindStr, ReplaceStr: string): string;
  writeln(ReplaceFirst(tester, 'HEX', 'MAX'));
 //ReplaceLast(const SourceStr, FindStr, ReplaceStr: string): string;
 //InsertLastBlock(var SourceStr: string; BlockStr: string): Boolean;
 //RemoveMasterBlocks(const SourceStr: string): string;
 //RemoveFields(const SourceStr: string): string;

{http s}
  testeransi:= 'http://www.softwareschule.ch/maxbox.htm';
 //URLEncode(const Value: AnsiString): AnsiString; // Converts string To A URLEncoded string
 writeln(URLEncode(testeransi)); // Converts string To A URLEncoded string

 //URLDecode(const Value: AnsiString): AnsiString; // Converts string From A URLEncoded string
 writeln(URLDecode(URLEncode(testeransi))); // Converts string To A URLEncoded string

{set s}
 //procedure SplitSet(AText: string; AList: TStringList);
 stl:= TStringlist.Create;
 SplitSet(tester,stl);
 
 writeln(JoinSet(stl));
 writeln(FirstOfSet(tester));
 writeln((LastOfSet(tester)));
 writeln(inttostr(CountOfSet(tester)));
 //SetRotateRight(const AText: string): string;
 //SetRotateLeft(const AText: string): string;
 //SetPick(const AText: string; AIndex: Integer): string;
 Writeln('sort: '+SetSort(tester));
 writeln('union: '+SetUnion(tester, tester2));
 //SetIntersect(const Set1, Set2: string): string;
 writeln('intersect: '+SetIntersect(tester, tester2));
 
 //SetExclude(const Set1, Set2: string): string;
 writeln('exclude: '+SetExclude(tester, tester2));

{replace any <,> etc by &lt; &gt;}
 //XMLSafe(const AText: string): string;

{simple hash, Result can be used in Encrypt}
 //Hash(const AText: string): Integer;

 writeln('hash: '+inttostr(Hash(tester)));
 
 SaveString(exepath+'savestring.txt',tester);
 writeln(dateTimeToStr(Easter(2013)));


{ Base64 encode and decode a string }
 //B64Encode(const S: AnsiString): AnsiString;
 //B64Decode(const S: AnsiString): AnsiString;

{Basic encryption from a Borland Example}
 //Encrypt(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
 //Decrypt(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;

{Using Encrypt and Decrypt in combination with B64Encode and B64Decode}
 //EncryptB64(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
 //DecryptB64(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;

(*procedure CSVToTags(Src, Dst: TStringList);
// converts a csv list to a tagged string list

procedure TagsToCSV(Src, Dst: TStringList);
// converts a tagged string list to a csv list
// only fieldnames from the first record are scanned ib the other records

procedure ListSelect(Src, Dst: TStringList; const AKey, AValue: string);
{selects akey=avalue from Src and returns recordset in Dst}
procedure ListFilter(Src: TStringList; const AKey, AValue: string);
{filters Src for akey=avalue}
procedure ListOrderBy(Src: TStringList; const AKey: string; Numeric: Boolean);
{orders a tagged Src list by akey}

 PosStr(const FindString, SourceString: string;
  StartPos: Integer = 1): Integer;
{ PosStr searches the first occurrence of a substring FindString in a string
  given by SourceString with case sensitivity (upper and lower case characters
  are differed). This  returns the index value of the first character
  of a specified substring from which it occurs in a given string starting with
  StartPos character index. If a specified substring is not found Q_PosStr
  returns zero. The author of algorithm is Peter Morris (UK) (Faststrings unit
  from www.torry.ru). }

 PosStrLast(const FindString, SourceString: string): Integer;
{finds the last occurance}

 LastPosChar(const FindChar: Char; SourceString: string): Integer;

 PosText(const FindString, SourceString: string;
  StartPos: Integer = 1): Integer;
{ PosText searches the first occurrence of a substring FindString in a string
  given by SourceString without case sensitivity (upper and lower case
  characters are not differed). This  returns the index value of the
  first character of a specified substring from which it occurs in a given
  string starting with StartPos character index. If a specified substring is
  not found Q_PosStr returns zero. The author of algorithm is Peter Morris
  (UK) (Faststrings unit from www.torry.ru). }

 PosTextLast(const FindString, SourceString: string): Integer;
{finds the last occurance}

 NameValuesToXML(const AText: string): string;
{$IFDEF MSWINDOWS}
procedure LoadResourceFile(AFile: string; MemStream: TMemoryStream);
{$ENDIF MSWINDOWS}
procedure DirFiles(const ADir, AMask: string; AFileList: TStringList);
procedure RecurseDirFiles(const ADir: string; var AFileList: TStringList);
procedure RecurseDirProgs(const ADir: string; var AFileList: TStringList);
procedure SaveString(const AFile, AText: string);
 LoadString(const AFile: string): string;
 HexToColor(const AText: string): TColor;
 UppercaseHTMLTags(const AText: string): string;
 LowercaseHTMLTags(const AText: string): string;
procedure GetHTMLAnchors(const AFile: string; AList: TStringList);
 RelativePath(const ASrc, ADst: string): string;
 GetToken(var Start: Integer; const SourceText: string): string;
 PosNonSpace(Start: Integer; const SourceText: string): Integer;
 PosEscaped(Start: Integer; const SourceText, FindText: string; EscapeChar: Char): Integer;
 DeleteEscaped(const SourceText: string; EscapeChar: Char): string;
 BeginOfAttribute(Start: Integer; const SourceText: string): Integer;
// parses the beginning of an attribute: space + alpha character
 ParseAttribute(var Start: Integer; const SourceText: string; var AName, AValue: string): Boolean;
// parses a name="value" attribute from Start; returns 0 when not found or else the position behind the attribute
procedure ParseAttributes(const SourceText: string; Attributes: TStrings);
// parses all name=value attributes to the attributes TStringList
 HasStrValue(const AText, AName: string; var AValue: string): Boolean;
// checks if a name="value" pair exists and returns any value
 GetStrValue(const AText, AName, ADefault: string): string;
// retrieves string value from a line like:
//  name="jan verhoeven" email="jan1 dott verhoeven att wxs dott nl"
// returns ADefault when not found
 GetHTMLColorValue(const AText, AName: string; ADefault: TColor): TColor;
// same for a color
 GetIntValue(const AText, AName: string; ADefault: Integer): Integer;
// same for an Integer
 GetFloatValue(const AText, AName: string; ADefault: Extended): Extended;
// same for a float
 GetBoolValue(const AText, AName: string): Boolean;
// same for Boolean but without default
 GetValue(const AText, AName: string): string;
// retrieves string value from a line like:
//  name="jan verhoeven" email="jan1 dott verhoeven att wxs dott nl"
procedure SetValue(var AText: string; const AName, AValue: string);
// sets a string value in a line
procedure DeleteValue(var AText: string; const AName: string);
// deletes a AName="value" pair from AText

procedure GetNames(AText: string; AList: TStringList);
// get a list of names from a string with name="value" pairs
 GetHTMLColor(AColor: TColor): string;
// converts a color value to the HTML hex value
 BackPosStr(Start: Integer; const FindString, SourceString: string): Integer;
// finds a string backward case sensitive
 BackPosText(Start: Integer; const FindString, SourceString: string): Integer;
// finds a string backward case insensitive
 PosRangeStr(Start: Integer; const HeadString, TailString, SourceString: string;
  var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range, e.g. <TD>....</TD> case sensitive
 PosRangeText(Start: Integer; const HeadString, TailString, SourceString: string;
  var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range, e.g. <TD>....</td> case insensitive
 BackPosRangeStr(Start: Integer; const HeadString, TailString, SourceString: string;
  var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range backward, e.g. <TD>....</TD> case sensitive
 BackPosRangeText(Start: Integer; const HeadString, TailString, SourceString: string;
  var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range backward, e.g. <TD>....</td> case insensitive
 PosTag(Start: Integer; SourceString: string; var RangeBegin: Integer;
  var RangeEnd: Integer): Boolean;
// finds a HTML or XML tag:  <....>
 InnerTag(Start: Integer; const HeadString, TailString, SourceString: string;
  var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds the innertext between opening and closing tags
 Easter(NYear: Integer): TDateTime;
// returns the easter date of a year.
 GetWeekNumber(Today: TDateTime): string;
//gets a datecode. Returns year and weeknumber in format: YYWW *)
 Writeln('parse: '+inttoStr(ParseNumber(tester)))
 //ParseNumber(const S: string): Integer;
// parse number returns the last position, starting from 1
 //Writeln(inttostr(ParseDate(tester)));
// parse a SQL style data string from positions 1,
// starts and ends with #   
end;



procedure SetForm;
var
  mbtn, mbtn2: TBitBtn;
  mi, mi1, mi2, mi3: TMenuItem;
  mt: TMainMenu;
  mlbl, mlbl1: TLabel; 

begin
  inFrm:= TForm.Create(self);
  mLbl:= TLabel.create(inFrm);
  mLbl1:= TLabel.create(inFrm);
  mPaint:= TPaintBox.Create(inFrm);
  mPaint2:= TPaintBox.Create(inFrm);
  mPaint3:= TPaintBox.Create(inFrm);
  stat:= TStatusbar.Create(inFrm);
  Lstbox:= TListbox.create(inFrm);
  mymemo:= TMemo.create(inFrm);

  with inFrm do begin
    caption:= '********SortMonster3************';  
    height:= 610;
    width:= 1180;
    //color:= clred;
    Position:= poScreenCenter;
    //onClose:= @CloseClick;
    Show;
  end;
  with mPaint do begin
     Parent:= inFrm;  
     SetBounds(LEFTBASE+20,TOPBASE+70,200,400)
     color:= clsilver;
     Show;
     //onpaint:= @closeclick;
  end; 
  with mPaint2 do begin
     Parent:= inFrm;  
     SetBounds(LEFTBASE+220,TOPBASE+70,200,400)
     color:= clsilver;
     Show;
     //onpaint:= @closeclick;
  end; 
   with mPaint3 do begin
     Parent:= inFrm;  
     SetBounds(LEFTBASE+420,TOPBASE+70,200,400)
     color:= clsilver;
     Show;
     //onpaint:= @closeclick;
  end; 
  
  with mymemo do begin
    Parent:= inFrm;
    SetBounds(LEFTBASE+720, TOPBASE+40, 400, 400)
    font.size:= 14;
    color:= clYellow;
    wordwrap:= true;
    scrollbars:= ssvertical;
  end;
  
  mBtn:= TBitBtn.Create(inFrm)
  with mBtn do begin
    Parent:= inFrm;
    setbounds(LEFTBASE+ 490, TOPBASE+ 460,150, 40);
    caption:= 'Random';
    font.size:= 12;
    glyph.LoadFromResourceName(getHINSTANCE,'CL_MPPAUSE'); 
    //event handler
    onclick:= @GetRandom;
  end;
  mBtn2:= TBitBtn.Create(inFrm)
  with mBtn2 do begin
    Parent:= inFrm;
    setbounds(LEFTBASE+ 330, TOPBASE+460,150, 40);
    caption:= 'Sort';
    font.size:= 12;
    glyph.LoadFromResourceName(getHINSTANCE,'CL_MPEJECT'); 
    //event handler
    onclick:= @BtnSortClick;
  end;
  mBtn3:= TBitBtn.Create(inFrm)
  with mBtn3 do begin
    Parent:= inFrm;
    setbounds(LEFTBASE+ 650, TOPBASE+460,150, 40);
    caption:= 'Start Sort';
    font.size:= 12;
    //glyph.LoadFromResourceName(getHINSTANCE,'PREVIEWGLYPH'); 
    glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTEP'); 
     //event handler
    onclick:= @BtnStartClick;
  end;
  with mlbl do begin
    parent:= inFrm;
    setbounds(LEFTBASE+5,TOPBASE-15,180,20);
    font.size:= 28;
    font.color:= clred;
    //font.style:= [fsunderline]
    caption:= 'SortThreadApp HEX in BOX';
  end;  
  with mlbl1 do begin
    parent:= inFrm;
    setbounds(LEFTBASE+715,TOPBASE-1,180,20);
    font.size:= 20;
    font.color:= clred;
    caption:= 'Text File:';
  end;  
  mt:= TMainMenu.Create(infrm)
  with mt do begin
   //parent:= frmMon;
  end;  
  mi:= TMenuItem.Create(mt)
  mi1:= TMenuItem.Create(mt)
  mi2:= TMenuItem.Create(mt)
  mi3:= TMenuItem.Create(mi)
  with mi do begin
    //parent:= frmMon;
    Caption:='Play Media';
    Name:='ITEM';
    mt.Items.Add(mi);   
    //OnClick:= @GetMediaData;
  end;
  with mi1 do begin
    //parent:= frmMon;
    Caption:='Show Video';
    Name:='ITEM2';
    mt.Items.Add(mi1) ;
    //OnClick:= @GetVideoData
  end;
  with mi2 do begin
    //parent:= frmMon;
    Caption:='Open CD Player';
    Name:='ITEM3';
    mt.Items.Add(mi2);
    //OnClick:= @OPenCD;
  end;
  with mi3 do begin
    Caption:='Open maXbook';
    Name:='ITEM4';
    //mi.Items[0].add(mi3);
  end;
  with Stat do begin
    parent:= inFrm;
    stat.SimplePanel:= true;
  end;
end; 
  var
    //ww: wchar;
     //wa: ansichar;
     wp: pchar;
     app: ___Pointer;   
     
begin
  memo2.font.size:= 14;
  SetForm;
  mymemo.lines.text:= getRandomText;
  //SearchAndOpenDoc(ExePath+MEDIAPATH)
  //mylistview:= TFormListView.Create(self);
  //exit;
  maxform1.color:= clsilver;
  //ansitonative
   //displaystream
  //SQLAddWhere
  //prettynametocolor
         //RGBToHSV
      // hasanychar  
          //writestringtostream
      //ansichar
      //pathdelim
        //drivedelim
        //dectohex
        //xorstring
          //wordcount
            //tformatsettings
            //inttobin
           // ms
             //validfilename
             //loaddll
             //  validdate
             //urlencode
              //trimleftw
             //copydir
             //incsecond
               //inttoextended
      //invalidaterect
      //replacestring
      //stringtoboolean
       //killmessage
         //hash
         //encrypt
         //dirfiles
          //savestring
            //deletedir
            //showtraybar
            //xorstring
  //getshellstring        
  //lzfileexpand;    
   //booltostrJ
   //strlicomp
    //posstr  
    //iszero      
    writeln(inttostr(swap(10)))
    //iserror
    //failed
    //succeeded
    //smallpointtopoint
    //nullrect
    //CreateMappedBmp
    //Truntimeerror
    //app:= inFrm;
    //SetMultiByteConversionCodePage
    //writeln(inttostr(modulecacheid))
    JCLStringsTester;
    bigstring:=  getRandomText;
    Saveln(exepath+'saveyourservants.txt',bigstring);
    maxForm1.tbtnUseCaseClick(self);  
End.

//-------------------------------------------------



source is tlistview
target is tform

procedure TfMerit.SourceLVStartDrag(Sender: TObject;
var DragObject: TDragObject);
var TargetLV:TListView;
begin
// TargetLV:=nejak urcit dle potreby
  TargetLV.BeginDrag(True)
end;

procedure TfMerit.SourceLVMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MouseIsDown:=True;
end;

procedure TfMerit.SourceLVMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseIsDown:=False;
if (Sender as TListView).Dragging then
(Sender as TListView).EndDrag(False);
end;

procedure TfMerit.SourceLVMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if (Sender.ClassNameIs('TListView')) then
begin
if MouseIsDown and ((Sender as TListView).SelCount>0) then
(Sender as TListView).BeginDrag(True);
end;
end;


procedure TfMerit.TargetLVDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var T:TListView;
begin
T:=Sender as TListView;
Accept:=Assigned(T.GetItemAt(X,Y));
end;


procedure TfMerit.TargetLVDragDrop(Sender, Source: TObject; X,
Y: Integer);
var It:TListItem;
LV1,LV2:TListView;
begin
LV1:=Source as TListView;
LV2:=Sender as TListview;

It:=LV2.GetItemAt(X,Y);
if Assigned(It) then
begin
// zpracuj polozku ze zdrojoveho listview
end;
end;


procedure jclstringstester;
begin

{template s}
 ReplaceFirst(const SourceStr, FindStr, ReplaceStr: string): string;
 ReplaceLast(const SourceStr, FindStr, ReplaceStr: string): string;
 InsertLastBlock(var SourceStr: string; BlockStr: string): Boolean;
 RemoveMasterBlocks(const SourceStr: string): string;
 RemoveFields(const SourceStr: string): string;

{http s}
 URLEncode(const Value: AnsiString): AnsiString; // Converts string To A URLEncoded string
 URLDecode(const Value: AnsiString): AnsiString; // Converts string From A URLEncoded string

{set s}
procedure SplitSet(AText: string; AList: TStringList);
 JoinSet(AList: TStringList): string;
 FirstOfSet(const AText: string): string;
 LastOfSet(const AText: string): string;
 CountOfSet(const AText: string): Integer;
 SetRotateRight(const AText: string): string;
 SetRotateLeft(const AText: string): string;
 SetPick(const AText: string; AIndex: Integer): string;
 SetSort(const AText: string): string;
 SetUnion(const Set1, Set2: string): string;
 SetIntersect(const Set1, Set2: string): string;
 SetExclude(const Set1, Set2: string): string;

{replace any <,> etc by &lt; &gt;}
 XMLSafe(const AText: string): string;

{simple hash, Result can be used in Encrypt}
 Hash(const AText: string): Integer;

{ Base64 encode and decode a string }
 B64Encode(const S: AnsiString): AnsiString;
 B64Decode(const S: AnsiString): AnsiString;

{Basic encryption from a Borland Example}
 Encrypt(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
 Decrypt(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;

{Using Encrypt and Decrypt in combination with B64Encode and B64Decode}
 EncryptB64(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
 DecryptB64(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;

procedure CSVToTags(Src, Dst: TStringList);
// converts a csv list to a tagged string list

procedure TagsToCSV(Src, Dst: TStringList);
// converts a tagged string list to a csv list
// only fieldnames from the first record are scanned ib the other records

procedure ListSelect(Src, Dst: TStringList; const AKey, AValue: string);
{selects akey=avalue from Src and returns recordset in Dst}

procedure ListFilter(Src: TStringList; const AKey, AValue: string);
{filters Src for akey=avalue}

procedure ListOrderBy(Src: TStringList; const AKey: string; Numeric: Boolean);
{orders a tagged Src list by akey}

 PosStr(const FindString, SourceString: string;
  StartPos: Integer = 1): Integer;
{ PosStr searches the first occurrence of a substring FindString in a string
  given by SourceString with case sensitivity (upper and lower case characters
  are differed). This  returns the index value of the first character
  of a specified substring from which it occurs in a given string starting with
  StartPos character index. If a specified substring is not found Q_PosStr
  returns zero. The author of algorithm is Peter Morris (UK) (Faststrings unit
  from www.torry.ru). }

 PosStrLast(const FindString, SourceString: string): Integer;
{finds the last occurance}

 LastPosChar(const FindChar: Char; SourceString: string): Integer;

 PosText(const FindString, SourceString: string;
  StartPos: Integer = 1): Integer;
{ PosText searches the first occurrence of a substring FindString in a string
  given by SourceString without case sensitivity (upper and lower case
  characters are not differed). This  returns the index value of the
  first character of a specified substring from which it occurs in a given
  string starting with StartPos character index. If a specified substring is
  not found Q_PosStr returns zero. The author of algorithm is Peter Morris
  (UK) (Faststrings unit from www.torry.ru). }

 PosTextLast(const FindString, SourceString: string): Integer;
{finds the last occurance}

 NameValuesToXML(const AText: string): string;
{$IFDEF MSWINDOWS}
procedure LoadResourceFile(AFile: string; MemStream: TMemoryStream);
{$ENDIF MSWINDOWS}
procedure DirFiles(const ADir, AMask: string; AFileList: TStringList);
procedure RecurseDirFiles(const ADir: string; var AFileList: TStringList);
procedure RecurseDirProgs(const ADir: string; var AFileList: TStringList);
procedure SaveString(const AFile, AText: string);
 LoadString(const AFile: string): string;
 HexToColor(const AText: string): TColor;
 UppercaseHTMLTags(const AText: string): string;
 LowercaseHTMLTags(const AText: string): string;
procedure GetHTMLAnchors(const AFile: string; AList: TStringList);
 RelativePath(const ASrc, ADst: string): string;
 GetToken(var Start: Integer; const SourceText: string): string;
 PosNonSpace(Start: Integer; const SourceText: string): Integer;
 PosEscaped(Start: Integer; const SourceText, FindText: string; EscapeChar: Char): Integer;
 DeleteEscaped(const SourceText: string; EscapeChar: Char): string;
 BeginOfAttribute(Start: Integer; const SourceText: string): Integer;
// parses the beginning of an attribute: space + alpha character
 ParseAttribute(var Start: Integer; const SourceText: string; var AName, AValue: string): Boolean;
// parses a name="value" attribute from Start; returns 0 when not found or else the position behind the attribute
procedure ParseAttributes(const SourceText: string; Attributes: TStrings);
// parses all name=value attributes to the attributes TStringList
 HasStrValue(const AText, AName: string; var AValue: string): Boolean;
// checks if a name="value" pair exists and returns any value
 GetStrValue(const AText, AName, ADefault: string): string;
// retrieves string value from a line like:
//  name="jan verhoeven" email="jan1 dott verhoeven att wxs dott nl"
// returns ADefault when not found
 GetHTMLColorValue(const AText, AName: string; ADefault: TColor): TColor;
// same for a color
 GetIntValue(const AText, AName: string; ADefault: Integer): Integer;
// same for an Integer
 GetFloatValue(const AText, AName: string; ADefault: Extended): Extended;
// same for a float
 GetBoolValue(const AText, AName: string): Boolean;
// same for Boolean but without default
 GetValue(const AText, AName: string): string;
// retrieves string value from a line like:
//  name="jan verhoeven" email="jan1 dott verhoeven att wxs dott nl"
procedure SetValue(var AText: string; const AName, AValue: string);
// sets a string value in a line
procedure DeleteValue(var AText: string; const AName: string);
// deletes a AName="value" pair from AText

procedure GetNames(AText: string; AList: TStringList);
// get a list of names from a string with name="value" pairs
 GetHTMLColor(AColor: TColor): string;
// converts a color value to the HTML hex value
 BackPosStr(Start: Integer; const FindString, SourceString: string): Integer;
// finds a string backward case sensitive
 BackPosText(Start: Integer; const FindString, SourceString: string): Integer;
// finds a string backward case insensitive
 PosRangeStr(Start: Integer; const HeadString, TailString, SourceString: string;
  var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range, e.g. <TD>....</TD> case sensitive
 PosRangeText(Start: Integer; const HeadString, TailString, SourceString: string;
  var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range, e.g. <TD>....</td> case insensitive
 BackPosRangeStr(Start: Integer; const HeadString, TailString, SourceString: string;
  var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range backward, e.g. <TD>....</TD> case sensitive
 BackPosRangeText(Start: Integer; const HeadString, TailString, SourceString: string;
  var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range backward, e.g. <TD>....</td> case insensitive
 PosTag(Start: Integer; SourceString: string; var RangeBegin: Integer;
  var RangeEnd: Integer): Boolean;
// finds a HTML or XML tag:  <....>
 InnerTag(Start: Integer; const HeadString, TailString, SourceString: string;
  var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds the innertext between opening and closing tags
 Easter(NYear: Integer): TDateTime;
// returns the easter date of a year.
 GetWeekNumber(Today: TDateTime): string;
//gets a datecode. Returns year and weeknumber in format: YYWW

 ParseNumber(const S: string): Integer;
// parse number returns the last position, starting from 1
 ParseDate(const S: string): Integer;
// parse a SQL style data string from positions 1,
// starts and ends with #
end;


procedure TControlParentR(Self: TControl; var T:TWinControl); begin T:= Self.Parent; end;
procedure TControlParentW(Self: TControl; T: TWinControl); begin Self.Parent:= T; end;
    RegisterPropertyHelper(@TControlParentR, @TControlParentW, 'PARENT');
    RegisterProperty('Parent', 'TWinControl', iptRW);

procedure TTXPTool.LVPFFDblClick(Sender: TObject);
var
tmpList : TListItem;
fn ; string;
ft : integer;
fs : integer;
begin
tmpList := LVPFF.Selected;
if tmplist<>nil then
begin
  fn := tmpList.Caption
  ft := tmpList.SubItems.Strings[1];
  fs := tmpList.SubItems.Strings[3];
  if pos('Wave', ft)>0 then
    PlayThisOne1Click(nil);
  if pos('Jpg', ft)>0 then
    ShowJpg1Click(nil);
  if pos('Targa', ft)>0 then
    ShowTga1Click(nil);
  if pos('Pcx', ft)>0 then
    ShowPcx1Click(nil);
  if pos('Mission Sound Collection', ft)>0 then
    ShowPwf1Click(nil);
end;
end;


procedure jclutilsnewtest;
begin
function VarIsInt(Value: Variant): Boolean;
 // VarIsInt returns VarIsOrdinal-[varBoolean]

{ PosIdx returns the index of the first appearance of SubStr in Str. The search
  starts at index "Index". }
function PosIdx(const SubStr, S: string; Index: Integer = 0): Integer;
function PosIdxW(const SubStr, S: WideString; Index: Integer = 0): Integer;
function PosLastCharIdx(Ch: Char; const S: string; Index: Integer = 0): Integer;

{ GetWordOnPos returns Word from string, S, on the cursor position, P}
function GetWordOnPos(const S: string; const P: Integer): string;
function GetWordOnPosW(const S: WideString; const P: Integer): WideString;
function GetWordOnPos2(const S: string; P: Integer; var iBeg, iEnd: Integer): string;
function GetWordOnPos2W(const S: WideString; P: Integer; var iBeg, iEnd: Integer): WideString;
{ GetWordOnPosEx working like GetWordOnPos function, but
  also returns Word position in iBeg, iEnd variables }
function GetWordOnPosEx(const S: string; const P: Integer; var iBeg, iEnd: Integer): string;
function GetWordOnPosExW(const S: WideString; const P: Integer; var iBeg, iEnd: Integer): WideString;
function GetNextWordPosEx(const Text: string; StartIndex: Integer;
  var iBeg, iEnd: Integer): string;
function GetNextWordPosExW(const Text: WideString; StartIndex: Integer;
  var iBeg, iEnd: Integer): WideString;
procedure GetEndPosCaret(const Text: string; CaretX, CaretY: Integer;
  var X, Y: Integer);
{ GetEndPosCaret returns the caret position of the last char. For the position
  after the last char of Text you must add 1 to the returned X value. }
procedure GetEndPosCaretW(const Text: WideString; CaretX, CaretY: Integer;
  var X, Y: Integer);
{ GetEndPosCaret returns the caret position of the last char. For the position
  after the last char of Text you must add 1 to the returned X value. }

{ SubStrBySeparator returns substring from string, S, separated with Separator string}
function SubStrBySeparator(const S: string; const Index: Integer; const Separator: string; StartIndex: Integer = 1): string;
function SubStrBySeparatorW(const S: WideString; const Index: Integer; const Separator: WideString; StartIndex: Integer = 1): WideString;
{ SubStrEnd same to previous function but Index numerated from the end of string }
//function SubStrEnd(const S: string; const Index: Integer; const Separator: string): string;
{ SubWord returns next Word from string, P, and offsets Pointer to the end of Word, P2 }
function SubWord(P: PChar; var P2: PChar): string;
//  function CurrencyByWord(Value: Currency): string;
{ GetLineByPos returns the Line number, there
  the symbol Pos is pointed. Lines separated with #13 symbol }
function GetLineByPos(const S: string; const Pos: Integer): Integer;
{ GetXYByPos is same as GetLineByPos, but returns X position in line as well}
procedure GetXYByPos(const S: string; const Pos: Integer; var X, Y: Integer);
procedure GetXYByPosW(const S: WideString; const Pos: Integer; var X, Y: Integer);
{ ReplaceString searches for all substrings, OldPattern,
  in a string, S, and replaces them with NewPattern }
function ReplaceString(S: string; const OldPattern, NewPattern: string; StartIndex: Integer = 1): string;
function ReplaceStringW(S: WideString; const OldPattern, NewPattern: WideString; StartIndex: Integer = 1): WideString;
{ ConcatSep concatenate S1 and S2 strings with Separator.
  if S = '' then separator not included }
function ConcatSep(const S1, S2, Separator: string): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ ConcatLeftSep is same to previous function, but
  strings concatenate right to left }
function ConcatLeftSep(const S1, S2, Separator: string): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}

{ Next 4 function for russian chars transliterating.
  This functions are needed because Oem2Ansi and Ansi2Oem functions
  sometimes suck }
procedure Dos2Win(var S: AnsiString);
procedure Win2Dos(var S: AnsiString);
function Dos2WinRes(const S: AnsiString): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function Win2DosRes(const S: AnsiString): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function Win2Koi(const S: AnsiString): AnsiString;

{ FillString fills the string Buffer with Count Chars }
procedure FillString(var Buffer: string; Count: Integer; const Value: Char); overload;
procedure FillString(var Buffer: string; StartIndex, Count: Integer; const Value: Char); overload;
{ MoveString copies Count Chars from Source to Dest }
procedure MoveString(const Source: string; var Dest: string; Count: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} overload;
procedure MoveString(const Source: string; SrcStartIdx: Integer; var Dest: string;
  DstStartIdx: Integer; Count: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} overload;
{ FillWideChar fills Buffer with Count WideChars (2 Bytes) }
procedure FillWideChar(var Buffer; Count: Integer; const Value: WideChar);
{ MoveWideChar copies Count WideChars from Source to Dest }
procedure MoveWideChar(const Source; var Dest; Count: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ FillNativeChar fills Buffer with Count NativeChars }
procedure FillNativeChar(var Buffer; Count: Integer; const Value: Char); // D2009 internal error {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ MoveWideChar copies Count WideChars from Source to Dest }
procedure MoveNativeChar(const Source; var Dest; Count: Integer); // D2009 internal error {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ IsSubString() compares the sub string to the string. Indices are 1th based. }
function IsSubString(const S: string; StartIndex: Integer; const SubStr: string): Boolean;

{ Spaces returns string consists on N space chars }
function Spaces(const N: Integer): string;
{ AddSpaces adds spaces to string S, if its Length is smaller than N }
function AddSpaces(const S: string; const N: Integer): string;
function SpacesW(const N: Integer): WideString;
function AddSpacesW(const S: WideString; const N: Integer): WideString;
{ function LastDateRUS for russian users only }
{ returns date relative to current date: 'äâà äíÿ íàçàä' }
function LastDateRUS(const Dat: TDateTime): string;
{ CurrencyToStr format Currency, Cur, using ffCurrency float format}
function CurrencyToStr(const Cur: Currency): string;
{ HasChar returns True, if Char, Ch, contains in string, S }
function HasChar(const Ch: Char; const S: string): Boolean;
function HasCharW(const Ch: WideChar; const S: WideString): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function HasAnyChar(const Chars: string; const S: string): Boolean;
{$IFNDEF COMPILER12_UP}
function CharInSet(const Ch: AnsiChar; const SetOfChar: TSysCharSet): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{$ENDIF ~COMPILER12_UP}
function CharInSetW(const Ch: WideChar; const SetOfChar: TSysCharSet): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function CountOfChar(const Ch: Char; const S: string): Integer;
function DefStr(const S: string; Default: string): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}

{ StrLICompW2 is a faster replacement for JclUnicode.StrLICompW }
function StrLICompW2(S1, S2: PWideChar; MaxLen: Integer): Integer;
function StrPosW(S, SubStr: PWideChar): PWideChar;
function StrLenW(S: PWideChar): Integer;
function TrimW(const S: WideString): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function TrimLeftW(const S: WideString): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function TrimRightW(const S: WideString): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{**** files routines}
procedure SetDelimitedText(List: TStrings; const Text: string; Delimiter: Char);

{ GenTempFileName returns temporary file name on
  drive, there FileName is placed }
function GenTempFileName(FileName: string): string;
{ GenTempFileNameExt same to previous function, but
  returning filename has given extension, FileExt }
function GenTempFileNameExt(FileName: string; const FileExt: string): string;
{ ClearDir clears folder Dir }
function ClearDir(const Dir: string): Boolean;
{ DeleteDir clears and than delete folder Dir }
function DeleteDir(const Dir: string): Boolean;
{ FileEquMask returns True if file, FileName,
  is compatible with given dos file mask, Mask }
function FileEquMask(FileName, Mask: TFileName;
  CaseSensitive: Boolean = DefaultCaseSensitivity): Boolean;
{ FileEquMasks returns True if file, FileName,
  is compatible with given Masks.
  Masks must be separated with SepPath (MSW: ';' / UNIX: ':') }
function FileEquMasks(FileName, Masks: TFileName;
  CaseSensitive: Boolean = DefaultCaseSensitivity): Boolean;
function DeleteFiles(const Folder: TFileName; const Masks: string): Boolean;

{$IFDEF MSWINDOWS}
{ LZFileExpand expand file, FileSource,
  into FileDest. Given file must be compressed, using MS Compress program }
function LZFileExpand(const FileSource, FileDest: string): Boolean;
{$ENDIF MSWINDOWS}

{ FileGetInfo fills SearchRec record for specified file attributes}
function FileGetInfo(FileName: TFileName; var SearchRec: TSearchRec): Boolean;
{ HasSubFolder returns True, if folder APath contains other folders }
function HasSubFolder(APath: TFileName): Boolean;
{ IsEmptyFolder returns True, if there are no files or
  folders in given folder, APath}
function IsEmptyFolder(APath: TFileName): Boolean;
{ AddSlash returns string with added slash Char to Dir parameter, if needed }
function AddSlash(const Dir: TFileName): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ AddPath returns FileName with Path, if FileName not contain any path }
function AddPath(const FileName, Path: TFileName): TFileName;
function AddPaths(const PathList, Path: string): string;
function ParentPath(const Path: TFileName): TFileName;
function FindInPath(const FileName, PathList: string): TFileName;
{ DeleteReadOnlyFile clears R/O file attribute and delete file }
function DeleteReadOnlyFile(const FileName: TFileName): Boolean;
{ HasParam returns True, if program running with specified parameter, Param }
function HasParam(const Param: string): Boolean;
function HasSwitch(const Param: string): Boolean;
function Switch(const Param: string): string;
{ ExePath returns ExtractFilePath(ParamStr(0)) }
function ExePath: TFileName; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function CopyDir(const SourceDir, DestDir: TFileName): Boolean;
//function FileTimeToDateTime(const FT: TFileTime): TDateTime;
procedure FileTimeToDosDateTimeDWord(const FT: TFileTime; out Dft: DWORD);
function MakeValidFileName(const FileName: TFileName; ReplaceBadChar: Char): TFileName;

{**** Graphic routines }


{ IsTTFontSelected returns True, if True Type font
  is selected in specified device context }
function IsTTFontSelected(const DC: HDC): Boolean;
function KeyPressed(VK: Integer): Boolean;




{ TrueInflateRect inflates rect in other method, than InflateRect API function }
function TrueInflateRect(const R: TRect; const I: Integer): TRect;
{**** Color routines }
procedure RGBToHSV(R, G, B: Integer; var H, S, V: Integer);
function RGBToBGR(Value: Cardinal): Cardinal;
//function ColorToPrettyName(Value: TColor): string;
//function PrettyNameToColor(const Value: string): TColor;

{**** other routines }
procedure SwapInt(var Int1, Int2: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function IntPower(Base, Exponent: Integer): Integer;
function ChangeTopException(E: TObject): TObject; // Linux version writes error message to ErrOutput
function StrToBool(const S: string): Boolean;

function Var2Type(V: Variant; const DestVarType: Integer): Variant;
function VarToInt(V: Variant): Integer;
function VarToFloat(V: Variant): Double;

{ following functions are not documented
  because they do not work properly sometimes, so do not use them }
// (rom) ReplaceStrings1, GetSubStr removed

function GetLongFileName(const FileName: string): string;
function FileNewExt(const FileName, NewExt: TFileName): TFileName;
function GetParameter: string;
function GetComputerID: string;
function GetComputerName: string;

{**** string routines }

{ ReplaceAllStrings searches for all substrings, Words,
  in a string, S, and replaces them with Frases with the same Index. }
function ReplaceAllStrings(const S: string; Words, Frases: TStrings): string;
{ ReplaceStrings searches the Word in a string, S, on PosBeg position,
  in the list, Words, and if founds, replaces this Word
  with string from another list, Frases, with the same Index,
  and then update NewSelStart variable }
function ReplaceStrings(const S: string; PosBeg, Len: Integer; Words, Frases: TStrings; var NewSelStart: Integer): string;
{ CountOfLines calculates the lines count in a string, S,
  each line must be separated from another with CrLf sequence }
function CountOfLines(const S: string): Integer;
{ DeleteLines deletes all lines from strings which in the words,  words.
  The word of will be deleted from strings. }
procedure DeleteOfLines(Ss: TStrings; const Words: array of string);
{ DeleteEmptyLines deletes all empty lines from strings, Ss.
  Lines contained only spaces also deletes. }
procedure DeleteEmptyLines(Ss: TStrings);
{ SQLAddWhere addes or modifies existing where-statement, where,
  to the strings, SQL.
  Note: If strings SQL allready contains where-statement,
  it must be started on the begining of any line }
procedure SQLAddWhere(SQL: TStrings; const Where: string);

{**** files routines - }

{$IFDEF MSWINDOWS}
{ ResSaveToFile save resource named as Name with Typ type into file FileName.
  Resource can be compressed using MS Compress program}
function ResSaveToFile(const Typ, Name: string; const Compressed: Boolean; const FileName: string): Boolean;
function ResSaveToFileEx(Instance: HINST; Typ, Name: PChar;
  const Compressed: Boolean; const FileName: string): Boolean;
function ResSaveToString(Instance: HINST; const Typ, Name: string;
  var S: string): Boolean;
{$ENDIF MSWINDOWS}
{ IniReadSection read section, Section, from ini-file,
  IniFileName, into strings, Ss.
  This function reads ALL strings from specified section.
  Note: TIninFile.ReadSection function reads only strings with '=' symbol.}
function IniReadSection(const IniFileName: TFileName; const Section: string; Ss: TStrings): Boolean;
{ LoadTextFile load text file, FileName, into string }
function LoadTextFile(const FileName: TFileName): string;
procedure SaveTextFile(const FileName: TFileName; const Source: string);
{ ReadFolder reads files list from disk folder, Folder,
  that are equal to mask, Mask, into strings, FileList}
function ReadFolder(const Folder, Mask: TFileName; FileList: TStrings): Integer;
function ReadFolders(const Folder: TFileName; FolderList: TStrings): Integer;

{ RATextOut same with TCanvas.TextOut procedure, but
  can clipping drawing with rectangle, RClip. }
procedure RATextOut(Canvas: TCanvas; const R, RClip: TRect; const S: string);
{ RATextOutEx same with RATextOut function, but
  can calculate needed height for correct output }
function RATextOutEx(Canvas: TCanvas; const R, RClip: TRect; const S: string; const CalcHeight: Boolean): Integer;
{ RATextCalcHeight calculate needed height for
  correct output, using RATextOut or RATextOutEx functions }
function RATextCalcHeight(Canvas: TCanvas; const R: TRect; const S: string): Integer;
{ Cinema draws some visual effect }
procedure Cinema(Canvas: TCanvas; rS {Source}, rD {Dest}: TRect);
{ Roughed fills rect with special 3D pattern }
procedure Roughed(ACanvas: TCanvas; const ARect: TRect; const AVert: Boolean);
{ BitmapFromBitmap creates new small bitmap from part
  of source bitmap, SrcBitmap, with specified width and height,
  AWidth, AHeight and placed on a specified Index, Index in the
  source bitmap }
function BitmapFromBitmap(SrcBitmap: TBitmap; const AWidth, AHeight, Index: Integer): TBitmap;
{ TextWidth calculate text with for writing using standard desktop font }
function TextWidth(const AStr: string): Integer;
{ TextHeight calculate text height for writing using standard desktop font }
function TextHeight(const AStr: string): Integer;

procedure SetChildPropOrd(Owner: TComponent; const PropName: string; Value: Longint);
procedure Error(const Msg: string);
procedure ItemHtDrawEx(Canvas: TCanvas; Rect: TRect;
  const State: TOwnerDrawState; const Text: string;
  const HideSelColor: Boolean; var PlainItem: string;
  var Width: Integer; CalcWidth: Boolean);
{ example for Text parameter :
  'Item 1 <b>bold</b> <i>italic ITALIC <c:Red>red <c:Green>green <c:blue>blue </i>' }
function ItemHtDraw(Canvas: TCanvas; Rect: TRect;
  const State: TOwnerDrawState; const Text: string;
  const HideSelColor: Boolean): string;
function ItemHtWidth(Canvas: TCanvas; Rect: TRect;
  const State: TOwnerDrawState; const Text: string;
  const HideSelColor: Boolean): Integer;
function ItemHtPlain(const Text: string): string;
{ ClearList - clears list of TObject }
procedure ClearList(List: TList);

procedure MemStreamToClipBoard(MemStream: TMemoryStream; const Format: Word);
procedure ClipBoardToMemStream(MemStream: TMemoryStream; const Format: Word);

{ RTTI support }
function GetPropType(Obj: TObject; const PropName: string): TTypeKind;
function GetPropStr(Obj: TObject; const PropName: string): string;
function GetPropOrd(Obj: TObject; const PropName: string): Integer;
function GetPropMethod(Obj: TObject; const PropName: string): TMethod;

procedure PrepareIniSection(Ss: TStrings);
{ following functions are not documented because
  they are don't work properly, so don't use them }

// (rom) from JvBandWindows to make it obsolete
function PointL(const X, Y: Longint): TPointL; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
// (rom) from JvBandUtils to make it obsolete
function iif(const Test: Boolean; const ATrue, AFalse: Variant): Variant; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}


procedure CopyIconToClipboard(Icon: TIcon; BackColor: TColor);
function CreateIconFromClipboard: TIcon;
{ begin JvIconClipboardUtils }
{ Icon clipboard routines }
function CF_ICON: Word;

procedure AssignClipboardIcon(Icon: TIcon);

{ Real-size icons support routines (32-bit only) }
procedure GetIconSize(Icon: HICON; var W, H: Integer);
function CreateRealSizeIcon(Icon: TIcon): HICON;
procedure DrawRealSizeIcon(Canvas: TCanvas; Icon: TIcon; X, Y: Integer);
{end JvIconClipboardUtils }

function CreateScreenCompatibleDC: HDC;

function InvalidateRect(hWnd: HWND; const lpRect: TRect; bErase: BOOL): BOOL; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}

{ begin JvRLE }

// (rom) changed API for inclusion in JCL

procedure RleCompressTo(InStream, OutStream: TStream);
procedure RleDecompressTo(InStream, OutStream: TStream);
procedure RleCompress(Stream: TStream);
procedure RleDecompress(Stream: TStream);
{ end JvRLE }

{ begin JvDateUtil }
function CurrentYear: Word; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function IsLeapYear(AYear: Integer): Boolean;
function DaysInAMonth(const AYear, AMonth: Word): Word;
function DaysPerMonth(AYear, AMonth: Integer): Integer;
function FirstDayOfPrevMonth: TDateTime;
function LastDayOfPrevMonth: TDateTime;
function FirstDayOfNextMonth: TDateTime;
function ExtractDay(ADate: TDateTime): Word;
function ExtractMonth(ADate: TDateTime): Word;
function ExtractYear(ADate: TDateTime): Word;
function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
function IncDay(ADate: TDateTime; Delta: Integer): TDateTime; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
function ValidDate(ADate: TDateTime): Boolean;
procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
function MonthsBetween(Date1, Date2: TDateTime): Double;
function DaysInPeriod(Date1, Date2: TDateTime): Longint;
{ Count days between Date1 and Date2 + 1, so if Date1 = Date2 result = 1 }
function DaysBetween(Date1, Date2: TDateTime): Longint;
{ The same as previous but if Date2 < Date1 result = 0 }
function IncTime(ATime: TDateTime; Hours, Minutes, Seconds, MSecs: Integer): TDateTime;
function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
function CutTime(ADate: TDateTime): TDateTime; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} { Set time to 00:00:00:00 }

{ String to date conversions }
function GetDateOrder(const DateFormat: string): TDateOrder;
function MonthFromName(const S: string; MaxLen: Byte): Byte;
function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
function StrToDateFmt(const DateFormat, S: string): TDateTime;
function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
//function DefDateFormat(AFourDigitYear: Boolean): string;
//function DefDateMask(BlanksChar: Char; AFourDigitYear: Boolean): string;

function FormatLongDate(Value: TDateTime): string;
function FormatLongDateTime(Value: TDateTime): string;
{ end JvDateUtil }
function BufToBinStr(Buf: Pointer; BufSize: Integer): string;
function BinStrToBuf(Value: string; Buf: Pointer; BufSize: Integer): Integer;


{ begin JvStrUtils }


function StrToOem(const AnsiStr: AnsiString): AnsiString;
{ StrToOem translates a string from the Windows character set into the
  OEM character set. }
function OemToAnsiStr(const OemStr: AnsiString): AnsiString;
{ OemToAnsiStr translates a string from the OEM character set into the
  Windows character set. }
function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
{ EmptyStr returns True if the given string contains only character
  from the EmptyChars. }
function ReplaceStr(const S, Srch, Replace: string): string;
{ Returns string with every occurrence of Srch string replaced with
  Replace string. }
function DelSpace(const S: string): string;
{ DelSpace return a string with all white spaces removed. }
function DelChars(const S: string; Chr: Char): string;
{ DelChars return a string with all Chr characters removed. }
function DelBSpace(const S: string): string;
{ DelBSpace trims leading spaces from the given string. }
function DelESpace(const S: string): string;
{ DelESpace trims trailing spaces from the given string. }
function DelRSpace(const S: string): string;
{ DelRSpace trims leading and trailing spaces from the given string. }
function DelSpace1(const S: string): string;
{ DelSpace1 return a string with all non-single white spaces removed. }
function Tab2Space(const S: string; Numb: Byte): string;
{ Tab2Space converts any tabulation character in the given string to the
  Numb spaces characters. }
function NPos(const C: string; S: string; N: Integer): Integer;
{ NPos searches for a N-th position of substring C in a given string. }
function MakeStr(C: Char; N: Integer): string; overload;
{$IFNDEF COMPILER12_UP}
function MakeStr(C: WideChar; N: Integer): WideString; overload;
{$ENDIF !COMPILER12_UP}
function MS(C: Char; N: Integer): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ MakeStr return a string of length N filled with character C. }
function AddChar(C: Char; const S: string; N: Integer): string;
{ AddChar return a string left-padded to length N with characters C. }
function AddCharR(C: Char; const S: string; N: Integer): string;
{ AddCharR return a string right-padded to length N with characters C. }
function LeftStr(const S: string; N: Integer): string;
{ LeftStr return a string right-padded to length N with blanks. }
function RightStr(const S: string; N: Integer): string;
{ RightStr return a string left-padded to length N with blanks. }
function CenterStr(const S: string; Len: Integer): string;
{ CenterStr centers the characters in the string based upon the
  Len specified. }
function CompStr(const S1, S2: string): Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ CompStr compares S1 to S2, with case-sensitivity. The return value is
  -1 if S1 < S2, 0 if S1 = S2, or 1 if S1 > S2. }
function CompText(const S1, S2: string): Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ CompText compares S1 to S2, without case-sensitivity. The return value
  is the same as for CompStr. }
function Copy2Symb(const S: string; Symb: Char): string;
{ Copy2Symb returns a substring of a string S from begining to first
  character Symb. }
function Copy2SymbDel(var S: string; Symb: Char): string;
{ Copy2SymbDel returns a substring of a string S from begining to first
  character Symb and removes this substring from S. }
function Copy2Space(const S: string): string;
{ Copy2Symb returns a substring of a string S from begining to first
  white space. }
function Copy2SpaceDel(var S: string): string;
{ Copy2SpaceDel returns a substring of a string S from begining to first
  white space and removes this substring from S. }
function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
{ Returns string, with the first letter of each word in uppercase,
  all other letters in lowercase. Words are delimited by WordDelims. }
function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
{ WordCount given a set of word delimiters, returns number of words in S. }
function WordPosition(const N: Integer; const S: string;
  const WordDelims: TSysCharSet): Integer;
{ Given a set of word delimiters, returns start position of N'th word in S. }
function ExtractWord(N: Integer; const S: string;
  const WordDelims: TSysCharSet): string;
function ExtractWordPos(N: Integer; const S: string;
  const WordDelims: TSysCharSet; var Pos: Integer): string;
function ExtractDelimited(N: Integer; const S: string;
  const Delims: TSysCharSet): string;
{ ExtractWord, ExtractWordPos and ExtractDelimited given a set of word
  delimiters, return the N'th word in S. }
function ExtractSubstr(const S: string; var Pos: Integer;
  const Delims: TSysCharSet): string;
{ ExtractSubstr given a set of word delimiters, returns the substring from S,
  that started from position Pos. }
function IsWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean;
{ IsWordPresent given a set of word delimiters, returns True if word W is
  present in string S. }
function QuotedString(const S: string; Quote: Char): string;
{ QuotedString returns the given string as a quoted string, using the
  provided Quote character. }
function ExtractQuotedString(const S: string; Quote: Char): string;
{ ExtractQuotedString removes the Quote characters from the beginning and
  end of a quoted string, and reduces pairs of Quote characters within
  the quoted string to a single character. }
function FindPart(const HelpWilds, InputStr: string): Integer;
{ FindPart compares a string with '?' and another, returns the position of
  HelpWilds in InputStr. }
function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
{ IsWild compares InputString with WildCard string and returns True
  if corresponds. }
function XorString(const Key, Src: ShortString): ShortString;
function XorEncode(const Key, Source: string): string;
function XorDecode(const Key, Source: string): string;

{ ** Command line routines ** }

function GetCmdLineArg(const Switch: string; ASwitchChars: TSysCharSet): string;

{ ** Numeric string handling routines ** }

function Numb2USA(const S: string): string;
{ Numb2USA converts numeric string S to USA-format. }
function Dec2Hex(N: Longint; A: Byte): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ Dec2Hex converts the given value to a hexadecimal string representation
  with the minimum number of digits (A) specified. }
function Hex2Dec(const S: string): Longint;
{ Hex2Dec converts the given hexadecimal string to the corresponding integer
  value. }
function Dec2Numb(N: Int64; A, B: Byte): string;
{ Dec2Numb converts the given value to a string representation with the
  base equal to B and with the minimum number of digits (A) specified. }
function Numb2Dec(S: string; B: Byte): Int64;
{ Numb2Dec converts the given B-based numeric string to the corresponding
  integer value. }
function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
{ IntToBin converts the given value to a binary string representation
  with the minimum number of digits specified. }
function IntToRoman(Value: Longint): string;
{ IntToRoman converts the given value to a roman numeric string
  representation. }
function RomanToInt(const S: string): Longint;
{ RomanToInt converts the given string to an integer value. If the string
  doesn't contain a valid roman numeric value, the 0 value is returned. }

function FindNotBlankCharPos(const S: string): Integer;
function FindNotBlankCharPosW(const S: WideString): Integer;
function AnsiChangeCase(const S: string): string;
function WideChangeCase(const S: string): string;

function StartsText(const SubStr, S: string): Boolean;
function EndsText(const SubStr, S: string): Boolean;

function DequotedStr(const S: string; QuoteChar: Char = ''''): string;
function AnsiDequotedStr(const S: string; AQuote: Char): string; // follow Delphi 2009's "Ansi" prefix

{end JvStrUtils}

{$IFDEF UNIX}
function GetTempFileName(const Prefix: AnsiString): AnsiString;
{$ENDIF UNIX}

{ begin JvFileUtil }
function FileDateTime(const FileName: string): TDateTime;
function HasAttr(const FileName: string; Attr: Integer): Boolean;
function DeleteFilesEx(const FileMasks: array of string): Boolean;
function NormalDir(const DirName: string): string;
function RemoveBackSlash(const DirName: string): string; // only for Windows/DOS Paths
function ValidFileName(const FileName: string): Boolean;

{$IFDEF MSWINDOWS}
function FileLock(Handle: Integer; Offset, LockSize: Longint): Integer; overload;
function FileLock(Handle: Integer; Offset, LockSize: Int64): Integer; overload;
function FileUnlock(Handle: Integer; Offset, LockSize: Longint): Integer; overload;
function FileUnlock(Handle: Integer; Offset, LockSize: Int64): Integer; overload;
{$ENDIF MSWINDOWS}
function GetWindowsDir: string;
function GetSystemDir: string;

function ShortToLongFileName(const ShortName: string): string;
function LongToShortFileName(const LongName: string): string;
function ShortToLongPath(const ShortName: string): string;
function LongToShortPath(const LongName: string): string;
{$IFDEF MSWINDOWS}
procedure CreateFileLink(const FileName, DisplayName: string; Folder: Integer);
procedure DeleteFileLink(const DisplayName: string; Folder: Integer);
{$ENDIF MSWINDOWS}

{ end JvFileUtil }

// Works like PtInRect but includes all edges in comparision
function PtInRectInclusive(R: TRect; Pt: TPoint): Boolean;
// Works like PtInRect but excludes all edges from comparision
function PtInRectExclusive(R: TRect; Pt: TPoint): Boolean;

function FourDigitYear: Boolean; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF}
function IsFourDigitYear: Boolean;

{ moved from JvJVCLUTils }

//Open an object with the shell (url or something like that)
function OpenObject(const Value: string): Boolean; overload;
function OpenObject(Value: PChar): Boolean; overload;

{$IFDEF MSWINDOWS}
//Raise the last Exception
procedure RaiseLastWin32; overload;
procedure RaiseLastWin32(const Text: string); overload;
//Raise the last Exception with a small comment from your part

{ GetFileVersion returns the most significant 32 bits of a file's binary
  version number. Typically, this includes the major and minor version placed
  together in one 32-bit Integer. It generally does not include the release
  or build numbers. It returns 0 if it failed. }
function GetFileVersion(const AFileName: string): Cardinal;

//Get version of Shell.dll
function GetShellVersion: Cardinal;

// CD functions
procedure OpenCdDrive;
procedure CloseCdDrive;

// returns True if Drive is accessible
function DiskInDrive(Drive: Char): Boolean;
{$ENDIF MSWINDOWS}

//Same as linux function ;)
procedure PError(const Text: string);

// execute a program without waiting
procedure Exec(const FileName, Parameters, Directory: string);
// execute a program and wait for it to finish
function ExecuteAndWait(CommandLine: string; const WorkingDirectory: string; Visibility: Integer = SW_SHOW): Integer;


// returns True if this is the first instance of the program that is running
function FirstInstance(const ATitle: string): Boolean;
// restores a window based on it's classname and Caption. Either can be left empty
// to widen the search
procedure RestoreOtherInstance(const MainFormClassName, MainFormCaption: string);

// manipulate the traybar and start button
procedure HideTraybar;
procedure ShowTraybar;
procedure ShowStartButton(Visible: Boolean = True);

// (rom) SC_MONITORPOWER is documented as Windows 95 only
// (rom) better do some testing
// set monitor functions
procedure MonitorOn;
procedure MonitorOff;
procedure LowPower;

// send a key to the window named AppName
function SendKey(const AppName: string; Key: Char): Boolean;

{$IFDEF MSWINDOWS}

// returns a list of all windows currently visible, the Objects property is filled with their window handle
procedure GetVisibleWindows(List: TStrings);
// associates an extension to a specific program
procedure AssociateExtension(const IconPath, ProgramName, Path, Extension: string);

procedure AddToRecentDocs(const FileName: string);
function GetRecentDocs: TStringList;
{$ENDIF MSWINDOWS}


function CharIsMoney(const Ch: Char): Boolean;

{ there is a STrToIntDef provided by Delphi, but no "safe" versions of
  StrToFloat or StrToCurr }
// Note: before using JvSafeStrToFloatDef, please be aware that it will ignore
// any character that is not a valid character for a float, which is different
// from what StrToFloatDef in Delphi 6 up is doing. This has been documented in Mantis
// issue# 2935: http://issuetracker.delphi-jedi.org/view.php?id=2935
// and in Mantis 4466: http://issuetracker.delphi-jedi.org/view.php?id=4466

//function JvSafeStrToFloatDef(const Str: string; Def: Extended; aDecimalSeparator: Char = ' '): Extended; {NOTE: default value of Space is a magic wildcard}

//function JvSafeStrToFloat(const Str: string; aDecimalSeparator: Char = ' '): Extended; {NOTE: default value of Space is a magic wildcard}


//function StrToCurrDef(const Str: string; Def: Currency): Currency;
function IntToExtended(I: Integer): Extended;

{ GetChangedText works out the new text given the current cursor pos & the key pressed
  It is not very useful in other contexts,
  but it is in this unit as it is needed in both MemoEx and TypedEdit }
function GetChangedText(const Text: string; SelStart, SelLength: Integer; Key: Char): string;

function MakeYear4Digit(Year, Pivot: Integer): Integer;

//function StrIsInteger(const S: string): Boolean;
function StrIsFloatMoney(const Ps: string): Boolean;
function StrIsDateTime(const Ps: string): Boolean;

function PreformatDateString(Ps: string): string;

function BooleanToInteger(const B: Boolean): Integer;
function StringToBoolean(const Ps: string): Boolean;

function SafeStrToDateTime(const Ps: string): TDateTime;
function SafeStrToDate(const Ps: string): TDateTime;
function SafeStrToTime(const Ps: string): TDateTime;

function StrDelete(const psSub, psMain: string): string;

  { returns the fractional value of pcValue}
function TimeOnly(pcValue: TDateTime): TTime;
{ returns the integral value of pcValue }
function DateOnly(pcValue: TDateTime): TDate;

type
  TdtKind = (dtkDateOnly, dtkTimeOnly, dtkDateTime);

const
  { TDateTime value used to signify Null value}
  NullEquivalentDate: TDateTime = 0.0;

function DateIsNull(const pdtValue: TDateTime; const pdtKind: TdtKind): Boolean;
// Replacement for Win32Check to avoid platform specific warnings in D6
function OSCheck(RetVal: Boolean): Boolean;

{ Shortens a fully qualified Path name so that it can be drawn with a specified length limit.
  Same as FileCtrl.MinimizeName in functionality (but not implementation). Included here to
  not be forced to use FileCtrl unnecessarily }
function MinimizeFileName(const FileName: string; Canvas: TCanvas; MaxLen: Integer): string;
function MinimizeText(const Text: string; Canvas: TCanvas; MaxWidth: Integer): string;
{ MinimizeString trunactes long string, S, and appends
  '...' symbols, if Length of S is more than MaxLen }
function MinimizeString(const S: string; const MaxLen: Integer): string;

{$IFDEF MSWINDOWS}
{ RunDLL32 runs a function in a DLL using the utility rundll32.exe (on NT) or rundll.exe (on Win95/98)
 ModuleName is the name of the DLL to load, FuncName is the function to call and CmdLine is
 the command-line parameters (if any) to send to the function. Set WaitForCompletion to False to
 return immediately after the call.
 CmdShow should be one of the SW_SHOWXXXX constants and defaults SW_SHOWDEFAULT
 Return value:
 if WaitForCompletion is True, returns True if the wait didn't return WAIT_FAILED
 if WaitForCompletion is False, returns True if the process could be created
 To get information on why RunDLL32 might have failed, call GetLastError
 To get more info on what can actually be called using rundll32.exe, take a look at
 http://www.dx21.com/SCRIPTING/RUNDLL32/REFGUIDE.ASP?NTI=4&SI=6
}
type
  // the signature of procedures in DLL's that can be called using rundll32.exe
  TRunDLL32Proc = procedure(Handle: THandle; HInstance: HMODULE; CmdLine: PChar; CmdShow: Integer); stdcall;

function RunDLL32(const ModuleName, FuncName, CmdLine: string; WaitForCompletion: Boolean; CmdShow:
procedure RunDll32Internal(Wnd: THandle; const DLLName, FuncName, CmdLine: string; CmdShow: Integer = SW_SHOWDEFAULT);
{ GetDLLVersion loads DLLName, gets a pointer to the DLLVersion function and calls it, returning the major and minor version values
from the function. Returns False if the DLL couldn't be loaded or if GetDLLVersion couldn't be found. }
function GetDLLVersion(const DLLName: string; var pdwMajor, pdwMinor: Integer): Boolean;
{$ENDIF MSWINDOWS}

procedure ResourceNotFound(ResID: PChar);
function EmptyRect: TRect;
function RectWidth(R: TRect): Integer;
function RectHeight(R: TRect): Integer;
function CompareRect(const R1, R2: TRect): Boolean;
procedure RectNormalize(var R: TRect);
function RectIsSquare(const R: TRect): Boolean;
function RectSquare(var ARect: TRect; AMaxSize: Integer = -1): Boolean;
//If AMaxSize = -1 ,then auto calc Square's max size

{$IFDEF MSWINDOWS}
procedure FreeUnusedOle;
function GetWindowsVersion: string;
function LoadDLL(const LibName: string): THandle;
function RegisterServer(const ModuleName: string): Boolean;
function UnregisterServer(const ModuleName: string): Boolean;
{$ENDIF MSWINDOWS}

{ String routines }
function GetEnvVar(const VarName: string): string;
function AnsiUpperFirstChar(const S: string): string; // follow Delphi 2009's example with the "Ansi" prefix
function StringToPChar(var S: string): PChar;
function StrPAlloc(const S: string): PChar;
procedure SplitCommandLine(const CmdLine: string; var ExeName, Params: string);
function DropT(const S: string): string;

{ Memory routines }

function AllocMemo(Size: Longint): Pointer;
function ReallocMemo(fpBlock: Pointer; Size: Longint): Pointer;
procedure FreeMemo(var fpBlock: Pointer);
function GetMemoSize(fpBlock: Pointer): Longint;
function CompareMem(fpBlock1, fpBlock2: Pointer; Size: Cardinal): Boolean;

{ Manipulate huge pointers routines }

procedure HugeInc(var HugePtr: Pointer; Amount: Longint);
procedure HugeDec(var HugePtr: Pointer; Amount: Longint);
function HugeOffset(HugePtr: Pointer; Amount: Longint): Pointer;
procedure HugeMove(Base: Pointer; Dst, Src, Size: Longint);
procedure HMemCpy(DstPtr, SrcPtr: Pointer; Amount: Longint);

function WindowClassName(Wnd: THandle): string;

procedure SwitchToWindow(Wnd: THandle; Restore: Boolean);
procedure ActivateWindow(Wnd: THandle);
procedure ShowWinNoAnimate(Handle: THandle; CmdShow: Integer);
procedure KillMessage(Wnd: THandle; Msg: Cardinal);

{ SetWindowTop put window to top without recreating window }
procedure SetWindowTop(const Handle: THandle; const Top: Boolean);
procedure CenterWindow(Wnd: THandle);
function MakeVariant(const Values: array of Variant): Variant;

{ Convert dialog units to pixels and backwards }

{$IFDEF MSWINDOWS}
function DialogUnitsToPixelsX(DlgUnits: Word): Word;
function DialogUnitsToPixelsY(DlgUnits: Word): Word;
function PixelsToDialogUnitsX(PixUnits: Word): Word;
function PixelsToDialogUnitsY(PixUnits: Word): Word;
{$ENDIF MSWINDOWS}

function GetUniqueFileNameInDir(const Path, FileNameMask: string): string;

{$IFDEF BCB}
function FindPrevInstance(const MainFormClass: ShortString;
  const ATitle: string): THandle;
function ActivatePrevInstance(const MainFormClass: ShortString;
  const ATitle: string): Boolean;
{$ELSE}
function FindPrevInstance(const MainFormClass, ATitle: string): THandle;
function ActivatePrevInstance(const MainFormClass, ATitle: string): Boolean;
{$ENDIF BCB}


{$IFDEF MSWINDOWS}
{ BrowseForFolderNative displays Browse For Folder dialog }
function BrowseForFolderNative(const Handle: THandle; const Title: string; var Folder: string): Boolean;
{$ENDIF MSWINDOWS}


procedure AntiAlias(Clip: TBitmap);
procedure AntiAliasRect(Clip: TBitmap; XOrigin, YOrigin,
  XFinal, YFinal: Integer);

procedure CopyRectDIBits(ACanvas: TCanvas; const DestRect: TRect;
  ABitmap: TBitmap; const SourceRect: TRect);
function IsTrueType(const FontName: string): Boolean;


// Removes all non-numeric characters from AValue and returns
// the resulting string
function TextToValText(const AValue: string): string;


// VisualCLX compatibility functions
function DrawText(DC: HDC; const Text: TCaption; Len: Integer; var R: TRect; WinFlags: Integer): Integer; overload;
function DrawText(Canvas: TCanvas; const Text: string; Len: Integer; var R: TRect; WinFlags: Integer): Integer; overload;
function DrawText(Canvas: TCanvas; Text: PAnsiChar; Len: Integer; var R: TRect; WinFlags: Integer): Integer; overload;
function DrawTextEx(Canvas: TCanvas; lpchText: PChar; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer; overload;
function DrawTextEx(Canvas: TCanvas; const Text: string; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer; overload;
function DrawText(Canvas: TCanvas; const Text: WideString; Len: Integer; var R: TRect; WinFlags: Integer): Integer; overload;
function DrawTextEx(Canvas: TCanvas; const Text: WideString; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer; overload;

function DrawTextW(Canvas: TCanvas; const Text: WideString; Len: Integer; var R: TRect; WinFlags: Integer): Integer; overload;
function DrawTextW(Canvas: TCanvas; Text: PWideChar; Len: Integer; var R: TRect; WinFlags: Integer): Integer; overload;
function DrawTextExW(Canvas: TCanvas; lpchText: PWideChar; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer; overload;
function DrawTextExW(Canvas: TCanvas; const Text: WideString; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer; overload;
end;



Changes to V3.9   (five !!)



//NoErrMsg variable
//- Controls whether the application displays an error message when a runtime error
//occurs.

{CompareValue function
- Returns the relationship between two numeric values.}

{SameValue function
- Indicates whether two floating-point values are (approximately) equal.}

{Sign function
- Indicates whether a numeric value is positive, negative, or zero.}

{SimpleRoundTo function
- Rounds a floating-point value to a specified digit or power of ten using
asymmetric arithmetic rounding.}

{AddExitProc procedure
- Add procedure to exit list.}
{ExitCode variable
- Contains the application's exit code.}
{UnicodeToUtf8 function
- Converts a string of Unicode characters into a UTF-8 string.}
{WideCharToStrVar procedure
- Converts Unicode string to a single or multi byte character data.}
{CreateClassID function
- CreateClassID generates a new GUID and returns it as a string.
{OleStrToString function
- Copies data received from a COM interface to a string.
{Supports function
- Indicates whether a given object or interface supports a specified interface.
{VarComplexToPolar procedure
- Computes the polar coordinates that correspond to a custom Variant that
represents a complex number.}
FindDatabaseID function
- Returns the ID of a specified database.

FindFieldID function
- Returns the ID of a specified field.

FindTableID function
- Returns the ID of a specified table.

GetAttrID function
- Returns the ID of the attribute set associated with a field.
{AnsiToNative function
- Converts a string from the ANSI character set to the character set associated
with a given locale.}
{NativeCompareStr function
- Compares strings based on a database locale case sensitively.

NativeCompareStrBuf function
- Compares null-terminated strings based on a database locale case sensitively.
{PasswordDialog function
- Displays a dialog box that prompts the user for the password of a local
password-protected table.}
{CheckSqlTimeStamp procedure
- Checks whether a TSQLTimeStamp value represents a valid date and time.}
{DateTimeToSQLTimeStamp function
- Converts a TDateTime value to a TSQLTimeStamp value.}
{NullSQLTimeStamp constant
- Represents a NULL TSQLTimeStamp value.}
{IsAbortResult function
- Checks the return value from a modal form dialog and indicates whether the user
selected Abort or Cancel.}
{LoginDialog function
- Brings up the database Login dialog to allow the user to connect to a database
server.

LoginDialogEx function
- Brings up the database Login dialog to allow the user to connect to a database
server.    }
{RemoteLoginDialog function
- Brings up the database Login dialog to allow the user to connect to a database
server. }
{StripAllFromResult function
- Converts a TModalResult value from a constant that refers to “all” to the
corresponding simple constant.}
{AcquireExceptionObject function
- Allows an exception object to persist after the except clause exits.}
(*ExtractShortPathName function
- Converts a file name to the short 8.3 form.

IncludeTrailingBackslash function
- Ensures path name ends with delimiter

IncludeTrailingPathDelimiter function
- Ensures path name ends with delimiter.

IsPathDelimiter function
- Indicates whether the byte at position Index of a string is the path delimiter.*)
{FloatToTextFmt function
- Converts a floating-point value to to an unterminated character string, using
a specified format.    }
(*CreateGrayMappedRes function
- Remaps the standard gray colors in a bitmap resource with the system grays.

CreateMappedBmp function
- Changes the color table in a bitmap.       *)
{GetDefFontCharSet function
- Returns the character set of the default system font.}
{GraphicExtension function
- Returns the default file-name extension of a graphics object.}
{GraphicFilter function
- Returns a file filter compatible with the Filter property of an Open or Save
dialog.}
{GetExtensionVersion function
- Returns the name and version number of an ISAPI or NSAPI application.}
{Rename procedure
- Changes the name of an external file.}  // there are 2 renames!!
{Truncate procedure
- Deletes all the records after the current file position.}
SameFileName function
- Compares file names based on the current locale.*)
{DefaultTextLineBreakStyle variable
- Specifies the characters that are used by default to separate lines in text.}
{GetEnvironmentVariable function
- Returns environment variable value..!!!}
{Slice function
- Returns a sub-section of an array.}
{UnloadPackage procedure
- Unloads a package.         !!!}
{Exclude procedure
- Removes an element from a set.}

{Include procedure
- Adds an element to a set.!!!}
{FindClass function
- Finds and returns a class that is derived from TPersistent.}
{FindClassHInstance function
- Returns the instance handle for the module in which a class type is defined.
{GetClass function
- Returns a registered persistent class given its name.
IntToIdent function
- Uses a mapping array to convert integers into their corresponding string
identifiers.  }
{BeginThread function
- Spawns a separate thread of execution.

CheckSynchronize function
- Allows background threads to synchronize their execution with the main thread.

EndThread function
- Terminates the execution of a thread.

ForegroundTask function
- Indicates whether the current thread is running in the foreground.

IsMultiThread variable
- Indicates whether the application spawned additional threads using BeginThread
or TThread objects.

WakeMainThread variable
- Represents a method (event handler) that is forced into the main thread’s queue.
{FindCustomVariantType function
- Retrieves the object that implements a custom Variant type.

GetVariantManager procedure
- Returns the entry points of the routines that define variant behavior.

IsVariantManagerSet function
- Indicates whether variant support is implemented in an application.}
{VarToStr function
- Converts a variant to a string.  !!!}
AllocateHwnd function
- Creates a window that implements a specified window procedure.
DestroyMetaPict procedure
- Frees a metafile resource given its handle.
NewStyleControls variable
- Determines whether controls are drawn using the Windows 3.x “look”.}
SameNamespace function
- Indicates whether a specified node is defined within a specified namespace.


from db.pas

     FILE_PATH = 'E:\maxbox\maxbox3\examples\271_closures_study.txt';

var
  LoginDialogProc: function (const ADatabaseName: string; var AUserName, APassword: string): Boolean;
  LoginDialogExProc: function (const ADatabaseName: string; var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
  RemoteLoginDialogProc: function (var AUserName, APassword: string): Boolean;
  ScreenCursorProc: procedure (const CurIndex : integer);
  PasswordDialog: function (const ASession: IDBSession): Boolean;
  DBScreen: IDBScreen;
  DBApplication: IDBApplication;

{ Global Functions }

function ExtractFieldName(const Fields: string; var Pos: Integer): string; overload; deprecated;
function ExtractFieldName(const Fields: WideString; var Pos: Integer): WideString; overload;
procedure RegisterFields(const FieldClasses: array of TFieldClass);

procedure DatabaseError(const Message: WideString; Component: TComponent = nil);
procedure DatabaseErrorFmt(const Message: WIdeString; const Args: array of const;
  Component: TComponent = nil);

procedure DisposeMem(var Buffer; Size: Integer);
function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
{ moved to FmtBcd.pas
function BCDToCurr(const BCD: TBcd; var Curr: Currency): Boolean;
function CurrToBCD(Curr: Currency; var BCD: TBcd; Precision: Integer = 32;
  Decimals: Integer = 4): Boolean; }

function GetFieldProperty(DataSet: TDataSet; Control: TComponent;
  const FieldName: WideString): TField;

function VarTypeToDataType(VarType: Integer): TFieldType;

implementation


uPSI_DB.pas

unit uPSI_DBLogDlg;

unit uPSI_SqlTimSt;

unit uPSI_DBTables;

icons in usecase

new units in 3.9

jvcomponentbase
JvResources, JvgUtils_max;
unit JvStrUtil_max;

unit JvStrings;
123 unit uPSI_JvJCLUtils;



IToString = interface
    ['{C4ABABB4-1029-46E7-B5FA-99800F130C05}']
    function ToString: string;
  end;

  TCharDynArray = array of Char;

  // The TStringBuilder class is a Delphi implementation of the .NET
  // System.Text.StringBuilder.
  // It is zero based and the method that allow an TObject (Append, Insert,
  // AppendFormat) are limited to IToString implementors.
  // This class is not threadsafe. Any instance of TStringBuilder should not
  // be used in different threads at the same time.
  TJclStringBuilder = class(TInterfacedObject, IToString)
  private
    FChars: TCharDynArray;
    FLength: SizeInt;
    FMaxCapacity: SizeInt;

    function GetCapacity: SizeInt;
    procedure SetCapacity(const Value: SizeInt);
    function GetChars(Index: SizeInt): Char;
    procedure SetChars(Index: SizeInt; const Value: Char);
    procedure Set_Length(const Value: SizeInt);
  protected
    function AppendPChar(Value: PChar; Count: SizeInt; RepeatCount: SizeInt = 1): TJclStringBuilder;
    function InsertPChar(Index: SizeInt; Value: PChar; Count: SizeInt; RepeatCount: SizeInt = 1): TJclStringBuilder;
  public
    constructor Create(const Value: string; Capacity: SizeInt = 16); overload;
    constructor Create(Capacity: SizeInt = 16; MaxCapacity: SizeInt = MaxInt); overload;
    constructor Create(const Value: string; StartIndex, Length, Capacity: SizeInt); overload;

    function Append(const Value: string): TJclStringBuilder; overload;
    function Append(const Value: string; StartIndex, Length: SizeInt): TJclStringBuilder; overload;
    function Append(Value: Boolean): TJclStringBuilder; overload;
    function Append(Value: Char; RepeatCount: SizeInt = 1): TJclStringBuilder; overload;
    function Append(const Value: array of Char): TJclStringBuilder; overload;
    function Append(const Value: array of Char; StartIndex, Length: SizeInt): TJclStringBuilder; overload;
    function Append(Value: Cardinal): TJclStringBuilder; overload;
    function Append(Value: Integer): TJclStringBuilder; overload;
    function Append(Value: Double): TJclStringBuilder; overload;
    function Append(Value: Int64): TJclStringBuilder; overload;
    function Append(Obj: TObject): TJclStringBuilder; overload;
    function AppendFormat(const Fmt: string; const Args: array of const): TJclStringBuilder; overload;
    function AppendFormat(const Fmt: string; Arg0: Variant): TJclStringBuilder; overload;
    function AppendFormat(const Fmt: string; Arg0, Arg1: Variant): TJclStringBuilder; overload;
    function AppendFormat(const Fmt: string; Arg0, Arg1, Arg2: Variant): TJclStringBuilder; overload;

    function Insert(Index: SizeInt; const Value: string; Count: SizeInt = 1): TJclStringBuilder; overload;
    function Insert(Index: SizeInt; Value: Boolean): TJclStringBuilder; overload;
    function Insert(Index: SizeInt; const Value: array of Char): TJclStringBuilder; overload;
    function Insert(Index: SizeInt; const Value: array of Char; StartIndex, Length: SizeInt): TJclStringBuilder;
      overload;
    function Insert(Index: SizeInt; Value: Cardinal): TJclStringBuilder; overload;
    function Insert(Index: SizeInt; Value: Integer): TJclStringBuilder; overload;
    function Insert(Index: SizeInt; Value: Double): TJclStringBuilder; overload;
    function Insert(Index: SizeInt; Value: Int64): TJclStringBuilder; overload;
    function Insert(Index: SizeInt; Obj: TObject): TJclStringBuilder; overload;

    function Replace(OldChar, NewChar: Char; StartIndex: SizeInt = 0; Count: SizeInt = -1): TJclStringBuilder;
      overload;
    function Replace(OldValue, NewValue: string; StartIndex: SizeInt = 0; Count: SizeInt = -1): TJclStringBuilder;
      overload;

    function Remove(StartIndex, Length: SizeInt): TJclStringBuilder;
    function EnsureCapacity(Capacity: SizeInt): SizeInt;

    { IToString }
    function ToString: string; {$IFDEF RTL200_UP} override; {$ENDIF RTL200_UP}

    property __Chars__[Index: SizeInt]: Char read GetChars write SetChars; default;
    property Chars: TCharDynArray read FChars;
    property Length: SizeInt read FLength write Set_Length;
    property Capacity: SizeInt read GetCapacity write SetCapacity;
    property MaxCapacity: SizeInt read FMaxCapacity;
  end;