V následujícím textu si ukážeme, jak naprogramovat nový přístroj pomocí nativních procedur přístroje drawing. Ve vytvářené aplikaci potřebujeme například víceúrovňový indikátor

Do aplikace vložíme přístroj drawing, který nabízí řadu nativních procedur pro vytvoření kresby. Budeme předpokládat, že přístroj bude použit jako vzor (template) a bude ho tedy možné parametrizovat. Nastavení parametrů bude možné definovat v uživatelsky definované proceduře Init() a v proceduře CreateSelf() vytvoříme pomocí nativních procedur přístroje drawing vlastní vzhled přístroje. Obě tyto procedury budou volány z procedury OnStartup().

const
  MAX_LEVELS = 5;
end_const;
static
  OrgDim : real;
  OrgValY : real;
  NoOfLevels : cardinal {init_value = 5};
  Levels : array[ 1..MAX_LEVELS ] of real {init_value = 20,30,70,80};
  Colors : array[ 1..MAX_LEVELS ] of longcard {init_value = val( '0000FF', 16 ),val( '00FFFF', 16 ),val( '00FF00', 16 ),val( '00FFFF', 16 ),val( '0000FF', 16 )};
  Reflection : boolean {init_value = true};
  RangeFrom : real;
  RangeTo : real {init_value = 100};
  Value : real;
end_static;

V proceduře Init() nastavíme přístroji potřebné parametry tak, aby vyhovovaly konkrétní instanci přístroje.

procedure Init();
begin
  // Init parameters here
  // --------------------
  NoOfLevels = 5;
  Levels[ 1 ] = 20;
  Levels[ 2 ] = 30;
  Levels[ 3 ] = 70;
  Levels[ 4 ] = 80;
  Reflection = true;
  RangeFrom = 0;
  RangeTo = 100;
  Value = 0;
  Colors[ 1 ] = system.ColorNameToColor( 'lred' );
  Colors[ 2 ] = system.ColorNameToColor( 'lyellow' );
  Colors[ 3 ] = system.ColorNameToColor( 'lgreen' );
  Colors[ 4 ] = system.ColorNameToColor( 'lyellow' );
  Colors[ 5 ] = system.ColorNameToColor( 'lred' );
end_procedure;

V proceduře CreateSelf() definujeme vzhled přístroje pomocí nativních procedur přístroje drawing.

procedure CreateSelf();
var
  c : cardinal;
  s : string;
begin
  s = 'Meter';
  CreateGroup( '', s );
  SetObjectSize( '', 100, 100 );
    
  s = 'Levels';
  CreateGroup( 'Meter', s );

  s = 'Reflection';
  CreateGroup( 'Meter', s );
  
  s = 'Value';
  CreateGroup( 'Meter', s );     


  s = 'Line1';
  CreateLine( 'Meter.Value', s, 0, 48, 45, 50 );   
  s = 'Line2';
  CreateLine( 'Meter.Value', s, 0, 52, 45, 50 );
  s = 'Line3';
  CreateLine( 'Meter.Value', s, 0, 49, 40, 50 );
  s = 'Line4';
  CreateLine( 'Meter.Value', s, 0, 50, 40, 50 );
  s = 'Line5';
  CreateLine( 'Meter.Value', s, 0, 51, 40, 50 );

  SetStrokeColorType( 'Meter.Value.Line*', 1 );
  SetStrokeWidth( 'Meter.Value.Line*', 1 );     
  SetStrokeStyle( 'Meter.Value.Line*', 'full' );       
  SetStrokeColor( 'Meter.Value.Line*', 0, 0, 0, 1 );

  if Reflection then
    s = 'Reflection1';
    CreateRect( 'Meter.Reflection', s, 0, 0, 100, 100, 0, 0 );
    SetStrokeColorType( 'Meter.Reflection.Reflection1', 0 );
    SetFillColorType( 'Meter.Reflection.Reflection1', 2 );
    SetFillGradientColor( 'Meter.Reflection.Reflection1', 1, 0.509, 0.509, 0.509, 0.403 );   
    SetFillGradientOffset( 'Meter.Reflection.Reflection1', 1, 0 );
    SetFillGradientColor( 'Meter.Reflection.Reflection1', 2, 1.0, 1.0, 1.0, 0.525 );
    SetFillGradientOffset( 'Meter.Reflection.Reflection1', 2, 0.5 );
    SetFillGradientColor( 'Meter.Reflection.Reflection1', 3, 0.619, 0.619, 0.619, 0.411 );
    SetFillGradientOffset( 'Meter.Reflection.Reflection1', 3, 1.0 );
  end;
  
  // Create levels 
  NoOfLevels = min2( NoOfLevels, MAX_LEVELS ); 
  for c = NoOfLevels to 1 by -1 do
    s = 'Level' + c:s;
    CreateRect( 'Meter.Levels',  s, 0, (NoOfLevels - c) * (100 / NoOfLevels), 100, 100 / NoOfLevels, 0, 0 );
    SetStrokeColorType( 'Meter.Levels.' + s, 0 );
    SetFillColor( 'Meter.Levels.' + s, Colors[ c ] );
  end;
  
  SetZoomMode( 1 );
