DELPHI - How to make Chalkin interpolation

procedure TForm1.ChaikinProc( var pNewX, pNewY : TVariable );
var
  iIndex : integer;
  iQx, iQy, iRx, iRy : double;
  iValue1, iValue2 : double;
  pNewListX, pNewListY : TVariable;
begin

  try
    pNewListX := TVariable.Create;
    pNewListY := TVariable.Create;

    { first }
    pNewListX.AddValue( pNewX.GetValue( 0 ) );
    pNewListY.AddValue( pNewY.GetValue( 0 ) );

    for iIndex := 0 to pNewX.Count - 2 do
      begin
        { - calc new Q coord }
        
        iQx := ( 0.75 * pNewX.GetValue( iIndex ) ) + ( 0.25 * pNewX.GetValue( iIndex + 1 ) );
        iQy := ( 0.75 * pNewY.GetValue( iIndex ) ) + ( 0.25 * pNewY.GetValue( iIndex + 1 ) );

        { - calc new R coord }

        iRx := ( 0.25 * pNewX.GetValue( iIndex ) ) + ( 0.75 * pNewX.GetValue( iIndex + 1 ) );
        iRy := ( 0.25 * pNewY.GetValue( iIndex ) ) + ( 0.75 * pNewY.GetValue( iIndex + 1 ) );

        { - add it to values list }

        pNewListX.AddValue( iQx );
        pNewListY.AddValue( iQy );
        pNewListX.AddValue( iRx );
        pNewListY.AddValue( iRy );
      end;

    { last }
    pNewListX.AddValue( pNewX.GetValue( pNewX.Count - 1 ) );
    pNewListY.AddValue( pNewY.GetValue( pNewY.Count - 1 ) );

    { copy }
    pNewListX.CopyTo( pNewX, true );
    pNewListY.CopyTo( pNewY, true );

  finally
    pNewListX.Free;
    pNewListY.Free;
  end;

end;

