delphi - How to work with generic TArray

Using generic TArray with String type.

procedure TFDrawingRelease.doReading;
var
  f : TextFile;
  sRow : string;
  aSplitted: TArray<string>;
begin
  { -- delete all rows }

  if QData.Active then
    begin
      QData.Close;
      QData.Open;
    end;

  { -- open file and read data (two columns divided by ";") }

  AssignFile( f, EFileName.Text );
  try
    Screen.Cursor := crHourGlass;
    QData.DisableControls;

    reset( f );  
    
    while not eof( f ) do
      begin
        readln( f, sRow );

        aSplitted := sRow.Split( [';'], 2 );

        QData.Insert;
        { ..and return to first char _ }
        QDataItemid.AsString := aSplitted[0].Split( [ '_' ], 1 )[0];
        QDataName.AsString := aSplitted[1];
        QData.Post;
      end;
  finally
    closeFile( f );

    QData.EnableControls;
    Screen.Cursor := crDefault;
  end;

  SetButtons;
end;

DELPHI - How to open file in Windows Explorer (default opening)

Shellapi unit.

ShellExecute( Handle,
              'OPEN',
              PChar('explorer.exe'),
              PChar('/select, "' + path + '"'),
              nil,
              SW_NORMAL
             ) ;

DELPHI - How to go through all rows in dataset with bookmark

Bookmarks store your position in dataset and  after action you can return back to original record.

var
  iCount : integer;
  pBookmark : TBookmark;
  pDataSetSource : TDataSet;
begin
  ...
  Screen.Cursor := crHourGlass;
  iCount := 1;
  pBookmark := pDatasetSource.GetBookmark;
  pDatasetSource.DisableControls;
  try

    pDatasetSource.First;
    while not pDatasetSource.Eof do
      begin
        try

          { action with record }

        finally
          inc( iCount );
          pDatasetSource.Next;
        end;

      end;
  finally
    pDatasetSource.GotoBookmark( pBookmark );
    pDatasetSource.EnableControls;

    Screen.Cursor := crDefault;
  end;

DELPHI - How to show enum name as string (TFieldType)

Add System.TypInfo to your uses statement:

var
  i : integer;
  pColumn : TcxGridDBColumn;
begin
  ...
  for i := 0 to pGridView.VisibleColumnCount - 1 do
    begin
      pColumn := TcxGridDBColumn( pGridView.VisibleColumns[i] );

      ShowMessage( pColumn.DataBinding.FieldName + ' , ' + 
                   GetEnumName( TypeInfo(TFieldType), 
                                ord( pColumn.DataBinding.Field.DataType ) ) );
    end;
  ...

Output:

DELPHI - How work with memory table (TFDMemTable)

Variant 1) Copy data from TDataSet to TFDMemTable:

var
  pMemTable : TFDMemTable;
  pQuery : TFDQuery;
begin
  ...
  pMemTable := TFDMemTable.Create( self );
  pMemTable.CloneCursor( pQuery );
  ...

Variant 2) Define own structure of TFDMemTable:

var
  pMemTable : TFDMemTable;
  pQuery : TFDQuery;
begin
  ...
  pMemTable := TFDMemTable.Create( self );
  pMemTable.FieldDefs.Add( 'key', ftString, 25 );
  pMemTable.FieldDefs.Add( 'value', ftString, 25 );
  pMemTable.CreateDataSet();
  ...
  pMemTable.AppendRecord( [ 'firstkey', 'firstvalue' ] );
  ...

DELPHI - How to solve error "...E2009 Incompatible types: 'method pointer and regular procedure'"

..try to surround called procedure as class procedure in class.

type
  TEachRowProcedures = class
  public
    class procedure ExportAsHTML_Proc( ARowIndex: Integer; ARowInfo: TcxRowInfo );
  end;

Call as:

...
_pView.DataController.ForEachRow( true, TEachRowProcedures.ExportAsHTML_Proc );

DELPHI - How to solve error "...Type mismatch for field...,expecting: Date actual: WideString"

-> for solution this error helps installation of new Native SQL client.

DELPHI - How read data from text file divided by semicolon

This example reads two columns from text file saved in this format:

0-0_0_0200;R-IVECO FRANCIE, 57M
0-0_0_2500;KOSTRY/8019-57 MIST
0-00260-X-0_0_0000;PODPĚR. TRUBKA PRAVÁ

