Příklady PASCAL: Porovnání verzí

Z K.A.P.
Skočit na navigaciSkočit na vyhledávání
 
(Není zobrazeno 7 mezilehlých verzí od stejného uživatele.)
Řádek 337: Řádek 337:
  
 
----
 
----
−
====Příklad 12 - Práce s XML za pomocí Msxml2.DOMDocument====
+
====Příklad 12 - Čtení dat z XML za pomocí Msxml2.DOMDocument====
 
  var
 
  var
 
   XMLDoc: Variant;
 
   XMLDoc: Variant;
Řádek 391: Řádek 391:
 
   end;
 
   end;
 
  end.
 
  end.
 +
----
 +
 +
====Příklad 13 - Zápis do XML souboru za pomocí Msxml2.DOMDocument====
 +
var
 +
  sklad, Kod: String;
 +
  tKarty: TKAPBtrTable;
 +
  tZasoby: TKAPBtrTable;
 +
  FldKarKod, FldKarCena, FldKarTypKarty, FldKarNazev, FldKarExtNazev, FldKarZobrazit, FldKarHmotnost, FldZasCena3, FldZasZasoba: TField;
 +
  IndPrice: TKAPIndPrice;
 +
  XMLDoc, Root, Item, PI: Variant;
 +
  Cena, CenaSDPH: Double;
 +
  Datum: TDateTime;
 +
 +
  procedure WriteTag(TagName, TagValue: string);
 +
  var Node: Variant;
 +
  begin
 +
    Node := XMLDoc.createElement(TagName);
 +
    Node.text := TagValue;
 +
    Item.appendChild(Node);
 +
  end;
 +
 +
begin
 +
  Sklad := Trim(Settings.Values['INI.StredKod']);
 +
  tKarty:= TKAPBtrTable.Create;
 +
  tZasoby:= TKAPBtrTable.Create;
 +
  XMLDoc :=CreateOLEObject('Msxml2.DOMDocument');
 +
  try
 +
    XMLDoc.async:= False;
 +
    XMLDoc.resolveExternals:= False;
 +
{  XMLDoc.preserveWhiteSpace := true;}
 +
    PI := XMLDoc.createProcessingInstruction('xml','version="1.0" encoding="UTF-8"');
 +
    XMLDoc.appendChild(PI);
 +
    Root := XMLDoc.createElement('ROWDATA');
 +
    Root.setAttribute('department', Settings.Values['INI.StredNazev']);
 +
    Root.setAttribute('departmentid', Sklad);
 +
    Root.setAttribute('vendorid', Settings.Values['INI.FirmaICO']);
 +
    Root.setAttribute('info', 'Export karet');
 +
    Root.setAttribute('version', '1.0');
 +
    XMLDoc.appendChild(Root);
 +
 +
    IndPrice := TKAPIndPrice.Create;
 +
    try
 +
    tKarty.TableName := 'SkladKar.btr';
 +
    tKarty.IndexFieldNames := 'Kod';
 +
    tKarty.ReadOnly := True;
 +
    tKarty.Open;
 +
 +
    tZasoby.TableName := 'SkladZas.btr';
 +
    tZasoby.IndexFieldNames := 'Sklad;Kod';
 +
    tZasoby.ReadOnly := True;
 +
    tZasoby.Open;
 +
 +
    FldKarKod := tKarty.FieldByName('Kod');
 +
    FldKarCena := tKarty.FieldByName('Cena');
 +
    FldKarTypKarty:= tKarty.FieldByName('TypKarty');
 +
    FldKarZobrazit:= tKarty.FieldByName('Zobrazit');
 +
    FldKarNazev := tKarty.FieldByName('Nazev');
 +
    FldKarExtNazev := tKarty.FieldByName('ExtNazev');
 +
    FldKarHmotnost:= tKarty.FieldByName('Hmotnost');
 +
    FldZasCena3 := tZasoby.FieldByName('CenaB');
 +
    FldZasZasoba := tZasoby.FieldByName('Zasoba');
  
 +
    Datum := Date;
 +
    tKarty.First;
 +
    while not tKarty.EOF do begin
 +
      if (FldKarTypKarty.AsInteger <> 0) and (FldKarZobrazit.AsInteger <> 2) then begin
 +
        Item := XMLDoc.createElement('Item');
 +
        Root.appendChild(Item);
 +
        Kod := FldKarKod.AsString;
 +
        WriteTag('Kod', Kod);
 +
        WriteTag('Nazev', FldKarNazev.AsString+FldKarExtNazev.AsString);
 +
        if tZasoby.FindKey([Sklad, Kod]) then begin
 +
          WriteTag('Zasoba', FormatFloat('0.0##', FldZasZasoba.AsFloat));
 +
          WriteTag('Cena3', FormatFloat('0.00###', FldZasCena3.AsFloat));
 +
        end else begin
 +
          WriteTag('Zasoba', '0');
 +
          WriteTag('Cena3', '0');
 +
        end;
 +
        WriteTag('Hmotnost', FormatFloat('0.0##', FldKarHmotnost.AsFloat));
 +
        Cena := FldKarCena.AsFloat;
 +
        if IndPrice.IndividualniCena('IND*', 'IND*', Kod, 0, 0, Datum, 1, Cena, CenaSDPH) then begin
 +
          WriteTag('CenaAkce', FormatFloat('0.00###', Cena));
 +
        end;
 +
      end;
 +
      tKarty.Next;
 +
    end;
 +
    XMLDoc.save('ExportKaret.XML');
 +
    finally
 +
    IndPrice.Free;
 +
    end;
 +
  finally
 +
    XMLDoc := nil;
 +
    tZasoby.Free;
 +
    tKarty.Free;
 +
  end;
 +