{ ---------------------------------------------------------------------------
  Chalkin`s curve.
  -------------------------------------------------------------------------- }
procedure TForm1.Chaikin;
var
  i, N : integer;
  pNewX, pNewY : TVariable;
  pSerieLine : TLineSeries;
begin
  pNewX := TVariable.Create;
  pNewY := TVariable.Create;

  for i := 0 to pX.Count - 1 do
    begin
      pX.CopyTo( pNewX );
      pY.CopyTo( pNewY );
    end;

  { get value from scrollbar }
  N := SChalkinFactor.Position;

  { count of smoothing }
  for i := 1 to N do
    ChaikinProc( pNewX, pNewY );

  pSerieLine := TLineSeries( Chart1.Series[1] );
  pSerieLine.Clear;

  for i := 0 to pNewX.Count - 1 do
  begin
    pSerieLine.AddXY( pNewX.GetValue( i ), pNewY.GetValue( i ) );
  end;

  pNewX.Free;
  pNewY.Free;
end;

Smoothing factor = 1

Smoothing factor = 10

DELPHI - How to make Lagrange interpolation

{ ---------------------------------------------------------------------------
  Calc Lagrange polynomial.
  -------------------------------------------------------------------------- }
function TForm1.CalcLagrange( _iX : double ) : double;
var
  i, j : integer;
  iNumerator, iDenominator : double;
begin
  result := 0;

  for i := 1 to pX.Count - 1 do
    begin
      iNumerator := 1;
      iDenominator := 1;

      for j := 1 to pX.Count - 1 do
        if j <> i then
          begin
            iNumerator := iNumerator * ( _iX - pX.GetValue( j ) );
            iDenominator := iDenominator * ( pX.GetValue( i ) - pX.GetValue( j ) );
          end;

      result := result + ( pY.GetValue( i ) * ( iNumerator / iDenominator ) );    
    end;
end;

{ ---------------------------------------------------------------------------
  Lagrange interpolation.
  -------------------------------------------------------------------------- }
procedure TForm1.Lagrange;
var
  j, i, iIndex : integer;
  iNumSegmentsCount : integer;
  iT, i1_T, iB0, iB1, iB2, iB3 : double;
  iNewX, iNewY : double;
  pSerieLine : TLineSeries;
  iValue : extended;
begin

  pSerieLine := TLineSeries( Chart1.Series[1] );
  pSerieLine.Clear;  

  { draw count of cubic curves }
  for iIndex := 0 to px.Count - 2 do
    begin

       { every curve generate from I parts }
       for i := 0 to 10 - 1 do
         begin
           iT := i / (10-1);

           iNewX := pX.GetValue( iIndex ) + 
                    ( (pX.GetValue( iIndex + 1 ) - pX.GetValue( iIndex )) * iT );

           iNewY := CalcLagrange( iNewX );          

           pSerieLine.AddXY( iNewX, iNewY );
         end;

  end;
end;

DELPHI - How make Ferguson cubic interpolation curve

procedure TForm1.Ferguson;
var
  j, i, iIndex : integer;
  iNumSegmentsCount : integer;
  iT, i1_T, iP0x, iP0y, iP1x, iP1y : double;
  iF1, iF2, iF3, iF4 : double;
  iNewX, iNewY : double;
  pSerieLine : TLineSeries;
  iValue : extended;
begin

  pSerieLine := TLineSeries( Chart1.Series[1] );
  pSerieLine.Clear;

  { draw specified count of the cubic curves }
  for iIndex := 0 to px.Count - 2 do
    begin

       { every cube generate from I parts }
       for i := 0 to giDetail - 1 do
         begin
           iT := i / (giDetail-1);

           { -- calculate Hermid polynomials }

           iF1 := ( 2 * power( iT, 3 ) ) - ( 3 * power( iT, 2 ) ) + 1;
           iF2 := ( -2 * power( iT, 3 ) ) + ( 3 * power( iT, 2 ) );
           iF3 := power( iT, 3 ) - ( 2 * power( iT, 2 ) ) + iT;
           iF4 := power( iT, 3 ) - power( iT, 2 );

           { -- and vectors }

           iP0x := abs( pX.GetValue( iIndex + 1 ) - pX.GetValue( iIndex ) );
           iP0y := abs( pY.GetValue( iIndex + 1 ) - pY.GetValue( iIndex ) );

           iP1x := abs( pX.GetValue( iIndex ) - pX.GetValue( iIndex + 1 ) );
           iP1y := abs( pY.GetValue( iIndex ) - pY.GetValue( iIndex + 1 ) );

           iNewX := ( pX.GetValue( iIndex ) * iF1 ) +
                    ( pX.GetValue( iIndex + 1 ) * iF2 ) +
                    ( iP0x * iF3 ) +
                    ( iP1x * iF4 );
           iNewY := ( pY.GetValue( iIndex ) * iF1 ) +
                    ( pY.GetValue( iIndex + 1 ) * iF2 ) +
                    ( iP0y * iF3 ) +
                    ( iP1y * iF4 );

           pSerieLine.AddXY( iNewX, iNewY );
         end;

  end;
end;

AX - Error message: "Cannot delete a record in Raw registrations (JmgTermReg). An update conflict occurred due to another user process deleting the record or changing one or more fields in the record."

This error shows in "Job registration" module for worker.

The reason is probably in "optimistic concurrency model" on the table JmgTermReg (table part is locked for changes)".

My solution:

1) Set JmgTermReg.OCCEnabled to No. Save it.
2) Connect with worker to "Job registration", and run action for him again (for example - clock out).
3) Set JmgTermReg.OCCEnabled again back to Yes. Save it.

Note: The reason could be bad session time on some client.

DELPHI - How make Catmull-Rom spline (interpolation)

function TForm1.GetCatmull_RomProc( _iT : double; _p0, _p1, _p2, _p3 : double ) : double;
begin
  result := 0.5 * ( ( 2 * _p1 ) +
                    ( ( ( -1 * _p0 ) + _p2 ) * _iT ) +
                    ( ( ( 2 * _p0 ) - ( 5 * _p1 ) + ( 4 * _p2 ) - _p3 ) * _iT * _iT ) +
                    ( ( ( - 1 * _p0 ) + ( 3 * _p1 ) - ( 3 * _p2 ) + _p3 ) * _iT * _iT * _iT )
                  );
end;

{ ---------------------------------------------------------------------------
  Catmull-Rom interpolation curve.
  -------------------------------------------------------------------------- }
procedure TForm1.Catmull_Rom;
var
  j, i, iIndex : integer;
  iNumSegmentsCount : integer;
  iT, i1_T, iP0, iP1, iP2, iP3 : double;
  iNewX, iNewY : double;
  pSerieLine : TLineSeries;
  iValue : extended;
  pNewX, pNewY : TVariable;
begin
  pNewX := TVariable.Create;
  pNewY := TVariable.Create;

  for i := 0 to pX.Count - 1 do
    begin
      pX.CopyTo( pNewX );
      pY.CopyTo( pNewY );
    end;

  { first and last point again }
  pNewX.InsertValue( 0, pNewx.GetValue( 0 ) );
  pNewY.InsertValue( 0, pNewy.GetValue( 0 ) );

  pNewX.InsertValue( pNewX.Count - 1, pNewx.GetValue( pNewX.Count - 1 ) );
  pNewY.InsertValue( pNewY.Count - 1, pNewy.GetValue( pNewY.Count - 1 ) );

  pSerieLine := TLineSeries( Chart1.Series[1] );
  pSerieLine.Clear;

  { draw count of cubic curves }
  for iIndex := 0 to pNewX.Count - 4 do
    begin

       { every curve generate from I parts }
       for i := 0 to giDetail - 1 do
         begin
           iT := i / (giDetail-1);
           i1_T := 1 - iT;

           iNewX := GetCatmull_RomProc( iT, pNewx.GetValue( iIndex ), 
                                        pNewx.GetValue( iIndex + 1 ),
                                        pNewx.GetValue( iIndex + 2 ), 
                                        pNewx.GetValue( iIndex + 3 )
                                      );

           iNewY := GetCatmull_RomProc( iT, pNewy.GetValue( iIndex ), 
                                        pNewy.GetValue( iIndex + 1 ),
                                        pNewy.GetValue( iIndex + 2 ), 
                                        pNewy.GetValue( iIndex + 3 )
                                      );

           pSerieLine.AddXY( iNewX, iNewY );
         end;

  end;

  pNewX.Free;
  pNewY.Free;
end;

DELPHI - How send message to control

To the control TreeSql_Hierarchy is sended KEYDOWN message, that simulate INSERT key with SHIFT:

SendMessage( TreeSql_Hierarchy.Handle, WM_KEYDOWN, VK_INSERT, MapVirtualKey( VK_SHIFT, 0 ) );

DELPHI - How to open Excel with .xls/.xlsx file

In sFile variable is saved path to opened file.

var
  sFile : string;
  pExcel : TExcelApplication;
begin
  ...
  iLocaleID := GetUserDefaultLCID;

  pExcel := TExcelApplication.Create( nil );                  
  pExcel.DisplayAlerts[ iLocaleID ] := false;
  pExcel.Connect;
  pExcel.Visible[ iLocaleID ] := true;

  pExcel.Workbooks.Open( sFile,
                         EmptyParam, EmptyParam, EmptyParam,
                         EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                         EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                         EmptyParam, EmptyParam, EmptyParam, iLocaleID );

In old Delphi (6) I used directed opening through COM, something like this:

uses ComObj;

const
  cExcelIdentifier = 'excel.application';

{ ---------------------------------------------------------------------------
  Try to run it.
  --------------------------------------------------------------------------- }
function TExcel.Execute : boolean;
begin
  result := false;

  FExcel := CreateOleObject( cExcelIdentifier );

  if VarIsEmpty( FExcel ) then
    begin
      MessageDlg( 'Application is not accessible.', mtError,  [mbOk], 0 );
      exit;
    end;

  FExcel.Visible := true;
  FExcel.Workbooks.Add( 1 );

  result := true;
end;

DELPHI - How to call external program

This code execute external program (FFileName as path, FParams as optional parameters). It uses ShellExecuteEx(), in old Windows (XP and older) you can use ShellExecute() too.

function TExecute.Execute : THandle;
var 
  iShowCmd : integer;  
  b : boolean;
  exInfo : SHELLEXECUTEINFO;
begin

  iShowCmd := sw_ShowNormal;
  case FShowType of
    stNormal         : iShowCmd := sw_ShowNormal;
    stMaximized      : iShowCmd := sw_ShowMaximized;
    stMinimize       : iShowCmd := sw_Minimize;
    stHide           : iShowCmd := sw_Hide;
    stRestore        : iShowCmd := sw_Restore;
    stShow           : iShowCmd := sw_Show;
    stShowMinimized  : iShowCmd := sw_ShowMinimized;
    stShowNA         : iShowCmd := sw_ShowNA;
    stShowNoActivate : iShowCmd := sw_ShowNoActivate;
  end;

  { -- run it }

  exInfo.cbSize := sizeof( SHELLEXECUTEINFO );
  exInfo.fMask := SEE_MASK_NOCLOSEPROCESS; 
  exInfo.wnd := Application.Handle;
  exInfo.lpVerb := pchar( 'open' ); 
  exInfo.lpFile := pchar( FFileName );
  exInfo.lpParameters := pChar( FParams );
  exInfo.nShow := SW_SHOWNORMAL;
  //exInfo.hInstApp = NULL;
  //exInfo.lpDirectory = NULL;

  b := ShellExecuteEx( @exInfo );

  SetWindowPos(result, HWND_TopMost, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);

  if not b then ShowMessage( 'Execute problem: ' + IntToStr( GetLastError ) );

  result := GetLastError;
end;

DELPHI - How to make "stack" for colors

Returned colors are repeated still in same order.

{ ***************************************************************************

  TColorStack - stack for colors.

  ************************************************************************** }

  TColorStack = class
  private
    pList : TList;

    iCurrent : integer;
  public
    constructor Create;
    destructor Destroy; override;

    function GetColor : TColor;
    procedure Reset;
  end;

constructor TColorStack.Create;
begin
  inherited Create;

  pList := TList.Create;

  { -- add some colors to list }

  Reset;
end;

destructor TColorStack.Destroy;
begin
  pList.Free;

  inherited destroy;
end;

{ ---------------------------------------------------------------------------
  Get next color from list.
  -------------------------------------------------------------------------- }
function TColorStack.GetColor : TColor;
begin
  result := TColor( pList[ iCurrent ] );

  inc( iCurrent );
  if iCurrent > pList.Count - 1 then iCurrent := 0;
end;

{ ---------------------------------------------------------------------------
  Reset to initial state.
  -------------------------------------------------------------------------- }
procedure TColorStack.Reset;
begin
  pList.Clear;

  pList.Add( Pointer( TColor( rgb( 99, 167, 54 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 245, 71, 106 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 91, 115, 196 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 249, 251, 155 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 148, 148, 148 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 207, 118, 189 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 170, 231, 152 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 126, 221, 226 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 181, 176, 130 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 244, 202, 53 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 209, 209, 209 ) ) ) );
  pList.Add( Pointer( TColor( rgb( 74, 61, 245 ) ) ) );

  iCurrent := 0;
end;

SQL SERVER - How get info about database

SQL server command (stored procedure):

exec sp_helpdb 'framework'

AX - "UPDATE" job

"Update job" - it change flushing princip on group of items to "Finish".

static void SetFlushingPrincipItem(Args _args)
{
    InventTable inventTable;
    
    ttsBegin;

    while
    select forUpdate * from inventtable
    where
    inventTable.ItemId like "S-*" &&
    inventTable.ProdFlushingPrincip != ProdFlushingPrincipItem::Finish
    {      
        inventTable.ProdFlushingPrincip = ProdFlushingPrincipItem::Finish;          
        inventTable.update();
        
        info( InventTable.ItemId );     
    }

    ttsCommit;

    info( 'OK' );    
}

ORACLE - How to set user`s password and how to unlock account

connect sys/password as sysdba;

alter user UserName identified by NewTestPassword account unlock;

JAVA - How to get local IP address and host name

import java.net.InetAddress;
import java.net.UnknownHostException;
...
try {
  InetAddress ia = InetAddress.getLocalHost();

  /* -- write results */

  System.out.println( ia.getHostAddress() );
  System.out.println( ia.getHostName() );

  System.out.println( ia.toString() );

  System.out.println( ia.getCanonicalHostName() );

  for ( int i = 0; i < ia.getAddress().length; i++ )
    System.out.println( ia.getAddress()[i] );

} catch ( UnknownHostException ex ) {
}

Output (could be):

10.26.1.11
pc082
pc082/10.26.1.11
pc082.org.local
10
26
1
11

AX - How use Query with date range (since-till) in where condition

When you need use date range in Query where condition, use SysQuery::range() function:

ProdRouteTrans prodRouteTrans;
Query q; 
QueryBuildDataSource qDS; 
QueryBuildRange qRange;
QueryRun qRun;
...
while
  select * from vm_resources
  where
  vm_resources.resource_mask != "" &&
  vm_resources.active == NoYes::Yes
  {
    q = new Query();
    qDS = q.addDataSource( TableNum( ProdRouteTrans ) );

    /* date range since..till */
    qRange = qDS.addRange( FieldNum( ProdRouteTrans, DateWIP ) );
    qRange.value( SysQuery::range( startDate, endDate ) );

    qRun = new QueryRun( q );
    while ( qRun.next() )
    {
       /* get ProdRouteTrans data from query */
       prodRouteTrans = qRun.get( TableNum( ProdRouteTrans ) );
       ...
    }
  ...
}

AX - How use Query with enum in where condition

When you need use enum item in Query where condition, use queryValue() function:

ProdRouteTrans prodRouteTrans;
Query q; 
QueryBuildDataSource qDS; 
QueryBuildRange qRange;
QueryRun qRun;
...
while
  select * from vm_resources
  where
  vm_resources.resource_mask != "" &&
  vm_resources.active == NoYes::Yes
  {
    q = new Query();
    qDS = q.addDataSource( TableNum( ProdRouteTrans ) );

    /* where condition: Qty only */
    qRange = qDS.addRange( FieldNum( ProdRouteTrans, TransType ) );
    qRange.value( queryValue( ProdRouteTransType::Qty ) );

    qRun = new QueryRun( q );
    while ( qRun.next() )
    {
       /* get ProdRouteTrans data from query */
       prodRouteTrans = qRun.get( TableNum( ProdRouteTrans ) );
       ...
    }
  ...
}

WIN OS - How to update client group policy settings

gpupdate /force

Output:

C:\Windows\System32>gpupdate /force
Updating policy...

Computer Policy update has completed successfull
User Policy update has completed successfully.

WIN OS - How get name of connection DC (domain controller)

echo %logonserver%

SQL SERVER - How call stored procedure automatically when SQL server instance started

This code call stored proc dbo.MyCreatePermissions after SQL server instance start:

EXEC sp_procoption N'[dbo].[MyCreatePermissions]', 'startup', '1'

Note: For disable it use 'startup', '0'.