Příklady PASCAL: Porovnání verzí
Z K.A.P.
Skočit na navigaciSkočit na vyhledávání(Není zobrazeno 31 mezilehlých verzí od stejného uživatele.) | |||
Řádek 1: | Řádek 1: | ||
+ | Příklady programů ve [[Skriptovací programovací jazyk|skriptovacím programovacím jazyku]] v jazyku Pascal. | ||
+ | |||
====Příklad 1 - práce s proměnnými uloženými do databáze==== | ====Příklad 1 - práce s proměnnými uloženými do databáze==== | ||
var i: integer; | var i: integer; | ||
Řádek 30: | Řádek 32: | ||
D2 := EncodeDate(YY, MM, DaysInMonth(YY, MM)); | 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 := 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']); | + | //S := GSRunReportV(6, 1, ['KFG_Datum1', 'KFG_Datum', 'INI_Jmeno'],[StrDate(D1), StrDate(D2), 'Pokusný sklad']); |
− | ShowMessage( | + | |
+ | 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. | end. | ||
---- | ---- | ||
+ | |||
====Příklad 3 - odeslání mailu s přílohou pomocí SMTP==== | ====Příklad 3 - odeslání mailu s přílohou pomocí SMTP==== | ||
var | var | ||
Řádek 98: | Řádek 105: | ||
---- | ---- | ||
====Příklad 6 - práce s TKAPBtrTable ve formuláři==== | ====Příklad 6 - práce s TKAPBtrTable ve formuláři==== | ||
+ | var | ||
t: TKAPBtrTable; | t: TKAPBtrTable; | ||
f: TForm; | f: TForm; | ||
Řádek 107: | Řádek 115: | ||
try // try-finally část není nutná, ale správně se takto řeší problémové situace | 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.TableName := 'CISELNIK.btr'; // jméno tabulky bez cesty | ||
− | t.IndexFieldNames := 'TypCis;Klic1'; | + | 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; | t.Open; | ||
f := TForm.Create(Application); | f := TForm.Create(Application); | ||
Řádek 129: | Řádek 142: | ||
---- | ---- | ||
+ | |||
====Příklad 7 - použití paměťové tabulky TKAPMemTable==== | ====Příklad 7 - použití paměťové tabulky TKAPMemTable==== | ||
var t: TKAPMemTable; | var t: TKAPMemTable; | ||
Řádek 191: | Řádek 205: | ||
end. | end. | ||
---- | ---- | ||
− | ====Příklad 8 - Spuštění funkce z hlavního menu aplikace==== | + | ====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); | procedure DoOnWaitKey(WaitForKeyInfo: TKAPAppControlWaitForKeyInfo); | ||
begin | begin | ||
Řádek 209: | Řádek 290: | ||
---- | ---- | ||
− | ====Příklad | + | ====Příklad 10 - Spuštění funkce z hlavního menu s obslužnou procedurou menu==== |
procedure DoOnMenu(MenuInfo: TKAPAppControlMenuInfo); | procedure DoOnMenu(MenuInfo: TKAPAppControlMenuInfo); | ||
begin | begin | ||
Řádek 225: | Řádek 306: | ||
begin | begin | ||
App.OnMenu := @DoOnMenu; | App.OnMenu := @DoOnMenu; | ||
− | App.RunMenu(3, 4, 9, ''''); | + | 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. | end. |
Aktuální verze z 12. 9. 2015, 10:24
Příklady programů ve skriptovacím programovacím jazyku v jazyku Pascal.
Obsah
- 1 Příklad 1 - práce s proměnnými uloženými do databáze
- 2 Příklad 2 - spuštění sestavy z generátoru sestav
- 3 Příklad 3 - odeslání mailu s přílohou pomocí SMTP
- 4 Příklad 4 - odeslání souboru pomocí MaximObjServeru
- 5 Příklad 5 - použití funkcí objektu TMOSCommunicator pro komunikaci s MaximObjServerem
- 6 Příklad 6 - práce s TKAPBtrTable ve formuláři
- 7 Příklad 7 - použití paměťové tabulky TKAPMemTable
- 8 Příklad 8 - použití externího datového zdroje pomocí TKAPADOTable
- 9 Příklad 9 - Spuštění funkce z hlavního menu aplikace
- 10 Příklad 10 - Spuštění funkce z hlavního menu s obslužnou procedurou menu
- 11 Příklad 11 - Použití objektu TKAPIndPrice
- 12 Příklad 12 - Čtení dat z XML za pomocí Msxml2.DOMDocument
- 13 Příklad 13 - Zápis do XML souboru za pomocí Msxml2.DOMDocument
- 14 Příklad 14 - Práce s požadavky (objednávkami zákazníků) za pomocí TKAPOrder
- 15 Příklad 15 - SQL dotaz zobrazený v kontingenční tabulce
- 16 Příklad 16 - Vytvoření sloupcového grafu
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.
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.
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.