For storing is used memory table (TdxMemTable, QData):

procedure TFDrawingImportItems.doReading;
var
  f : TextFile;
  sRow : string;
  aSplitted: TArray< string >;
begin
  { -- delete all rows }

  if QData.Active then
    begin
      QData.Close;
      QData.Open;
    end;

  { -- open file and read data (two columns divided by ";") }

  AssignFile( f, EFileName.Text );
  try
    Screen.Cursor := crHourGlass;
    QData.DisableControls;

    reset( f );
  while not eof( f ) do
    begin
      readln( f, sRow );

      { only two columns }
      aSplitted := sRow.Split( [';'], 2 );

      QData.Insert;
      QDataItemid.AsString := aSplitted[0];
      QDataname.AsString := aSplitted[1];
      QData.Post;
    end;
  finally
    closeFile( f );

    QData.EnableControls;
    Screen.Cursor := crDefault;
  end;

end;

Output should be:

DELPHI - How to load own (animated) cursor

There is a several steps:

1) Prepare cursor - here it is animated cursor in file "cursor_busy.ani".

2) Create file with .rc extension, write path to cursor to it.

CUR_ANIM 21 "c:\delphi\projects\project_name\cursors\cursor_busy.ani"

3) Add link to .rc file to project:

{$R 'myResources.res' 'myResources.rc'}

4) Define internal number for own cursor:

const
  crCursor_Busy = 115;

5) Load defined cursor to app:

const
  Screen.Cursors[ crCursor_Busy ] := LoadCursor( hInstance, 'CUR_ANIM' );

6) Now, when you use this code:

Screen.Cursor := crCursor_Busy;

..you will see this loaded (animated) cursor:

DELPHI - How to work with TDirectory (generic)

TDictionary is collection of key-value. In this example is it used for saving previous values - and its refreshing.

procedure TSQLParams.LoadForSQL( _iSQL_ID : integer );
var
  i : integer;
  b : boolean;
  vValue : variant;
  pParam : TSQLParam;
  pSQLParam : TSQLParam;
  pOldValues : TDictionary < string, variant >;
begin

  pOldValues := TDictionary < string, variant >.Create;

  try
    { -- save old values of params }

    for i := 0 to self.Count - 1 do
      begin
        pParam := TSQLParam( Items[ i ] );

        if not VarIsNull( pParam.vValue ) then
          pOldValues.Add( pParam.sIdent, pParam.vValue );
      end;

    { -- clear all }

    clear;

    { - get info  }

    if DB_SP.sp_params_by_sql_id.Active then DB_SP.sp__params_by_sql_id.Close;
    DB_SP.sp_params_by_sql_id.ParamByName( '@sql_id' ).AsInteger := _iSQL_ID;
    DB_SP.sp_sql_detail_params_by_sql_id.Open;

    DB_SP.sp_params_by_sql_id.First;
    while not DB_SP.sp_params_by_sql_id.Eof do
      begin
        { create new param }

        pSQLParam := TSQLParam( self.Add );
        pSQLParam.sIdent := DB_SP.sp_params_by_sql_id.FieldByName( 'ident' ).AsString.ToLower;
        pSQLParam.vValue := Variants.null;

       { - try to find old saved value }

       b := pOldValues.TryGetValue( pSQLParam.sIdent, vValue );
       if b then pSQLParam.vValue := vValue;

       { - next row }

       DB_SP.sp_params_by_sql_id.Next;

     end;

  finally
    pOldValues.Free;
  end;

end;

DELPHI - How to split string with TStringList class support

For string split you can use class TStringList.

var
  i : integer;
  sResult : string;
  pSplit : TStringList;
begin
  pSplit := TStringList.Create;
  try
    { define delimiter }
    pSplit.Delimiter := ';';

    { - split it }

    pSplit.Clear;
    pSplit.DelimitedText := 'This;is;a;list';

    { - list it }

    sResult := '';
    for i := 0 to pSplit.Count - 1  do
      begin
        sResult := sResult + pSplit[i] + #13;
      end;

    ShowMessage( sResult );

  finally
    pSplit.Free;
  end;

Output:

DELPHI - How ensure (system) path delimiter to end of file path

One of the good technique to ensure, that file path is ended with system delimiter.

var
  sMask : string;
begin
  ..
  sMask := IncludeTrailingPathDelimiter( ExtractFilePath( Application.ExeName ) ) + 
  '*' + '.txt';

