{***************************************************************
 * Project  : System Function Overview Performance & Benchmark Tester
 * App Name: 290_bestofbox2, #locs=769
 * Purpose  : Demonstrates best functions to measure performance
 * Date  : 09/22/2012  -  17:07
 * Lastmod, #sign:Administrator: PC08: 19/07/2014 06:49:28 PM 
 * History  : convert to maXbox Nov 2011
 *          : system demo for mX3.9, finished yet!!
            : regression, dbscript, API and threads, wget
            : performance of graphic, calculation and internet
 ****************************************************************}
Program BestofBoxDemo2_Benchmark;
{BOOL WINAPI MessageBeep(
  __in  UINT uType
);}
//TThreadFunction = function(P: Pointer): Longint; stdcall;
//Procedure ExecuteThread(afunc: TThreadFunction; var thrOK: boolean);

function  MessageBeep(para: integer): byte;
  external 'MessageBeep@user32.dll stdcall'; 
  
function MessageBoxTimeOut(hWnd: HWND; lpText: PChar; lpCaption: PChar; uType: UINT;
                wLanguageId: WORD; dwMilliseconds: DWORD): Integer;
  external 'MessageBoxTimeoutA@user32.dll stdcall';
  
  
const
  BITMAP = 'examples\citymax.bmp';
  
type
  TByteArr = array of byte;
  
  (*TStLinEst = record
    B0, B1     : Double;   {model coefficients}
    seB0, seB1 : Double;   {standard error of model coefficients}
    R2         : Double;   {coefficient of determination}
    sigma      : Double;   {standard error of regression}
    SSr, SSe   : Double;   {elements for ANOVA table}
    F0         : Double;   {F-statistic to test B1=0}
    df         : Integer;  {denominator degrees of freedom for F-statistic}
  end;*)
   
var
  except_state, execute_state: string;  
  mytimestamp: TDateTime;
  osType: TIdWin32Type;
  //diskTotal, amtFree: int64;
  //ptr: ___Pointer;
  thresult: boolean;
  //thfct: TThreadFunction;   //procedure type
  //mybase: TThread;
  //mySort: TSortThread;
  mybox: TPaintBox;
  mythreadArray: TSortArray;
  frmMon: TForm;
  Image1: TImage;

  //my bestofbox functions
  procedure getMaxBoxIni; forward;        //1
  procedure getDriveTypesF; forward;      //2
  procedure ThreadDemoForm; forward;      //3
  procedure RegExTest; forward;           //4
  procedure newDBTableScript; forward;    //5
  procedure RotateBitmap(var htmpBitmapDC: TBitmap; var lWidth : Longint;
                           var lHeight : Longint; lRadians : real; origmap: TBitmap); forward;//6
  procedure VariantTests; forward;                         //7
  procedure CallTicker(msecs: integer); forward;           //8
  procedure StatisticPackage; forward;                     //9
  Procedure PrimeTimeFactors(afactor: integer); forward;   //10
  function loadPForm(vx, vy: integer): TForm; forward;     //11
  procedure TimeOutBox_API; forward;                       //12
 

  
procedure getMaxBoxIni;
var
  Ini: TIniFile;   
begin
  Ini:= TIniFile.Create(ExePath+'maxboxdef.ini');
  try
    except_state:= Ini.ReadString('Form', 'EXCEPTIONLOG','');
    execute_state:= Ini.ReadString('Form', 'EXECUTESHELL','');
  finally
    writeln('inifile sysdata test: '+(except_state)+ ' '+(execute_state))
    ini.Free;
  end;
end;

//------------------------------------------thread func tester
Function myThread(p: integer): Longint; //stdcall;
var x: Integer;
begin
  inc(x)
  with TThread.Create(true) do begin
  //after construction
    Resume;
    writeln('thread id: '+inttoStr(threadID));
    writeln('thread handle: '+inttoStr(handle));
    Free;
  end; 
  writeln('thread locale ' +inttostr(GetThreadLocale))
  writeln('thread current ' +inttostr(GetCurrentThreadID))
end;

Procedure signal_Sounds;
var sound: integer;
begin
for sound:= 1 to 100 do
  if sound mod 10 = 0 then begin
    MessageBeep(sound)
    sleep(1500)
  end;  
  //ExtractTokensS
  //CompUCStringS
  //ForceExtensionS
end;


//const StHexDigits  : array[0..$F] of Char = '0123456789ABCDEF';

function BinaryBS(B : Byte) : ShortString;
  {-Return a binary string for a byte.}
var
  I, N : Cardinal;
begin
  N := 1;
  Result[0] := #8;
  for I := 7 downto 0 do begin
    Result[N] := CHEXSET[Ord(B and (1 shl I) <> 0)]; {0 or 1}
    Inc(N);
  end;
end;

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

procedure getDriveTypesF;
var
  Drive: byte;
  DriveLetter: String;