end.
 
----
 
----
−
====Příklad 13 - Práce s požadavky (objednávkami zákazníků) za pomocí TKAPOrder====
+
 
 +
====Příklad 14 - Práce s požadavky (objednávkami zákazníků) za pomocí TKAPOrder====
 
  var
 
  var
 
   Order: TKAPOrder;
 
   Order: TKAPOrder;
Řádek 429: Řádek 525:
 
   finally
 
   finally
 
     Order.Free;
 
     Order.Free;
 +
  end;
 +
end.
 +
----
 +
 +
====Příklad 15 - SQL dotaz zobrazený v kontingenční tabulce====
 +
var
 +
  q: TKAPPvQuery;
 +
  f: TForm;
 +
  PanelGrid, PanelNahore: TPanel;
 +
  fcSlice: TfcxSlice;
 +
  fcGrid : TfcxSliceGrid;
 +
  fcToolBar: TfcxSliceGridToolbar;
 +
  Timer: TTimer;
 +
 +
  procedure OnTimer(Sender: TObject);
 +
  begin
 +
    Timer.Enabled := false;
 +
    f.Close;
 +
  end;
 +
 +
  procedure OnFormShow(Sender: TObject);
 +
  begin
 +
    fcSlice.LoadFromFile('MIS_1_30.MDS');  // MDS soubor můžete vytvořit v MISu, jen je třeba dodržet jména polí v SQL dotazu
 +
    fcGrid.CaptionZone.Visible:= false;    // skryje oblast nadpisu kontingenční tabulky
 +
    fcGrid.ExportToFile('MojeTabulka.XLS', fexExcelBIFF); // export může být proveden až je okno viditelné
 +
//  Timer.Enabled := true;  // zavolá událost pro zavření okna (f.Close nelze volat přímo z OnShow)
 +
  end;
 +
 +
begin
 +
  f := TForm.Create(Application);
 +
  try
 +
    Timer := TTimer.Create(f);    // Objekt Timer je potřeba jen v případě,
 +
    Timer.Enabled := false;      // že je třeba tabulku pouze exportovat
 +
    Timer.Interval := 1;          // a poté hned ukončit skript.
 +
    Timer.OnTimer := 'OnTimer';  // Kontingenční tabulky lze exportovat,
 +
                                  // pouze když existuje okno, ve kterém je tabulka zobrazena
 +
    f.Caption := 'Test PvQuery';
 +
    f.Position := poDefault;
 +
    PanelNahore:= TPanel.Create(f); // panel, ve kterém je umístěn toolbar s nástroji
 +
    PanelNahore.Parent:= f;
 +
    PanelNahore.Align:= alTop;
 +
    PanelNahore.Height := 30;
 +
    PanelGrid:= TPanel.Create(f);  // panel, na kterém je umístěna kontingenční tabulka
 +
    PanelGrid.Parent:= f;
 +
    PanelGrid.Align:= alClient;
 +
    q := TKAPPvQuery.Create(f);    // SQL dotaz do databáze PSQL
 +
    q.DatabaseName := 'MIS';
 +
    q.SQL.Text := 'SELECT * FROM DATAMIS';
 +
    q.Open;
 +
    fcSlice := CreatefcxCubeSlice(f, q);  // vytvoří sadu objektů potřebných pro práci kontingenční tabulkou
 +
    fcGrid := TfcxSliceGrid.Create(f);    // vytvoří vizuální prvek pro práci s kontingenční tabulkou
 +
    fcGrid.Slice:= fcSlice;
 +
    fcGrid.Parent := PanelGrid;
 +
    fcGrid.Align:= alClient;
 +
    fcGrid.AddAllExportFilters;          // povolí všechny varianty exportů kontingenční tabulky
 +
    fcToolBar:= TfcxSliceGridToolbar.Create(f);  // vytvoří toolbar s nástroji pro práci s kontingenční tabulkou
 +
    fcToolBar.SliceGrid := fcGrid;
 +
    fcToolBar.Parent := PanelNahore;
 +
    f.OnShow := 'OnFormShow';
 +
    f.ShowModal;  // zobrazí okno v modálním režimu a ihned poté se automaticky zavolá událost OnFormShow
 +
  finally
 +
    f.Free;        // uvolní objekt okna a všech na něm umístěných prvků
 +
  end;
 +