Output (should be):

c:\dir\*.txt

DELPHI - How check if OLE library is installed on client

When you use some special OLE object, you can check, if is installed on client (Winapi.ActiveX):

var
  classID: TCLSID;
  sOLEObject: string;
  bIsSupport : boolean;
begin
  { is installed ? }

  sOLEObject := 'Microsoft.DirectMusic.1';
  bIsSupport := CLSIDFromProgID( PWideChar( WideString( sOLEObject ) ), classID ) = S_OK;

  if bIsSupport then ShowMessage( 'Supported.' );
  ...

DELPHI - How to create new directory (..and check if directory exists)

var
  sBackupPath : string;
begin
  ...
  sBackupPath := gsExePath + gcsDictionarySubDir;

  { check if not exists }
  if not DirectoryExists( sBackupPath ) then
    begin
      { try to create new directory }

      b := ForceDirectories( sBackupPath );

      if not b then
        begin
          ShowMessage( 'Backup directory cannot be created.' );
          exit;
        end;
    end;
...

DELPHI - How to make tray icon with WIN API support only (without TTrayIcon)

trayIconData : TNotifyIconData;
...
{ add icon }
with TrayIconData do
begin
  cbSize := sizeOf( trayIconData );
  Wnd := Handle;
  uID := 0;
  uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
  uCallbackMessage := WM_ICONTRAY;
  hIcon := Application.Icon.Handle;
  StrPCopy( szTip, self.Caption );
end;

Shell_NotifyIcon( NIM_ADD, @TrayIconData );

And callback procedure:

procedure TFMain.WMIconTray( var msg : TMessage );
var
  pt : TPoint;
begin
  case msg.lParam of
    { popup menu }
    WM_RBUTTONDOWN:
      begin
         GetCursorPos( pt );
         PopupTray.Popup( pt.x, pt.y );
      end;

    { doubleclick }
    WM_LBUTTONDBLCLK :
      begin
        MPopup_NextClick( nil );
      end;

    { mouse over }
    WM_MOUSEMOVE :
      begin
        self.Caption := gcsTitle + GetNextWordTime;

        with TrayIconData do
        begin
          StrPCopy( szTip, self.Caption );
          uFlags := NIF_TIP;
          Shell_NotifyIcon( NIM_MODIFY, @TrayIconData );
        end;
        
      end;
   end;
end;

And removing after destroy:

procedure TFMain.FormDestroy(Sender: TObject);
begin
  ...
  Shell_NotifyIcon( NIM_DELETE, @trayIconData );
end;

Output:

DELPHI - How to make rotation of shape around point

Suppose this easy class for shape - triangle:

TShape = class( TObject )
  p1 : TPoint;
  p2 : TPoint;
  p3 : TPoint;

  procedure Moving( _iDeltaX, _iDeltaY : integer );
  procedure Rotation( _iAngle : integer );
  procedure RotationAroundXY( _x, _y : integer; _iAngle : integer );
end;

And initialization:

pShape := TShape.Create;
pShape.p1.X := 300;  pShape.p1.Y := 250;
pShape.p2.X := 250;  pShape.p2.Y := 280;
pShape.p3.X := 350;  pShape.p3.Y := 330;

For rotation shape around point use this code:

procedure TShape.RotationAroundXY( _x, _y : integer; _iAngle : integer );
var
  iNewX, iNewY : integer;
  dCos, dSin : double;
  dRadian : double;
  p1x, p1y, p2x, p2y, p3x, p3y : integer;
begin
  { -- angle }

  dRadian := ( 2 * pi ) / ( 360 / _iAngle );
                     
  dCos := cos( dRadian );
  dSin := sin( dRadian );

  { -- point for rotation around (in other case the rotation is around start of coords) }

  p1x := p1.x - _x;
  p1y := p1.y - _y;
  p2x := p2.x - _x;
  p2y := p2.y - _y;
  p3x := p3.x - _x;
  p3y := p3.y - _y;

  { -- calculation of the positions }

  iNewX := round( ( p1x * dCos ) - ( p1y * dSin ) );
  iNewY := round( ( p1y * dCos ) + ( p1x * dSin ) );
  p1.X := iNewX + _x;
  p1.Y := iNewY + _y;

  iNewX := round( ( p2x * dCos ) - ( p2y * dSin ) );
  iNewY := round( ( p2y * dCos ) + ( p2x * dSin ) );
  p2.X := iNewX + _x;
  p2.Y := iNewY + _y;

  iNewX := round( ( p3x * dCos ) - ( p3y * dSin ) );
  iNewY := round( ( p3y * dCos ) + ( p3x * dSin ) );
  p3.X := iNewX + _x;
  p3.Y := iNewY + _y;