begin
  for Drive:= ord('A') to ord('Z') do begin
    DriveLetter:= chr(Drive) + ':\';
    case GetDriveType(PChar(chr(Drive) + ':\')) of
      0: //DRIVE_UNKNOWN
      Memo2.Lines.Add(DriveLetter + ' Unknown Drive');
      {1: //DRIVE_NO_ROOT_DIR
      Memo2.Lines.Add(DriveLetter + ' No Root Dir or mount Point');}
      2: //DRIVE_REMOVABLE:
      Memo2.Lines.Add(DriveLetter + ' Removable or Floppy Drive');
      3: //DRIVE_FIXED:
      Memo2.Lines.Add(DriveLetter + ' Fixed Drive');
      4: //DRIVE_REMOTE:
      Memo2.Lines.Add(DriveLetter + ' Network Drive');
      5: //DRIVE_CDROM:
      Memo2.Lines.Add(DriveLetter + ' CD-ROM Drive');
      6: //DRIVE_RAMDISK:
      Memo2.Lines.Add(DriveLetter + ' RAM Disk');
    end;
  end;
end;

procedure ThreadDemoForm;
begin
    with TSortThread.Create(mybox, mythreadarray) do begin
      bolTHslowmotion:= true;
      slowmotion:= 2;
    end;  
    with TQuickSort.Create(mybox, mythreadarray) do begin
      bolTHslowmotion:= true;
      slowmotion:= 4;
    end;  
    with TThreadSortForm.Create(self) do begin
      caption:= 'IBZDemo';
      label1.caption:= 'Bubble Sort down up';
      //bolTHslowmotion:= true;
      slowmotionfirst:= 1;   //to begin
      slowmotion:= 3;        // for each thread
      show;
      //StartBtn.caption:= 'go parallel';
      //StartBtnClick(self);
    end;  
end;

procedure checkerboard2(mycanvas: TCanvas);
var row, col: byte;
begin  
    for row:= 1 to 64 do begin
   if row mod 8 = 0 then begin
      //r2:= r2+ row;
      for col:= 1 to 8 do 
        myCanvas.Rectangle(col*28,50+row*3,80,20);
      end;
   end;   
end; 
  

procedure InitBitmapForm;
begin
 frmMon:= TForm.create(self);
 with frmMon do begin
   //FormStyle := fsStayOnTop;
   Position := poScreenCenter;
   caption:='Pulsar Universe BitmaX';
   color:= clblack;
   width:= 400;
   height:= 400;
   Show;
 end;
 Image1:= TImage.create(frmMon);
 with Image1 do begin
   parent:= frmMon;
   //picture.bitmap.color:= 
   setbounds(10,15, 200,150);
   //onMousedown:= @Image1MouseDown;
   show;
   //onMouseup:= @Image1MouseUp
 end;
end; 
 
procedure RegExTest;
var regexres: TStrings;
begin
// Function ExecRegExpr( const ARegExpr, AInputStr : RegExprString) : boolean');
    ///regex1 [12][09]\d{2}-\d{2}-\d{2}T12:[23]\d:\d{2}/
    //regex2 result group = /((19)|(20))(\d{2}-\d{2}-\d{2}T)(12:[23]\d:\d{2})/
  if ExecRegExpr('((19)|(20))\d{2}-\d{2}-\d{2}T12:[23]\d:\d{2}',
    '1925-04-01T12:23:29') then writeln('regex true') else writeln('regex false');
 //4464: Function RegExprSubExpressions(const ARegExpr: string; ASubExprs: TStrings; AExtendedSyntax: boolean) :
   regexres:= TStringlist.Create;
   regexres.Clear;
   RegExprSubExpressions('((19)|(20))(\d{2}-\d{2}-\d{2}T)(12:[23]\d:\d{2})', regexres, true);
   writeln('regex extract: '+regexres[4]);
   regexres.Free;
end;  

procedure newDBTableScript;
begin
  with TTable.Create(self) do begin
    Active:= false;
    databasename:= 'DBDEMOS';
    //databasename:= 'knabe';
    tablename:= 'maxtable3';
    tabletype:= ttparadox;
    with fielddefs do begin
      Clear;
      add('field1',ftinteger,0,false)
      add('field2',ftinteger,0,false)
      add('field3',ftfloat,0,false)
    end;
    CreateTable; 
    active:= true;
    Insert;
    FieldbyName('field1').value:= 44;
    FieldbyName('field2').value:= 55;
    FieldbyName('field3').value:= 3.1415;
    Post;
    Close;  
  end;
end;  

procedure RotateBitmap(var htmpBitmapDC: TBitmap; var lWidth : Longint;
                            var lHeight : Longint; lRadians : real; origmap: TBitmap);
var
         I,J : Longint;               // loop counter
         //htmpBitmapDC : Longint;    // DC of the new bitmap
         lSine,lCosine : extended;          // sine,cosine used in rotation
         X1,X2,X3,Y1,Y2,Y3 : Longint;     // used in calculating new bitmap dimensions
         lMinX,lMaxX,lMinY,lMaxY: Longint;  
         lNewWidth,lNewHeight : Longint;  // width of new bitmap
         lSrcX,lSrcY  : Longint;   // x,y pixel coord we are blitting from the source image
         myrect: TRect;
begin
   // create a compatible DC from the one just brought
   // compute the sine/cosinse of the radians used to // rotate this image
    //tbmpDC:= tbmp.handle;
   lSine := Sin(lRadians);
   lCosine := Cos(lRadians);
   // compute the size of the new bitmap being created
   X1 := Round(-lHeight * lSine);
   Y1 := Round(lHeight * lCosine);
   X2 := Round(lWidth * lCosine - lHeight * lSine);
   Y2 := Round(lHeight * lCosine + lWidth * lSine);
   X3 := Round(lWidth * lCosine);
   Y3 := Round(lWidth * lSine);
   // figure out the max/min size of the new bitmap
   lMinX := Min(0, Min(X1, Min(X2, X3)));
   lMinY := Min(0, Min(Y1, Min(Y2, Y3)));
   lMaxX := Max(X1, Max(X2, X3));
   lMaxY := Max(Y1, Max(Y2, Y3));
   // set the new bitmap width/height
   lNewWidth:= lMaxX - lMinX;
   lNewHeight:= lMaxY - lMinY;
   // create a new bitmap based upon the new width/height of the // rotated bitmap
   //hNewBitmap := CreateCompatibleBitmap(hBitmapDC, lNewWidth, lNewHeight);
   htmpBitmapDC.height:= lNewHeight;
   htmpBitmapDC.width:= lNewWidth;
   //myRect:= Rect(0,0,lwidth,lheight); 
   //frmmon.Canvas.BrushCopy(MyRect, Image1.Picture.Bitmap, MyRect, clred);
   For I:= 0 To lNewWidth do begin
     For J:= 0 To lNewHeight do begin
       lSrcX:= Round((J + lMinX) * lCosine + (I + lMinY) * lSine);
       lSrcY:= Round((I + lMinY) * lCosine - (J + lMinX) * lSine);
       If (lSrcX >= 0) And (lSrcX <= lWidth) And
          (lSrcY >= 0) And (lSrcY <= lHeight) Then begin
         BitBlt(htmpBitmapDC.canvas.handle,J,I,lnewheight,lnewwidth,origmap.canvas.handle,
                                 lSrcX,lSrcY, SRCCOPY);
        end;
     end;
  end;
  //Image1.Refresh; 
  lWidth:= htmpBitmapDC.width;
  lHeight:= htmpBitmapDC.height;
End;
      
procedure TForm1_RotateTest2(Sender: TObject);
var
 lRadians: real;
 tbmpDC, H,W, Degrees: longint;
 mybitmap: TBitmap;
 MyRect: TRect;
begin
  mybitmap:= TBitmap.create;
  mybitmap.loadfromfile(exepath+'examples\citymax.bmp')
  image1.width:= mybitmap.width;
  image1.height:= mybitmap.height;
  //Image1.Picture.BitMap.PixelFormat:= pf24bit; 
  Image1.Picture.BitMap:= mybitmap;
  //mybitmap.Free;
  Degrees:= 45;
  lRadians:= PI * Degrees / 180;
  W:= Image1.Picture.Width;
  H:= Image1.Picture.Height;
  //W:= Image1.Width;
  //H:= Image1.Height;
  mybitmap:= TBitmap.create;
  RotateBitmap(mybitmap, W, H, lRadians, Image1.Picture.Bitmap);
  myRect:= Rect(0,0,W,H); 
  //frmmon.Canvas.CopyRect(MyOther,mybitmap.Canvas,MyRect);
  Image1.Width:= W;
  Image1.Height:= H;
  Image1.Picture.Bitmap.Width:= W;
  Image1.Picture.Bitmap.Height:= H;
  //Image1.Picture.bitmap:= mybitmap;
  BitBlt(Image1.Picture.Bitmap.Canvas.Handle,0,0,W,H,mybitmap.canvas.handle,0,0,SRCCopy);
  //frmmon.Canvas.BrushCopy(MyRect, Image1.Picture.Bitmap, MyRect, clRed);
  //for j:= 1 to image1.height do
    //image1.Picture.Bitmap.Canvas.pixels[j,j]:= clred; //test line
  mybitmap.Free;
  Image1.Refresh; 
end;


function vsomme(a,b: variant): variant;
begin
  result:= a+b;
end;  

procedure VariantTests;
var at: variant;
begin
  writeln('variant 5+6: '+inttostr(vsomme(5,6)));
  writeln('variant 5.8+6.0: '+floattostr(vsomme(5.8,6.0)));
  writeln('variant str(5)+str(6): '+(vsomme('5','6')));
  writeln('variant '+(vsomme('bonjour','monsieur')));
  vsomme(date,7);
  writeln('variant plus 7 days: '+datetostr(vsomme(date,7)));
  at:= varArrayCreate([1,8],varvariant);
  //at[1]:= 'first of var';
  //t[2]:= 'second of var';
  //Writeln(t[1]+'   :   '+t[2]);
  
end;


procedure Delay2StopWatch(msecs: integer);
 var FirstTickCount: longint;
begin
 FirstTickCount:= GetTickCount;
 repeat
   Application.ProcessMessages; {allowing access to other controls, widgets, etc.}
 until ((GetTickCount-FirstTickCount) >= Longint(msecs));
end;
//Test it with:
procedure CallTicker(msecs: integer);
begin
 with TStopWatch.create do begin
   start
     Delay2StopWatch(msecs)
   stop
   writeln('Stop Watch CPU Tester: '+getValueStr)
 end;    
end;

function StrToArrOfByte(AStr: String): TByteArr;
var
  j: smallint;
begin
   SetLength(Result, Length(AStr)) ;
   for j:= 0 to Length(AStr)-1 do
   Result[j]:= ord(AStr[j + 1])-48;
end;

{4565: Function AveDev( const Data : array of Double) : Double');
4566: Function AveDev16( const Data, NData : Integer) : Double');
4567: Function Confidence( Alpha, StandardDev : Double; Size : LongInt) : Double');
4568: Function Correlation( const Data1, Data2 : array of Double) : Double');
4569: Function Correlation16( const Data1, Data2, NData : Integer) : Double');
4570: Function Covariance( const Data1, Data2 : array of Double) : Double');
4571: Function Covariance16( const Data1, Data2, NData : Integer) : Double');
4572: Function DevSq( const Data : array of Double) : Double');
4573: Function DevSq16( const Data, NData : Integer) : Double');}
{X Values	Y Values
60	3.1
61	3.6
62	3.8
63	4
65	4.1  }

procedure StatisticPackage; //see also ex. 289 regression
var adx, ady, adrand, adregx, adregy: array of double;
    aaSum, aaSumOfSquares: extended;
    linregress: TStLinEst;
//http://www.koders.com/delphi/fid01C6FC01AA74690692B71DC9F63FEB4B86AE43DB.aspx?s=crc    
begin
  SetLength(adx,5)
  SetLength(ady,5)
  adx[0]:= 60;
  adx[1]:= 61;
  adx[2]:= 62;
  adx[3]:= 63;
  adx[4]:= 65;
  ady[0]:= 3.1;
  ady[1]:= 3.6;
  ady[2]:= 3.8;
  ady[3]:= 4.0;
  ady[4]:= 4.1;
  PrintF('Correlation of x and y %.4f',[Correlation(ady,adx)]);
  PrintF('Covariance of x and y %.4f',[Covariance(ady,adx)]);
//4604: Function Forecast(X : Double; const KnownY: array of Double; const KnownX: array of Double): Double');
  PrintF('Forecast of x is %.4f',[Forecast(7,ady,adx)]);
  //4606: Function Intercept( const KnownY : array of Double; const KnownX : array of Double) : Double');
  PrintF('Intercept of y and x %.4f',[Intercept(ady,adx)]);
  //5832: Procedure SumsAndSquares( const Data : array of Double; var Sum, SumOfSquares : Extended)
  SumsAndSquares(adx, aaSum, aaSumOfSquares);
  PrintF('SumsAndSquares of X: %.2f  %.2f', [aaSum, aaSumOfSquares]);
  //4574: Procedure Frequency( const Data : array of Double; const Bins : array of Double; var Counts : array of LongInt)');
  //4609: Function StandardErrorY( const KnownY : array of Double; const KnownX : array of Double) : Double');
  PrintF('Standard Error of y %.4f',[StandardErrorY(ady,adx)]);
  PrintF('Slope of both %.4f',[Slope(ady,adx)]);
  PrintF('R Squared of both %.4f',[RSquared(ady,adx)]);
  // SetLength(adrand,1000)
  //for i:= 1 to 1000-1 do adrand[i]:= randomF;
  //for i:= 1 to 1000-1 do writeln(floattostr(adrand[i]));
  {abytearr:= StrtoArrofByte(memo2.text)
  for i:= 0 to length(abytearr)-1 do write((chr(abytearr[i]+48)));
  writeln('');}
//Trick 1_6: 1, 2, 4, 5, 7, 8
  PrintF('choose a number %f',[maXcalc('7*9*111*1001/7')]);
{Step1: Choose a number from 1 to 6.
 Step2: Multiply the number with 9.
 Step3: Multiply the result with 111.
 Step4: Multiply the result by 1001.
 Step5: Divide the answer by 7.
 Answer: All the above numbers will be present.}
//type
//http://people.sc.fsu.edu/~jburkardt/datasets/regression/regression.html
  {full statistics for a linear regression}
  (*TStLinEst = record
    B0, B1     : Double;   {model coefficients}
    seB0, seB1 : Double;   {standard error of model coefficients}
    R2         : Double;   {coefficient of determination}
    sigma      : Double;   {standard error of regression}
    SSr, SSe   : Double;   {elements for ANOVA table}
    F0         : Double;   {F-statistic to test B1=0}
    df         : Integer;  {denominator degrees of freedom for F-statistic}
  end;
{LINEST}
procedure LinEst(const KnownY : array of Double;
  const KnownX : array of Double; var LF : TStLinEst; ErrorStats : Boolean);
  {-Performs linear fit to data and returns coefficients and error
    statistics.
      KnownY is the dependent array of known data points.
      KnownX is the independent array of known data points.
      NData must be greater than 2.
      If ErrorStats is FALSE, only B0 and B1 are computed; the other fields
        of TStLinEst are set to 0.0.
      See declaration of TStLinEst for returned data.
  } *)
 // adx[0]:= 60.0;
 { adx[1]:= 61.0;
  adx[2]:= 62.0;
  adx[3]:= 63.0;
  adx[4]:= 65.0;}
  //ady[0]:= 30.1;
 { ady[1]:= 30.6;
  ady[2]:= 30.8;
  ady[3]:= 40.0;
  ady[4]:= 40.1;}

   SetArrayLength(adregx,3)
   SetArrayLength(adregy,3)              
   adregx[0]:= 234;
   adregx[1]:= 254;
   adregx[2]:= 264;
   adregy[0]:= 250;
   adregy[1]:= 250;
   adregy[2]:= 264;
  //LinEst(adregx,adregy, linregress, true) 
end;

Procedure PrimeTimeFactors(afactor: integer);
var md: TDynCardinalArray;
    i: integer;
begin
  md:= PrimeFactors(afactor) 
  write('Prime factors of '+intToStr(afactor)+': ');
  for i:= 0 to length(md)-1  do
    write(inttostr(md[i])+ '  ');
end;

procedure CurrencyFormat;
var fSettings: TFormatSettings;
begin
  GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, fSettings);
  writeln(fsettings.timeAMString);
  writeln(fsettings.longDateFormat);
  writeln(fsettings.shortDateFormat);
    //writeln(currtostrF
  writeln('currtostrFS 1234.56 formats with setting as = '+
             CurrToStrFS(1234.5678989, ffCurrency, 4, fSettings));
             writeln(FloatToStrF(1234.5678989, ffCurrency, 6, 6));
  writeln('currtostrFS and back as = '+
             CurrToStrFS(strToCurr('1234.5678989'), ffCurrency, 4, fSettings));
end; 

procedure maxcalc_demo;
begin
  printF('this is %.6f',[maXcalc('ln(2)+fact(388)+2!')]); 
  printF('this is %.6f',[maXcalc('(4!)^(3!)')]); 
  printF('this is %.6f',[maXcalc('4!+4!')]); 
  printF('this is %.6f',[maXcalc('log(22)')]); 
  printF('this is logN %.6f',[maXcalc('2%256')]);
  writeln('ln(e): '+floattostr(maXcalc('ln(e)')))
  writeln(floattostr(maXcalc('e+10^6')))
  printF('addition theorem %.18f ',[maXcalc('sin(2.5/2)')])
  printF('addition theorem %.18f ',[maXcalc('sqrt(1/2*(1-cos(2.5)))')])
  printF('addition theorem2 %22.18f ',[maXcalc('cos(2.5/2)')])
  printF('addition theorem2 %22.18f ',[maXcalc('sqrt(1/2*(1+cos(2.5)))')])
  maXcalcF('2%256+2^10');
end; 

procedure syncobj_demo;
begin
 with TCriticalSection.Create do begin
    if TryEnter then
    writeln('in critical section');
    Leave;
    writeln('leave critical section');
    Free;
  end;  
  with TMutex.Create(false) do begin
    //if TryEnter then
    writeln('handle of mutex: '+inttoStr(handle));
    Waitfor(2000);
    Free;
  end;
end;  

procedure CloseClick(Sender: TObject; var action: TCloseAction);
begin
  {if Timer1 <> NIL then begin
    Timer1.enabled:= false;
    Timer1.Free;
    Timer1:= NIL;
  end;}
  action:= caFree;
  //sender.Close;
  writeln('form being closed');
end;

procedure CloseButtonClick(Sender: TObject);
var act: TCloseAction;
   handle: THandle;
begin
  //act:= caFree;
  sender.Free;
  //TForm(sender).Close;
  //CloseClick(sender,act);
  //Handle:= FindWindow(ppform,''); //FindReplDialog does not
  //if Handle <> 0 then 
    //Showmessage('maXbox is alive')
end;

procedure mxButton2(x,y,w,h,t,l,ahandle: integer);
var rgn: HRgn;
begin
  rgn:= createRoundRectRgn(x,y,w,h,t,l);
  setWindowRgn(ahandle, rgn, true);
end;    


function loadPForm(vx, vy: integer): TForm;
var psize: integer;
    ppform: TForm;
    rgn: hrgn;
begin
  psize:= vx*vy
  //constructor
  ppform:= TForm.Create(self);
  with ppform do begin
    caption:= 'LEDBOX, Press <Return> to run the Sentence';  
    width:= (vx*psize)+ 10 + 200;
    height:= (vy*psize)+ 30;
    BorderStyle:= bsDialog;
    Position:= poScreenCenter;
    //onKeyPress:= @FormKeyPress
    //OnClick:= @Label1Click;
    canvas.Pen.mode :=pmNotXor;
    canvas.pen.style:= psDot; //Gepunktete Linien
    color:= clBlack;
    OnClose:= @closeClick;
    Show;
  end;
  with TBitBtn.create(self) do begin
    parent:= ppform;
    setbounds(140,440,140,40)
    glyph.LoadFromResourceName(HINSTANCE,'CL_MPSTOP'); 
    rgn:= createRoundRectrgn(0,0,width,height,12,12);
    setWindowRgn(handle, rgn, true);
    caption:= '&Close button';
    onClick:= @closeButtonClick;
  end;
   with TBitBtn.create(self) do begin
    parent:= ppform;
    setbounds(300,440,140,40)
    glyph.LoadFromResourceName(HINSTANCE,'CL_MPPLAY'); 
    mXButton(0,0,width, height,12,12,handle);
    //rgn:= createRoundRectrgn(0,0,width,height,20,20);
    //setWindowRgn(handle, rgn, true);
    caption:= '&open button';
    //onClick:= @openButtonClick;
  end;
     with TBitBtn.create(self) do begin
    parent:= ppform;
    setbounds(460,440,140,40)
    glyph.LoadFromResourceName(HINSTANCE,'CL_MPRECORD'); 
    mXButton(0,0,width, height,12,12,handle);
    //rgn:= createRoundRectrgn(0,0,width,height,20,20);
    //setWindowRgn(handle, rgn, true);
    caption:= '&maXcalc button';
    //onClick:= @openButtonClick;
  end;  
  result:= ppform;  
end;

procedure LetBitmaponForm(aform: TForm);
var mbitmap: TBitMap;
begin
  mbitmap:= TBitmap.Create;
  try
    mbitmap.LoadFromFile(Exepath+BITMAP);
    aform.Canvas.Draw(320,160, mbitmap);
    aform.Canvas.Draw(180,110, mbitmap);
    aform.Canvas.draw(5,50, mbitmap);
    checkerBoard2(aForm.canvas);
  finally
    //aForm.Free;
    mbitmap.Free;
  end;
end;

procedure TimeOutBox_API;
var iFlags, iResult: integer;
begin 
iFlags:= $0 or $00010000 or $00000040;
    iResult:= MessageBoxTimeout(Application.Handle,
        'Test a timeout of 2 seconds.','MessageBoxTimeout Test',iFlags,0,2000);  
end;  
 
procedure leibniz_formula;
var zeta: extended;
    tac: boolean;
    i: longint;
begin    
  zeta:= 0;
  tac:= true;
  for i:= 1 to 50000 do 
    if NOT (i mod 2 = 0) then begin 
      tac:= not tac;
      if tac then
        zeta:= zeta - 1/i else
        zeta:= zeta + 1/i;
    end;  
  writeln('harmonic alternate leibniz formula to PI/4: '+floatToStr(zeta))  
  writeln('leibniz test a maXcalc: '+floatToStr(maxcalc('PI/4')))
  writeln('constant test ref PI/4: '+floatToStr(PIOn4))
end;    


begin   //main of bestofbox
   //InifileRead;
   ProcessMessagesON;
   getMaxBoxIni;
   thresult:= false;
   //thfct:= @myThread;
   CurrentThreadID
   writeln('Thread ID :'+intToStr(CurrentThreadID))
   CurrentProcessId
   writeln('Process ID :'+intToStr(CurrentProcessID))
   //ExecuteThread(thfct, thresult)
   //if thresult = true then
   writeln('machine name is: '+getHostName)
   writeln('user name is: '+getUserName)
   osType:= Win32Type;
   writeln('OS Type is: '+intToStr(ord(osType)));
   mytimestamp:= GetFileCreationTime(exepath+'maxbox3.exe')
   writeln(DateTimeToStr(mytimestamp)+' for maXbox3 file')
   //SearchAndOpenDoc(ExtractFilePath(ParamStr(0))+'docs\maxbox_starter2.pdf')
   //signal_Sounds;
   //ExecuteCommand('cmd','/k dir *.*')
   getDriveTypesF;
    with TJvCustomLED.Create(self) do begin
      SetBounds(10,10,50,50);
      visible:= true;
      //interval
      show;
      Free;
    end;
   ThreadDemoForm;  
   RegExTest;
   //newDBTableScript;
   InitBitmapForm;
   TForm1_RotateTest2(Self);
   VariantTests;
   CallTicker(500);
   with TStString.Create do begin
     AppendString(memo2.text)
     Writeln('this word count of StString '+IntToStr(WordCount));
     Writeln('ASCII count of output '+inttoStr(ASCIICount));
     Writeln('Alloc Length of output '+inttoStr(allocLength));
     //atIndex
     Free;
   end;
   maXcalc_demo;
   Writeln('************************Stat Pac*****************************');  
   StatisticPackage;  
   PrimeTimeFactors(23457);
   Writeln('************************API Pac*****************************');  
   CurrencyFormat;
   SyncObj_demo;
   myThread(200) //stdcall;
   // thread save avoid local vars!
   LetBitmaponForm(loadpform(8,8));
   TimeOutBox_API;
   leibniz_formula;
   writeln(DateTimeToInternetStr(now, true))
   try
     if isInternet then 
     wGet('http://www.softwareschule.ch/download/maxbox_starter4.pdf','mytestpdf.pdf');
   except
     showmessage(' no internet connection ');
   end
    //[regex]
   //maXbox
   //writeln(binarybs(128))
   //AnsiCompareStrShort32
   writeln('runtime before: '+ getRuntime); 
   writeln(showmemory2);
End.   

------------------------------------------------
Windows crashed again. I am the Blue Screen of Death. No one hears your screams.
Three things are certain: Death, taxes, and lost data. Guess which has occurred.
There is no place like 127.0.0.1 
sha1 of mx39994 zip
f03f8e361fc755814fd34d2a06c4798018878e89



50000  = 0.693137180659968
100000 = 0.693142180584982
500000 = 0.693146180561005
10^6   = 0.693146680560255
5*10^6 = 0.693147080560068
50*10^6= 0.693147170560399    //Runtime: 0:28:22.422
ln(2)  = 0.693147180559945

(* zeta:= 0;
     for i:= 1 to 50000 do 
       if i mod 2 = 0 then
         zeta:= zeta - 1/i else
         zeta:= zeta + 1/i;
       writeln('harmonic alternate to ln(2): '+floattostr(zeta))  
       writeln(floattostr(maxcalc('ln(2)')))
       writeln(floattostr(ln2))    *)
   

type
  //PThreadSortArray = ^TThreadSortArray;
  //TThreadSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;
  TSortArray =  array[1..ARRSIZE] of Integer;


  TSortThread = class(TThread)
  strict private
    FBox: TPaintBox;
    //FSortArray: PThreadSortArray;
    FSortArray: TSortArray;
    FSize: Integer;
    FA, FB, FI, FJ: Integer;
    Fbolthslowmotion: boolean;
    procedure DoVisualSwap;
    procedure Setbolthslowmotion(const Value: boolean);
  protected
    procedure Execute; override;
    procedure VisualSwap(A, B, I, J: Integer);
    procedure Sort(var A: array of Integer); virtual; abstract;
  public
    constructor Create(Box: TPaintBox; var SortArray: TSortArray);
    property  bolTHslowmotion: boolean read Fbolthslowmotion write Setbolthslowmotion;

  end;


procedure SIRegister_TThreadSortForm(CL: TPSPascalCompiler);
begin
  //with RegClassS(CL,'TForm', 'TThreadSortForm') do
  with CL.AddClassN(CL.FindClass('TForm'),'TThreadSortForm') do
  begin
    RegisterProperty('BubbleSortBox', 'TPaintBox', iptrw);
    RegisterProperty('SelectionSortBox', 'TPaintBox', iptrw);
    RegisterProperty('QuickSortBox', 'TPaintBox', iptrw);
    RegisterProperty('Bevel1', 'TBevel', iptrw);
    RegisterProperty('Bevel2', 'TBevel', iptrw);
    RegisterProperty('Bevel3', 'TBevel', iptrw);
    RegisterProperty('StartBtn', 'TButton', iptrw);
    RegisterProperty('Label1', 'TLabel', iptrw);
    RegisterProperty('Label2', 'TLabel', iptrw);
    RegisterProperty('Label3', 'TLabel', iptrw);
    RegisterProperty('BitBtn1slowmotion', 'TBitBtn', iptrw);
    RegisterMethod('Procedure StartBtnClick( Sender : TObject)');
    RegisterMethod('Procedure BubbleSortBoxPaint( Sender : TObject)');
    RegisterMethod('Procedure SelectionSortBoxPaint( Sender : TObject)');
    RegisterMethod('Procedure QuickSortBoxPaint( Sender : TObject)');
    RegisterMethod('Procedure FormCreate( Sender : TObject)');
    RegisterMethod('Procedure FormDestroy( Sender : TObject)');
    RegisterMethod('Procedure FormKeyPress( Sender : TObject; var Key : Char)');
    RegisterMethod('Procedure BitBtn1slowmotionClick( Sender : TObject)');
    RegisterMethod('Procedure ThreadDone( Sender : TObject)');
    RegisterProperty('mouse', 'boolean', iptrw);
  end;
end;



//----------------------------------------------
 DiskSize returns -1 if the drive number is invalid. Drive parameter can be 
 set to: 0 = Current drive, 1 = A, 2 = B, 3 = C and so on. 


DRIVE_UNKNOWN
0 The drive type cannot be determined.
 
DRIVE_NO_ROOT_DIR
1 The root path is invalid; for example, there is no volume mounted at the specified path.
 
DRIVE_REMOVABLE
2 The drive has removable media; for example, a floppy drive, thumb drive, or flash card reader.
 
DRIVE_FIXED
3 The drive has fixed media; for example, a hard drive or flash drive.
 
DRIVE_REMOTE
4 The drive is a remote (network) drive.
 
DRIVE_CDROM
5 The drive is a CD-ROM drive.
 
DRIVE_RAMDISK
6 The drive is a RAM disk.

***********************************Thread Class *****************************
  TThread = class
  private
{$IFDEF MSWINDOWS}
    FHandle: THandle;
    FThreadID: THandle;
{$ENDIF}
{$IFDEF LINUX}
    // ** FThreadID is not THandle in Linux **
    FThreadID: Cardinal;
    FCreateSuspendedSem: TSemaphore;
    FInitialSuspendDone: Boolean;
{$ENDIF}
    FCreateSuspended: Boolean;
    FTerminated: Boolean;
    FSuspended: Boolean;
    FFreeOnTerminate: Boolean;
    FFinished: Boolean;
    FReturnValue: Integer;
    FOnTerminate: TNotifyEvent;
    FSynchronize: TSynchronizeRecord;
    FFatalException: TObject;
    procedure CallOnTerminate;
    class procedure Synchronize(ASyncRec: PSynchronizeRecord; QueueEvent: Boolean = False); overload;
{$IFDEF MSWINDOWS}
    function GetPriority: TThreadPriority;
    procedure SetPriority(Value: TThreadPriority);
{$ENDIF}
{$IFDEF LINUX}
    // ** Priority is an Integer value in Linux
    function GetPriority: Integer;
    procedure SetPriority(Value: Integer);
    function GetPolicy: Integer;
    procedure SetPolicy(Value: Integer);
{$ENDIF}
    procedure SetSuspended(Value: Boolean);
  protected
    procedure CheckThreadError(ErrCode: Integer); overload;
    procedure CheckThreadError(Success: Boolean); overload;
    procedure DoTerminate; virtual;
    procedure Execute; virtual; abstract;
    procedure Queue(AMethod: TThreadMethod); overload;
    procedure Synchronize(AMethod: TThreadMethod); overload;
    property ReturnValue: Integer read FReturnValue write FReturnValue;
    property Terminated: Boolean read FTerminated;
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Resume;
    procedure Suspend;
    procedure Terminate;
    function WaitFor: LongWord;
    class procedure Queue(AThread: TThread; AMethod: TThreadMethod); overload;
    class procedure RemoveQueuedEvents(AThread: TThread; AMethod: TThreadMethod);
    class procedure StaticQueue(AThread: TThread; AMethod: TThreadMethod);
    class procedure Synchronize(AThread: TThread; AMethod: TThreadMethod); overload;
    class procedure StaticSynchronize(AThread: TThread; AMethod: TThreadMethod);
    property FatalException: TObject read FFatalException;
    property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
{$IFDEF MSWINDOWS}
    property Handle: THandle read FHandle;
    property Priority: TThreadPriority read GetPriority write SetPriority;
{$ENDIF}
{$IFDEF LINUX}
    // ** Priority is an Integer **
    property Priority: Integer read GetPriority write SetPriority;
    property Policy: Integer read GetPolicy write SetPolicy;
{$ENDIF}
    property Suspended: Boolean read FSuspended write SetSuspended;
{$IFDEF MSWINDOWS}
    property ThreadID: THandle read FThreadID;
{$ENDIF}
{$IFDEF LINUX}
    // ** ThreadId is Cardinal **
    property ThreadID: Cardinal read FThreadID;
{$ENDIF}
    property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
  end;
  
  
  Trick 6: 1, 2, 4, 5, 7, 8
Step1: Choose a number from 1 to 6.
Step2: Multiply the number with 9.
Step3: Multiply the result with 111.
Step4: Multiply the result by 1001.
Step5: Divide the answer by 7.
Answer: All the above numbers will be present.

 
Understanding the SynEdit Highlighter
SynEdit - Highlighter relationship
***************************************************************************
SynEdit <-> Highlighter have a n to 1 relationship.

    1 (instance of a) Highlighter can serve n (many) (instances of) SynEdits
    Each SynEdit only has one Highlighter
    But: one text (text-buffer) can have many highlighters, if shared by several SynEdit (each SynEdit will have one HL, but all HL will work on the same document) 

As a result of this:

    no Highlighter Instance has a (fixed) reference to the SynEdit. 
     (Highlighters however keep a list of SynEditTextBuffers to which they are attached) 
     All data for the Highlighter is (and must be) stored on the SynEdit (actually on the TextBuffer of SynEdit (referred to as "Lines"). 

However SynEdit ensures before each call to the Highlighter that Highlighter.CurrentLines is set to the current SynEdits Lines. This way the highlighter can access the data whenever needed. The Format of the data-storage is determined by the highlighter (TSynCustomHighlighter.AttachToLines)
Scanning and Returning Highlight attributes

The Highlighter is expected to work on a per Line base.

If any text was modified, SynEdit will call (TSynCustomHighlighter.ScanFrom / Currently called from TSynEdit.ScanFrom) with the line range. The Highlighter should know the state of the previous line.
If Highlight attributes are required SynEdit will request them per Line too. SynEdit will loop through individual tokens on a line. This currently happens from nested proc PaintLines in SynEdit.PaintTextLines. It calls TSynCustomHighlighter.StartAtLineIndex, followed by HL.GetTokenEx/HL.GetTokenAttribute for as long as HL.GetEol is false 

Also the BaseClass for the Highlighter's data (see AttachToLines) is based on per line storage, and SynEdit's TextBuffer (Lines) do maintenance on this data to keep it synchronized. That is when ever lines of text are inserted or removed, so are entries inserted or removed from the highlighters data (hence it must have one entry per line).
Usually Highlighters store the end-of-line-status in this field. So if the highlighter is going to work on a line, it will continue with the state-entry from the previous line. 
maXboy or maXbox

    
    TTxtFile =  class (TObject)
    private
      FDefaultExt: TFileExt;
      FTextFile: TextFile;
      function GetActive: Boolean;
      function GetEof: Boolean;
      function GetEoln: Boolean;
      function GetMode: TFileMode;
      function GetName: string;
      function GetSeekEoln: Boolean;
      procedure SetActive(state: Boolean);
      procedure SetMode(const NewMode: TFileMode);
    public
      constructor Create(Name : TFileName);
      destructor Destroy; override;
      procedure Append;
      procedure Assign(FName: string);
      procedure Close; virtual;
      procedure Flush;
      //function loadfromStreamFile(const aFileName: string; memStream:
      //                                  TMemoryStream ): Boolean;
      procedure ReadLn(var S : string);
      procedure ReSet; virtual;
      procedure ReWrite; virtual;
      procedure SetTextBuf(var Buf; Size : Word);
      procedure Write(const S : string);
      procedure WriteLn(const S : String);
      property Active: Boolean read GetActive write SetActive;
      property DefaultExt: TFileExt read FDefaultExt write FDefaultExt;
      property Eof: Boolean read GetEof;
      property Eoln: Boolean read GetEoln;
      property FileName: string read GetName write Assign;
      property SeekEoln: Boolean read GetSeekEoln;
      property state: TFileMode read GetMode write SetMode;
    end;
    
     mX3 executed: 04.01.2014 18:26:47  Runtime: 0:0:12.453  Memoryload: 44% use

    
Fri, 28 Mar 2014 08:38:19 +0100
 mX3 executed: 28/03/2014 08:38:21 AM  Runtime: 0:0:9.122  Memoryload: 34% use
PascalScript maXbox3 - RemObjects & SynEdit
 mX3 executed: 28/03/2014 08:39:18 AM  Runtime: 0:0:8.980  Memoryload: 34% use
 mX3 executed: 12/04/2014 07:58:19 PM  Runtime: 0:0:9.14  Memoryload: 47% use
 mX3 executed: 23/04/2014 11:37:28 PM  Runtime: 0:0:9.158  Memoryload: 60% use
 mX3 executed: 27/04/2014 07:28:50 PM  Runtime: 0:0:9.322  Memoryload: 35% use
 mX3 executed: 27/04/2014 07:29:48 PM  Runtime: 0:0:9.158  Memoryload: 35% use
 mX3 executed: 27/04/2014 07:30:23 PM  Runtime: 0:0:9.96  Memoryload: 35% use
 mX3 executed: 27/04/2014 07:30:57 PM  Runtime: 0:0:9.76  Memoryload: 35% use
 mX3 executed: 27/04/2014 07:32:53 PM  Runtime: 0:0:9.66  Memoryload: 36% use
 mX3 executed: 14/05/2014 02:59:58 PM  Runtime: 0:0:9.144  Memoryload: 48% use
 mX3 executed: 14/05/2014 03:49:12 PM  Runtime: 0:0:9.156  Memoryload: 46% use
 mX3 executed: 14/05/2014 06:13:21 PM  Runtime: 0:0:9.206  Memoryload: 45% use
 mX3 executed: 19/05/2014 07:38:02 PM  Runtime: 0:0:9.140  Memoryload: 48% use
 mX3 executed: 19/05/2014 08:21:32 PM  Runtime: 0:0:9.120  Memoryload: 48% use
 mX3 executed: 22/05/2014 06:28:54 PM  Runtime: 0:0:9.83  Memoryload: 61% use
 mX3 executed: 13/06/2014 12:13:43 PM  Runtime: 0:0:9.377  Memoryload: 39% use
 mX3 executed: 13/06/2014 01:04:37 PM  Runtime: 0:0:9.350  Memoryload: 47% use
 mX3 executed: 14/07/2014 11:22:37 PM  Runtime: 0:0:9.272  Memoryload: 53% use
mX3 executed: 14/07/2014 11:23:59 PM  Runtime: 0:0:9.103  Memoryload: 53% use
 mX3 executed: 19/07/2014 04:13:16 PM  Runtime: 0:0:9.284  Memoryload: 40% use
 mX3 executed: 19/07/2014 06:04:05 PM  Runtime: 0:0:9.122  Memoryload: 41% use


PascalScript maXbox3 - RemObjects & SynEdit




PascalScript maXbox3 - RemObjects & SynEdit
form being closed