end.
 +
 +
====Příklad 16 - Vytvoření sloupcového grafu====
 +
var
 +
  f: TForm;
 +
  Chart: TChart; // viz.  * http://www.teechart.net/docs/teechart/vclfmx/lib/html/TChart.html - dokumentace k TChart
 +
  BarSeries: TBarSeries;
 +
begin
 +
  f:= tForm.Create(nil);
 +
  try
 +
    f.Caption := 'Test graf';
 +
    f.Position := poDefault;
 +
    Chart := TChart.Create(f);
 +
    Chart.Parent := f;
 +
    Chart.Align := alClient;
 +
    BarSeries := TBarSeries.Create(f);
 +
    BarSeries.Add(16, 'první', clRed);
 +
    BarSeries.Add(20, 'druhá', clGreen);
 +
    BarSeries.Add(12, 'třetí', clYellow);
 +
    BarSeries.ParentChart := Chart;
 +
    f.ShowModal;
 +
  finally
 +
    f.Free
 
   end;
 
   end;
 
  end.
 
  end.

Aktuální verze z 12. 9. 2015, 10:24

Příklady programů ve skriptovacím programovacím jazyku v jazyku Pascal.

Příklad 1 - práce s proměnnými uloženými do databáze

var i: integer;
    s: String;
begin
 s:=IniReadString('ScriptTest', 1, True, _AktualniSklad_, '5');
 ShowMessage(Settings.Values['INI.FirmaJmeno']+chr(13)+Settings.Values['USER.JmenoUziv']+chr(13)+_KonfigDir_);
 LogWrite('Direktivy:'+_Direktivy_);
 if s <> '' then
   i := StrToInt(s)+1
 else
   i := -10;
 if not IniWriteInteger('ScriptTest', 1, True, _AktualniSklad_, i) then
   ShowMessage('V IniWriteInteger se vyskytla chyba');
end.

Příklad 2 - spuštění sestavy z generátoru sestav

var 
 s: String; 
 d1, d2: TDateTime; 
 DD, MM, YY : word; 