end;

Output:

DELPHI - How get greatest common divisor (for two digits)

The function returns greatest common divisor for two digits. When it does not found it, returns 1.

function GCD( _iNumber1, _iNumber2 : integer ) : integer;
var
  iTemp : integer;
begin
  if _iNumber1 < 0 then _iNumber1 := -_iNumber1;
  if _iNumber2 < 0 then _iNumber2 := -_iNumber2;

  repeat

    if _iNumber1 < _iNumber2 then
      begin
        iTemp := _iNumber1;
        _iNumber1 := _iNumber2;
        _iNumber2 := iTemp;
      end;

    _iNumber1 := _iNumber1 mod _iNumber2;

  until ( _iNumber1 = 0 );

  result := _iNumber2;
end;

Calling:

var
  i : integer;
begin
  i := GCD( 12, 16 );

  ShowMessage( IntToStr( i ) );
end;

Output:

DELPHI - How to show chi-square distribution curve

Propability density function (chi-square distribution).

var
  i, iK : integer;
  iX, iY, iGamma, iNumerator, iDenominator : double;
  pSerie : TLineSeries;
  pIntegral : TIntegral;
begin
  Memo1.Clear;

  pSerie := TLineSeries( Chart1.Series[0] );
  pSerie.Clear;

  pIntegral := TIntegral.Create;
  pIntegral.iStep := 0.05;
  pIntegral.SetInterval( 0.001, 20 );

  { -- set param + calc GAMMA function }

  iK := 8;
  iGamma := GetGamma( iK/2 );

  for i := 0 to pIntegral.pX.Count - 1 do
    begin
      iX := pIntegral.pX.GetValue( i );

      try
        iNumerator := power( iX, iK/2-1 ) * exp( ( -1*iX ) /2 );
        iDenominator := power( 2, iK / 2 ) * iGamma;

        if iDenominator <> 0 then
          iY := iNumerator / iDenominator
        else
          iY := 0;
      except
        iY := 0;
      end;
      pIntegral.pY.AddValue( iY );

      { -- add to chart }

      pSerie.AddXY( iX, iY );
    end;
end;

And here is very important Gamma() function with k parameter.

function GammaStirF( X : double ) : double;
var
  y : double;
  w : double;
  v : double;
  stir : double;
begin
  w := 1 / x;
  stir := 7.87311395793093628397E-4;
  stir := -2.29549961613378126380E-4 + w * stir;
  stir := -2.68132617805781232825E-3 + w * stir;
  stir := 3.47222221605458667310E-3 + w * stir;
  stir := 8.33333333333482257126E-2 + w * stir;
  w := 1 + w * stir;
  y := exp(x);
  if x > 143.01608 then
    begin
      v := power( x, 0.5 * x -0.25 );
      y := v *( v / y );
    end
  else
    begin
      y := power( x, x -0.5 ) / y;
    end;
  result := 2.50662827463100050242 * y * w;
end;

function GetGamma( _x : double ) : double;
var
  p : double;
  PP : double;
  q : double;
  QQ : double;
  z : double;
  i : longint;
  SgnGam : double;