end_procedure;

Inicializaci a vytvoření přístroje vyvoláme z událostní procedury OnStartup(), které se volá jako první po spuštění aplikace.

procedure OnStartup();       
var
  c : cardinal;
  x, y, w, d : real;
begin
  Init();
  CreateSelf();
  
  if not GetObjectRect( 'Meter', x, y, w, OrgDim ) then
    system.DebugOutput( 'ERROR: ' + GetName() + ' Meter group not found!');
    system.StopApplication();
  end;  
  
  if not GetObjectRect( 'Meter.Value', x, y, w, d ) then
    system.DebugOutput( 'ERROR: ' + GetName() + ' Meter.Value group not found!');
    system.StopApplication();
  end;  
  OrgValY = y + d / 2;

  SetValueColor( GetColor( 'Meter.Value' ) );
  for c = 1 to NoOfLevels do
    SetFillColor( 'Meter.Levels.Level' + c:s, Colors[ c ] );
  end; (* for *)  
  SetLevels( Levels );
  SetValue( Value );
end_procedure;

Dále do přístroje doplníme procedury pro nastavení zobrazované hodnoty, rozsahu, nastavení pásem a barev.

procedure SetValue( V : real );
var
  y : real;                 
begin
  Value = V;
  y = (RangeTo - V) * OrgDim/(RangeTo - RangeFrom) - OrgValY;     
  TransformReset( 'Meter.Value' );
  TransformTranslate( 'Meter.Value', 0, y );
  Paint();
  if PBox <> null then
    PBox->SetColor( 'interior', GetLevelColorByValue( Value ) );
  end;
end_procedure;

procedure SetRange( From, To : real );
begin
  RangeFrom = From;
  RangeTo = To;
  SetLevels( Levels );
end_procedure;

procedure SetLevels( L : array of real );
var
  c : cardinal;
  d : real;
begin
  for c = 1 to NoOfLevels - 1 do
    d = (L[ c ] - RangeFrom) * OrgDim / (abs(RangeTo) + abs(RangeFrom));
    SetRectParameters( 'Meter.Levels.Level' + c:s, 0, OrgDim - d, 100, d, 0, 0 );
  end;  
  d = (RangeTo - RangeFrom) * OrgDim / (abs(RangeTo) + abs(RangeFrom));
  SetRectParameters( 'Meter.Levels.Level' + NoOfLevels:s, 0, OrgDim - d, 100, d, 0, 0 );
  SetValue( Value );
end_procedure;

procedure SetValueColor( RGB : longcard );
begin                             
  SetFillColor( 'Meter.Value', RGB );
  Paint();
end_procedure;

procedure SetLevelColor( Level : shortcard; RGB : longcard );
begin                             
  if (Level > 0) and (Level <= NoOfLevels) then
    SetFillColor( 'Meter.Levels.Level' + Level:s, RGB );
    Paint();
  end;
end_procedure;

procedure GetLevelColorByValue( Value : real ): longcard;
var
  c : cardinal;
begin
  for c := 1 to NoOfLevels - 1 do
    if Value <= Levels[ c ] then
      return Colors[ c ];
    end;  
  end;
  return Colors[ NoOfLevels ];
end_procedure;

Pokud bude přístroj časován, pak můžeme proceduru pro nastavení hodnoty SetValue() volat z procedury OnActivate(). Případně můžeme volat tuto proceduru z kódu jiné procedury.

procedure OnActivate();
begin
  SetValue( expr ); // expr <= value to be displayed
end_procedure;

Celá ukázková aplikace je ke stažení zde.