begin 
 DecodeDate(Date, YY, MM, DD); 
 if MM=1 then begin // Zjisteni predchoziho mesice 
   MM := 12; 
   YY := YY - 1; 
 end else 
   MM := MM - 1; 
 D1 := EncodeDate(YY, MM, 1); 
 D2 := EncodeDate(YY, MM, DaysInMonth(YY, MM)); 
 S := GSRunReport(6, 1, 'KFG_Datum1='+StrDate(D1)+chr(13)+ 'KFG_Datum='+StrDate(D2)+chr(13)+ 'INI_Jmeno=Pokusný sklad');
 //S := GSRunReportV(6, 1, ['KFG_Datum1', 'KFG_Datum', 'INI_Jmeno'],[StrDate(D1), StrDate(D2), 'Pokusný sklad']);
 
 if EnumStr(S, 0, #13)='OK' then
   ShowMessage('Výpočet OK, výsledek sestavy je v '+EnumStr(S, 1, #13))
 else
   ShowMessage(S)
end.

Příklad 3 - odeslání mailu s přílohou pomocí SMTP

var 
 s: String; 
begin 
//From, SendTo, FileAttach, Subject, SMTPServer, SMTPSenderName, SMTPPassword, BodyString, ErrMessage 
  if SendMailBySMTP('odesilatel@posta.cz', 'prijemce@mail.com', 'UZIV\SESTAVA1.SLK'#9'UZIV\SESTAVA2.SES'#13'UZIV\vystup.pdf', 'Test scriptu', 'smtp.posta.cz', 'SMTPjmeno', 'SMTPheslo', 'Testovaci email.'#13'Konec', s) then
    ShowMessage('OK '+ s)
  else
    ShowMessage('CHYBA '+ s); 
end.

Příklad 4 - odeslání souboru pomocí MaximObjServeru

var MOSCommunicator: TMOSCommunicator; 
begin 
 MOSCommunicator := TMOSCommunicator.Create('MOS.bin', '', '', '', 0); 
 if MOSCommunicator.SendFile('C:\DIR\DATA1.xml', 'DATA1.XML', '', '', '', True) then
   LogWrite('Prenos OK')
 else
   LogWrite(MOSCommunicator.ErrMessage); 
 MOSCommunicator.Free; 
end.

Příklad 5 - použití funkcí objektu TMOSCommunicator pro komunikaci s MaximObjServerem

var MOSCommunicator: TMOSCommunicator; 
    Info: String; 
    Velikost: Extended; 
    Cas: TDateTime; 
begin 
 MOSCommunicator := TMOSCommunicator.Create('', '192.168.17.1', 'MOSuser', 'MOSpswd', 1); 
 try 
   if MOSCommunicator.Connect then begin  // pokud se připojím, pak se vše realizuje 
                                          // v rámci jednoho připojení 
                                          //    ShowMessage('Pripojeno'); 
     if MOSCommunicator.Connected then begin // test navic 
       if MOSCommunicator.SendSMS('111222333','Pokus o poslani SMS') then
         ShowMessage('SMS odeslana.') 
       else
         ShowMessage('Chyba pri odesilani SMS:'#13+MOSCommunicator.ErrMessage); 
       if MOSCommunicator.SendFile('C:\DIR\DATA1.xml', 'DATA1.XML', '', '', '', False) then 
       begin 
         ShowMessage('Prenos OK'); 
         if MOSCommunicator.GetFileInfo('Sklad6DOC', 'Stavy.xml', Info, Velikost, Cas) then begin 
           ShowMessage('GetFileInfo:'#13 + Info+ #13 + FloatToStr(Velikost) + #13 + DateTimeToStr(Cas)); 
           if not MOSCommunicator.GetFile('C:\DIR\Stavy2.XML', 'Podslozka\Stavy.xml', 'Sklad6DOC') then
             ShowMessage('GetFile:'#13+MOSCommunicator.ErrMessage); 
         end else 
           ShowMessage('GetFileInfo:'#13+MOSCommunicator.ErrMessage); 
       end else 
         ShowMessage('SendFile'#13+MOSCommunicator.ErrMessage); 
       MOSCommunicator.Disconnect; 
     end else 
       ShowMessage(MOSCommunicator.ErrMessage); 
   end else 
     ShowMessage(MOSCommunicator.ErrMessage); 
 finally 
   MOSCommunicator.Free; 
 end; 
end.

Příklad 6 - práce s TKAPBtrTable ve formuláři

var
  t: TKAPBtrTable;
  f: TForm;
  DBGrid: TDBGrid;
  ds: TDataSource;
begin
 ds := nil;
 t := TKAPBtrTable.Create;
 try  // try-finally část není nutná, ale správně se takto řeší problémové situace
   t.TableName := 'CISELNIK.btr';  // jméno tabulky bez cesty
   t.IndexFieldNames := 'TypCis;Klic1';                // index s těmito poli musí v tabulce existovat
   if MsgDlg('Přejete si použít filtr ?', 'Testovací skript', mtConfirmation, 
        msgboxOK + msgboxCancel, 'mbOK=Použít filtr') = mrOK then begin
     t.Filter := '(TypCis=161)AND(PosUp("T",Klic1)=1)';
     t.Filtered := true;
   end;
   t.Open;
   f := TForm.Create(Application);
   try
     f.Caption := 'Zobrazení ' + t.TableName;
     f.Position := poDefault;
     DBGrid:= TDBGrid.Create(f);   // parametr určuje vlastníka prvku DBGrid
     DBGrid.Parent := f;           // Parent určuje, na kterém formuláři se má DBGrid zobrazit
     DBGrid.Align := alClient;     // alClient znamená vyplnit celý formulář
     ds:= TDataSource.Create(f); // TDataSource propojuje tabulku s vizuálními prvky pro editaci (DBGrid)
     DBGrid.DataSource := ds;
     ds.DataSet := t;
     f.ShowModal;                // hlavní okno je třeba vždy otevírat pomocí ShowModal
   finally
     F.Free;                     // objekty, kterým byl určen vlastník (DBGrid) se ruší automaticky
   end;                          // při rušení vlastníka (při F.Free se ruší DBGrid i ds)
 finally
   t.Free;                       // vytvořené objekty je třeba zrušit
 end;
end.

Příklad 7 - použití paměťové tabulky TKAPMemTable

var t: TKAPMemTable;
   f:TForm;
   DBGr: TDBGrid;
   ds: TDataSource;
   MinA, x: Integer;
begin
 t := TKAPMemTable.Create;
 try
   t.FieldDefs.Add('A',ftInteger,0, false);
   t.FieldDefs.Add('B',ftString,30, false);
   t.FieldDefs.Add('C',ftfloat,0, false);
   t.FieldDefs.Add('D',ftDate,0, false);
   t.FieldDefs.Add('E',ftTime,0, false);
   t.CreateTable(nil);
//    t.IndexFieldNames := 'A;B';
   t.AddIndex('i1', 'A;B',[ixCaseInsensitive]); // nesmi byt prazdna mnozina
   t.IndexName := 'i1';
   t.Open;
   t.Append;
   t.FieldByName('A').AsInteger := 5555;
   t.FieldByName('B').AsString := 'TEST';
   t.FieldByName('C').AsFloat := 10.5;
   t.Post;
   t.Append;
   t.FieldByName('A').AsInteger := 4444;
   t.FieldByName('D').AsDateTime := Date+1;
   t.Post;
   t.Append;
   t.FieldByName('A').AsInteger := 3333;
   t.Post;
   t.Append;
   t.FieldByName('A').AsInteger := 8888;
   t.Post;
   t.First;
   MinA := t.FieldByName('A').AsInteger;
   while not t.EOF do begin
     if t.FieldByName('A').AsInteger < MinA then MinA := t.FieldByName('A').AsInteger;
     t.Next;
   end;
   ShowMessage('Min: '+IntToStr(MinA));
   f := TForm.Create(Application);
   try
     f.Caption := 'Zobrazení MemTable';
     f.Width := 1024;
     f.Height := 768;
     DBGr:= TDBGrid.Create(f);
     DBGr.Parent := f;
     DBGr.Align := alClient;
     ds:= TDataSource.Create(f);
     DBGr.DataSource :=ds;
     ds.DataSet := t;
     f.ShowModal;
   finally
     f.free;
   end
//    x := t.RecordCount;
 finally
   t.Free;
 end
end.

Příklad 8 - použití externího datového zdroje pomocí TKAPADOTable

var
 t: TKAPADOTable;
 f:TForm;
 DBGr: TDBGrid;
 ds: TDataSource;
 spl1: TSplitter;
 lb: TListBox;
 i : integer;
//  Fld : TField;
begin
  f := nil;
  DBGr := nil;
  ds := nil;
  t := TKAPADOTable.Create;
  t.ConnectionString:= 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Slozka\TestData.xls;Extended Properties=Excel 8.0';
  try
    try
      t.TableName := 'Tabulka'; // data v tabulce MS Excel označte pomocí funkce Definovat název
      t.Open;
      f := TForm.Create(nil);
      f.Caption := 'Zobrazení dat z Excelu';
      f.Width := 1024;
      f.Height := 768;
      DBGr:= TDBGrid.Create(f);
      DBGr.Parent := f;
      DBGr.Align := alLeft;
      DBGr.Width := 800;
      DBGr.ReadOnly := true;
      spl1 := TSplitter.Create(f);
      spl1.Parent := f;
      spl1.Align := alLeft;
      spl1.Width := 4;
      spl1.Left := 802;
      lb := TListBox.Create(f);
      lb.Parent := f;
      lb.Left := 1000;
      lb.Top := 300;
      lb.Align := alClient;
      ds:= TDataSource.Create(f);
      DBGr.DataSource := ds;
      ds.DataSet := t;
      DBGr.Options := dgAlwaysShowSelection + dgCancelOnExit + dgColLines + dgColumnResize + dgConfirmDelete + dgIndicator + dgRowLines + dgRowSelect + dgTitles;
      for i := 0 to DBGr.Columns.Count - 1 do begin  // sloupce gridu se připraví po spojení gridu s otevřeným datasetem
        lb.Items.Add(DBGr.Columns[i].FieldName);
        DBGr.Columns[i].Width := 80;
      end;
//      for i := 0 to t.FieldCount - 1 do begin  // jiný způsob jak projít pole tabulky (nezávislý na gridu)
//        lb.Items.Add(t.Fields[i].FieldName);   // takto to nefunguje
//        Fld := t.Fields[i];                    // Field je nutné nejdříve přiřadit do proměnné typu TField
//        lb.Items.Add(Fld.FieldName);
//        Fld.DisplayWidth := 12;
//      end;
      f.ShowModal;
    except
      ShowMessage(ExceptionMessage);
    end;
  Finally
    t.Free;
    if ds <> nil then
      ds.Free;
    if F <> nil then
      F.Free;
  end;
end.

Příklad 9 - Spuštění funkce z hlavního menu aplikace

procedure DoOnWaitKey(WaitForKeyInfo: TKAPAppControlWaitForKeyInfo);
begin
  if PosUp('OBDOB', App.ActiveWindowCaption) > 0 then begin
    App.PressFnKeys('F2');
  end;
end;
// hlavní část
begin
  App.OnWaitForKey := @DoOnWaitKey;
//App.RunMenu(KodMenu1, KodMenu2, PristPravo: byte; Keys: string);
//Kód menu lze zjistit v rámci Systémové menu/Menu
  App.RunMenu(1, 15, 9, '"181212" Tab "201212"');
// v rámci spuštění položky menu s kódem KodMenu1 a KodMenu2 lze klávesy "namačkat" dopředu;
// pokud program vyčerpá klávesy ze zásobníku a obslužná procedura nestiskne další klávesu, pak program funkci automaticky ukončuje pomocí ESC
end.

Příklad 10 - Spuštění funkce z hlavního menu s obslužnou procedurou menu

procedure DoOnMenu(MenuInfo: TKAPAppControlMenuInfo);
begin
  if MenuInfo <> nil then                                           
    if Trim(App.ActiveWindowCaption) = 'Kontrola' then begin
      if MenuInfo.MenuItemsCount > 1 then
        MenuInfo.SelectedMenuItem := 2;
    end else
      if PosUp('Kontrola datumu spotřeby', App.ActiveWindowCaption) >= 1 then begin
        MenuInfo.SelectedMenuItem := 3;
        App.PressKeys('"50" F2');
      end;
end;
// hlavní část
begin
  App.OnMenu := @DoOnMenu;
  App.RunMenu(3, 4, 9, '');
end.

Příklad 11 - Použití objektu TKAPIndPrice

var
 IC: TKAPIndPrice;
 Cena, CenaSDPH: Double;
 UrovenDPH: byte;
 KodKarty : string;
begin
  IC := TKAPIndPrice.Create;
  try
    KodKarty := '1020199';
    Cena := IC.KartaCena(KodKarty, 1, false); // první cenové pásmo z karty - cena bez DPH
    UrovenDPH := IC.KartaUrovenDPH(KodKarty); // pořadové číslo sazby DPH 0, 1, 2...
           // použije se individuální cena MOJEIC nebo aternativní individuální cena IND*
           // Cena musí být naplněna již před voláním IC.IndividualniCena
    if IC.IndividualniCena('MOJEIC', 'IND*', KodKarty, 1, 0, Date, 1, Cena, CenaSDPH) then
      ShowMessage('Výsledná cena: '+FormatFloat('#.00', Cena)+'   cena s DPH: '+FormatFloat('#.00', CenaSDPH))
    else begin
      CenaSDPH := IC.CenaSDPH(Cena, UrovenDPH);
      ShowMessage('Individuální cena nebyla pro dané zboží vyhodnocena'#13+
                  'Základní cena: '+FormatFloat('#.00', Cena)+'   cena s DPH: '+FormatFloat('#.00', CenaSDPH));
    end;
  finally
    IC.Free;
  end;
end.

Příklad 12 - Čtení dat z XML za pomocí Msxml2.DOMDocument

var
 XMLDoc: Variant;
 ZaznamList, FieldNode : Variant;
 InfoStr: string;
 I, Cnt: integer;
begin
//  XMLDoc:=CreateOLEObject('Msxml2.DOMDocument.6.0');   -- potřebuje novější verzi MSXML; umožňuje ale např. práci s XSD šablonami
 XMLDoc :=CreateOLEObject('Msxml2.DOMDocument');
 try
   XMLDoc.async:= False;
   XMLDoc.resolveExternals:= False;
   XMLDoc.Load('Respons.XML');
// XMLDoc.LoadXML(textXML)  -- umožňuje načíst XML ve formě textu
{
<?xml version="1.0" encoding="UTF-8"?>
<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/">
 <soapenv:Body>
  <StatusNespolehlivyPlatceResponse xmlns="http://adis.mfcr.cz/rozhraniCRPDPH/">
   <status odpovedGenerovana="2013-03-31" statusCode="0" statusText="OK"/>
   <statusPlatceDPH dic="CZ6301050074" nespolehlivyPlatce="NENALEZEN"/>
   <statusPlatceDPH dic="CZ27495132" nespolehlivyPlatce="NENALEZEN"/>
  </StatusNespolehlivyPlatceResponse>
 </soapenv:Body>
</soapenv:Envelope>
}
   if XMLDoc.parseError.errorCode = 0 then begin
     ZaznamList:= XMLDoc.getElementsByTagName('soapenv:Body');
     if ZaznamList.Length > 0 then begin
       ZaznamList:= ZaznamList.item(0).childNodes;   // zanoří se do dané větve XML
       if ZaznamList.Length > 0 then begin
         FieldNode := ZaznamList.item(0);
         if FieldNode.NodeName = 'StatusNespolehlivyPlatceResponse' then begin
           ZaznamList:= FieldNode.childNodes;
           Cnt := 0;
           InfoStr := ' ';
           for I := 0 to ZaznamList.Length - 1 do begin
             FieldNode := ZaznamList.item(I);
             if FieldNode.NodeName = 'statusPlatceDPH' then
               inc(Cnt)
             else
               if FieldNode.NodeName = 'status' then
                 InfoStr := Format('Ze dne %s', [FieldNode.getAttribute('odpovedGenerovana')])
           end;
           ShowMessage(Format('Počet záznamů "statusPlatceDPH": %d'#13'%s', [Cnt, InfoStr]));
         end;
       end;
     end;
   end else
     ShowMessage(Format('Chyba při čtení XML: %d %s', [XMLDoc.parseError.errorCode, xmlDoc.parseError.reason]));
 finally
   XMLDoc := nil;
 end;
end.

Příklad 13 - Zápis do XML souboru za pomocí Msxml2.DOMDocument

var
  sklad, Kod: String;
  tKarty: TKAPBtrTable;
  tZasoby: TKAPBtrTable;
  FldKarKod, FldKarCena, FldKarTypKarty, FldKarNazev, FldKarExtNazev, FldKarZobrazit, FldKarHmotnost, FldZasCena3, FldZasZasoba: TField;
  IndPrice: TKAPIndPrice;
  XMLDoc, Root, Item, PI: Variant;
  Cena, CenaSDPH: Double;
  Datum: TDateTime;

 procedure WriteTag(TagName, TagValue: string);
  var Node: Variant;
 begin
   Node := XMLDoc.createElement(TagName);
   Node.text := TagValue;
   Item.appendChild(Node);
 end;

begin
  Sklad := Trim(Settings.Values['INI.StredKod']);
  tKarty:= TKAPBtrTable.Create;
  tZasoby:= TKAPBtrTable.Create;
  XMLDoc :=CreateOLEObject('Msxml2.DOMDocument');
  try
   XMLDoc.async:= False;
   XMLDoc.resolveExternals:= False;
{   XMLDoc.preserveWhiteSpace := true;}
   PI := XMLDoc.createProcessingInstruction('xml','version="1.0" encoding="UTF-8"');
   XMLDoc.appendChild(PI);
   Root := XMLDoc.createElement('ROWDATA');
   Root.setAttribute('department', Settings.Values['INI.StredNazev']);
   Root.setAttribute('departmentid', Sklad);
   Root.setAttribute('vendorid', Settings.Values['INI.FirmaICO']);
   Root.setAttribute('info', 'Export karet');
   Root.setAttribute('version', '1.0');
   XMLDoc.appendChild(Root);

   IndPrice := TKAPIndPrice.Create;
   try
    tKarty.TableName := 'SkladKar.btr';
    tKarty.IndexFieldNames := 'Kod';
    tKarty.ReadOnly := True;
    tKarty.Open;

    tZasoby.TableName := 'SkladZas.btr';
    tZasoby.IndexFieldNames := 'Sklad;Kod';
    tZasoby.ReadOnly := True;
    tZasoby.Open;

    FldKarKod := tKarty.FieldByName('Kod');
    FldKarCena := tKarty.FieldByName('Cena');
    FldKarTypKarty:= tKarty.FieldByName('TypKarty');
    FldKarZobrazit:= tKarty.FieldByName('Zobrazit');
    FldKarNazev := tKarty.FieldByName('Nazev');
    FldKarExtNazev := tKarty.FieldByName('ExtNazev');
    FldKarHmotnost:= tKarty.FieldByName('Hmotnost');
    FldZasCena3 := tZasoby.FieldByName('CenaB');
    FldZasZasoba := tZasoby.FieldByName('Zasoba');

    Datum := Date;
    tKarty.First;
    while not tKarty.EOF do begin
      if (FldKarTypKarty.AsInteger <> 0) and (FldKarZobrazit.AsInteger <> 2) then begin
        Item := XMLDoc.createElement('Item');
        Root.appendChild(Item);
        Kod := FldKarKod.AsString;
        WriteTag('Kod', Kod);
        WriteTag('Nazev', FldKarNazev.AsString+FldKarExtNazev.AsString);
        if tZasoby.FindKey([Sklad, Kod]) then begin
          WriteTag('Zasoba', FormatFloat('0.0##', FldZasZasoba.AsFloat));
          WriteTag('Cena3', FormatFloat('0.00###', FldZasCena3.AsFloat));
        end else begin
          WriteTag('Zasoba', '0');
          WriteTag('Cena3', '0');
        end;
        WriteTag('Hmotnost', FormatFloat('0.0##', FldKarHmotnost.AsFloat));
        Cena := FldKarCena.AsFloat;
        if IndPrice.IndividualniCena('IND*', 'IND*', Kod, 0, 0, Datum, 1, Cena, CenaSDPH) then begin
          WriteTag('CenaAkce', FormatFloat('0.00###', Cena));
        end;
      end;
      tKarty.Next;
    end;
    XMLDoc.save('ExportKaret.XML');
   finally
    IndPrice.Free;
   end;
  finally
    XMLDoc := nil;
    tZasoby.Free;
    tKarty.Free;
  end;
end.

Příklad 14 - Práce s požadavky (objednávkami zákazníků) za pomocí TKAPOrder

var
 Order: TKAPOrder;
 OrderItem: TKAPOrderItem;
 OK: Boolean;
begin
 Order := TKAPOrder.Create(true);
 try
   if Order.SetCustomer('12675962') then begin     {odběratel musí být v adresáři odběratelů}
     Order.Pozadovano := Date+2;
     Order.Radek1:= 'Testovací objednávka';
     Order.Uhrada:= 1; {hotově}
     Order.MemoA.Add('Poznámka nahoře');
     Order.MemoB.Add('Poznámka dole');
     OK := Order.AddOrderItem('20092', 12, 0, true, 0, 'test'); {zboží s kódem 20092 musí existovat v seznamu karet}
     if OK then
       OK := Order.AddOrderItem('54005', 24, 0, true, 0, ' ');
     if OK then begin
       OrderItem := Order.Items[0];   {zpřístupní první položku objednávky}
       OrderItem.Quantity := 6;       {a u této položky změní počet MJ na 6}
       Order.DeleteItem(1);           {odstraní druhou položku objednávky - 54005}
       OK := Order.AddOrderItem('50056', 1, 0, true, 0, 'VL');
     end;
     if OK then
       OK := Order.SaveOrder;
     if OK then
       if length(Order.LastError) = 0 then
         ShowMessage(Format('Nová objednávka uložena pod číslem %d', [Order.CisloObjednavky]))
       else
         ShowMessage(Order.LastError)
     else
       ShowMessage(Order.LastError)
   end else
     ShowMessage('Chyba při zpracování objednávky'#13+Order.LastError);
 finally
   Order.Free;
 end;
end.

Příklad 15 - SQL dotaz zobrazený v kontingenční tabulce

var
  q: TKAPPvQuery;
  f: TForm;
  PanelGrid, PanelNahore: TPanel;
  fcSlice: TfcxSlice;
  fcGrid : TfcxSliceGrid;
  fcToolBar: TfcxSliceGridToolbar;
  Timer: TTimer;

 procedure OnTimer(Sender: TObject);
 begin
   Timer.Enabled := false;
   f.Close;
 end;

 procedure OnFormShow(Sender: TObject);
 begin
   fcSlice.LoadFromFile('MIS_1_30.MDS');  // MDS soubor můžete vytvořit v MISu, jen je třeba dodržet jména polí v SQL dotazu
   fcGrid.CaptionZone.Visible:= false;    // skryje oblast nadpisu kontingenční tabulky
   fcGrid.ExportToFile('MojeTabulka.XLS', fexExcelBIFF); // export může být proveden až je okno viditelné
//   Timer.Enabled := true;  // zavolá událost pro zavření okna (f.Close nelze volat přímo z OnShow)
 end;

begin
  f := TForm.Create(Application);
  try
    Timer := TTimer.Create(f);    // Objekt Timer je potřeba jen v případě,
    Timer.Enabled := false;       // že je třeba tabulku pouze exportovat
    Timer.Interval := 1;          // a poté hned ukončit skript.
    Timer.OnTimer := 'OnTimer';   // Kontingenční tabulky lze exportovat,
                                  // pouze když existuje okno, ve kterém je tabulka zobrazena
    f.Caption := 'Test PvQuery';
    f.Position := poDefault;
    PanelNahore:= TPanel.Create(f); // panel, ve kterém je umístěn toolbar s nástroji
    PanelNahore.Parent:= f;
    PanelNahore.Align:= alTop;
    PanelNahore.Height := 30;
    PanelGrid:= TPanel.Create(f);   // panel, na kterém je umístěna kontingenční tabulka
    PanelGrid.Parent:= f;
    PanelGrid.Align:= alClient;
    q := TKAPPvQuery.Create(f);     // SQL dotaz do databáze PSQL
    q.DatabaseName := 'MIS';
    q.SQL.Text := 'SELECT * FROM DATAMIS';
    q.Open;
    fcSlice := CreatefcxCubeSlice(f, q);  // vytvoří sadu objektů potřebných pro práci kontingenční tabulkou
    fcGrid := TfcxSliceGrid.Create(f);    // vytvoří vizuální prvek pro práci s kontingenční tabulkou
    fcGrid.Slice:= fcSlice;
    fcGrid.Parent := PanelGrid;
    fcGrid.Align:= alClient;
    fcGrid.AddAllExportFilters;           // povolí všechny varianty exportů kontingenční tabulky
    fcToolBar:= TfcxSliceGridToolbar.Create(f);  // vytvoří toolbar s nástroji pro práci s kontingenční tabulkou
    fcToolBar.SliceGrid := fcGrid;
    fcToolBar.Parent := PanelNahore;
    f.OnShow := 'OnFormShow';
    f.ShowModal;   // zobrazí okno v modálním režimu a ihned poté se automaticky zavolá událost OnFormShow
  finally
    f.Free;        // uvolní objekt okna a všech na něm umístěných prvků
  end;
end.

Příklad 16 - Vytvoření sloupcového grafu

var
 f: TForm;
 Chart: TChart; // viz.  * http://www.teechart.net/docs/teechart/vclfmx/lib/html/TChart.html - dokumentace k TChart
 BarSeries: TBarSeries;
begin
 f:= tForm.Create(nil);
 try
   f.Caption := 'Test graf';
   f.Position := poDefault;
   Chart := TChart.Create(f);
   Chart.Parent := f;
   Chart.Align := alClient;
   BarSeries := TBarSeries.Create(f);
   BarSeries.Add(16, 'první', clRed);
   BarSeries.Add(20, 'druhá', clGreen);
   BarSeries.Add(12, 'třetí', clYellow);
   BarSeries.ParentChart := Chart;
   f.ShowModal;
 finally
   f.Free
 end;
end.
Citováno z „https://wiki.kapsw.cz/index.php?title=Příklady_PASCAL&oldid=15924“