begin
  SgnGam := 1;
  q := abs( _x );
  if q > 33.0 then
  begin
    if _x < 0.0 then
    begin
      p := floor(q);
      i := round(p);

      if i mod 2 = 0 then
      begin
        SgnGam := -1;
      end;

      z := q - p;

      if z > 0.5 then
      begin
        p := p+1;
        z := q-p;
      end;

      z := q * sin( pi * z );
      z := Abs(z);
      z := pi / ( z * GammaStirF( q ) );
    end
    else
    begin
      z := GammaStirF( _x );
    end;
    result := SgnGam * z;
    exit;
  end;
  z := 1;
  while _x >= 3 do
  begin
    _x := _x - 1;
    z := z *_x;
  end;
  while _x < 0 do
  begin
    if _x > -0.000000001 then
    begin
      result := z / ( ( 1 + 0.5772156649015329 *_x ) * _x );
      exit;
    end;
    z := z /_x;
    _x := _x + 1;
  end;
  while _x < 2 do
  begin
    if _x < 0.000000001 then
    begin
      result := z / ( ( 1 + 0.5772156649015329 * _x ) *_x );
      exit;
    end;
    z := z /_x;
    _x := _x + 1.0;
  end;
  if _x = 2 then
  begin
    result := z;
    exit;
  end;

  _x := _x - 2.0;
  PP := 1.60119522476751861407E-4;
  PP := 1.19135147006586384913E-3 + _X * PP;
  PP := 1.04213797561761569935E-2 + _X * PP;
  PP := 4.76367800457137231464E-2 + _X * PP;
  PP := 2.07448227648435975150E-1 + _X * PP;
  PP := 4.94214826801497100753E-1 + _X * PP;
  PP := 9.99999999999999996796E-1 + _X * PP;
  QQ := -2.31581873324120129819E-5;
  QQ := 5.39605580493303397842E-4 + _X * QQ;
  QQ := -4.45641913851797240494E-3 + _X * QQ;
  QQ := 1.18139785222060435552E-2 + _X * QQ;
  QQ := 3.58236398605498653373E-2 + _X * QQ;
  QQ := -2.34591795718243348568E-1 + _X * QQ;
  QQ := 7.14304917030273074085E-2 + _X * QQ;
  QQ := 1.00000000000000000320 + _X * QQ;

  result := z * PP / QQ;
  exit;
end;

Output:

k=2

k=8

DELPHI - How to show normal distribution curve (Gaussian)

Typical propability density function (Gaussian distribution).

var
  i : integer;
  iY : double;
  pDN : TDistribution_Normal;
  pSerie : TLineSeries;
begin
  Memo1.Clear;

  /* prepare chart */

  pSerie := TLineSeries( Chart1.Series[0] );
  pSerie.Clear;

  /* prepare distribution data */

  pDN := TDistribution_Normal.Create;
  pDN.Init( 0, 1 );

  for i := 0 to pDN.pIntegral.pY.Count - 1 do
    begin
      { -- get value }

      iY := pDN.pIntegral.pY.GetValue( i );

      pSerie.AddXY( i, iY );
    end;

And here is very important TDistribution_Normal.Init() function with parameters as MEAN and SIGMA, here is generated range MEAN +-3.5 SIGMA.
The sum values under curve is equeal to 1.

function TDistribution_Normal.Init( _iMean, _iSigma : double ) : boolean;
var
  i : integer;
  iFrom, iTo, iValue : double;
begin
  result := false;

  { -- check }

  if _iSigma <= 0 then
    begin
      ShowMessage( 'Distribution_Normal() - standard deviation can`t be 0.' );
      exit;
    end;

  { -- add range -3.5 sigma - Mean - + 3.5 sigma }

  pIntegral.Clear;

  iFrom := _iMean - ( 3.5 * _iSigma );
  iTo := _iMean + ( 3.5 * _iSigma );
  { aproximation - 300 items }
  pIntegral.iStep := ( iTo - iFrom ) / 300;
  pIntegral.SetInterval( iFrom, iTo );

  { -- calc values normal distribution for every X }

  for i := 0 to pIntegral.pX.Count - 1 do
    begin
      iValue := ( 1 / ( _iSigma * sqrt( 2*pi ) ) ) * 
                exp( - ( sqr( pIntegral.pX.GetValue( i ) - _iMean ) ) / 
                ( 2 * sqr( _iSigma ) ) );

      pIntegral.pY.AddValue( iValue );
    end;

  pIntegral.Calc;

  result := true;
end;

Output:

DELPHI - How get hash value for file (SHA-1 fingerprint)

Hash function returns same value for same (in this case) file. This uses SHA-1 (Secure Hash Algorithm) algorithm.

uses IdHashMessageDigest;
...
var
  sFile : string;
  pSHA : TIdHashSHA1;
  pStream : TFileStream;
begin
  sFile := 'c:\_ax\error.png';

  pSHA := TIdHashSHA1.Create;
  pStream := TFileStream.Create( sFile, fmOpenRead or fmShareDenyWrite );

 try
   ShowMessage( 'File fingerprint = ' + pSHA.HashStreamAsHex( pStream ) );
 finally
   pStream.Free;
   pSHA.Free;
 end;

Output: