unit fo_ShowData;
{ ******************************************************************************
fo_ShowData
Programm um folgende Dinge zu testen
* Daten per Thread auslesen und anzeigen
--------------------------------------------------------------------------------
Historie
23.01.17, V1.0.1, GPA, Delphi XE10
* Verwaltung der Daten in TList unter Verwendung von TMonitor.Enter/Exit
23.01.17, V1.0.0, GPA, Delphi XE10
* Verwaltung der Daten in TThreadList unter Verwendung von LockList/UnlockList
****************************************************************************** }
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants,
System.Classes,
Vcl.Graphics,
ActiveX,
Generics.Collections,
Generics.Defaults,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs, Data.DB, VclTee.TeeGDIPlus,
VclTee.Chart, VclTee.TeEngine, VclTee.Series,
Vcl.StdCtrls, VclTee.TeeProcs,
VclTee.DBChart,
Vcl.Grids,
Vcl.DBGrids, VirtualTrees,
Vcl.ExtCtrls,
Vcl.ComCtrls, Nav, MemDS, DBAccess, Uni, UniProvider, SQLServerUniProvider,
VclTee.TeeXML, VclTee.TeeSeriesTextEd, VclTee.TeeURL, VclTee.TeeExcelSource;
type
TForm2 =
class(TForm)
paTop: TPanel;
paData: TPanel;
StatusBar1: TStatusBar;
paManuell: TPanel;
vstData: TVirtualStringTree;
chForce: TChart;
Series3: TLineSeries;
Series4: TLineSeries;
UniConnection1: TUniConnection;
SQLServerUniProvider1: TSQLServerUniProvider;
UniQuery1: TUniQuery;
DataSource1: TDataSource;
DBNavigatorSpec1: TDBNavigatorSpec;
laReport: TLabel;
procedure FormCreate(Sender: TObject);
procedure DataSource1DataChange(Sender: TObject; Field: TField);
procedure vstDataGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType;
var CellText:
string);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure vstDataGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure vstDataInitNode(Sender: TBaseVirtualTree;
ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
private
{ Private-Deklarationen }
procedure CreateThrReadDb(iID: Integer);
public
{ Public-Deklarationen }
procedure SyncReady(bValue: Boolean);
end;
TThreadBoolean =
procedure(bValue: Boolean)
of Object;
PValues = ^TValues;
TValues =
class
dtTime: TDateTime;
rForce,
rFtarget,
rTemperatur,
rHumidity: Real;
End;
TListData =
class(TList<TValues>)
end;
TThrReadDb =
class(TThread)
protected
procedure Execute;
override;
private
_Ready: Boolean;
_ReadyEvent: TThreadBoolean;
dbcon: TUniConnection;
dbProvider: TSQLServerUniProvider;
dbQuery: TUniQuery;
procedure syncReadyEvent;
public
property ReadyEvent: TThreadBoolean
read _ReadyEvent
write _ReadyEvent;
end;
var
Form2: TForm2;
lstData: TListData;
thrReadDb: TThrReadDb;
bThrReadDbIsRunning: Boolean;
implementation
{$R *.dfm}
procedure TForm2.DataSource1DataChange(Sender: TObject; Field: TField);
// Bei jedem Blättervorgang in den Masterdaten Thread zum Auslesen der
// Detaildaten erzeugen
begin
laReport.Caption := format('
%s [%d]', [UniQuery1.FieldByName('
Nr').AsString,
UniQuery1.FieldByName('
ID').AsInteger]);
CreateThrReadDb(UniQuery1.FieldByName('
ID').AsInteger)
end;
procedure TForm2.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
lstData.Free;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
lstData := TListData.Create;
UniQuery1.Open;
end;
procedure TForm2.CreateThrReadDb(iID: Integer);
// Thread zum Auslesen der Daten aus DB erzeugen
begin
// Falls noch ein Thread zum Laden von Daten läuft diesen abbrechen
if (bThrReadDbIsRunning)
then
begin
// thrReadDb.dbQuery.BreakExec; // Führt zu Fehlermeldung "operation was canceled"
thrReadDb.Terminate;
bThrReadDbIsRunning := false
end;
lstData.Clear;
bThrReadDbIsRunning := TRUE;
thrReadDb := TThrReadDb.Create(TRUE);
thrReadDb.ReadyEvent := Form2.SyncReady;
{ Create suspended--secondProcess does not run yet. }
thrReadDb.FreeOnTerminate := TRUE;
{ You do not need to clean up after termination. }
thrReadDb.Priority := tpLower;
// Set the priority to lower than normal.
if not assigned(thrReadDb.dbQuery)
then
begin
thrReadDb.dbcon := TUniConnection.Create(
NIL);
thrReadDb.dbcon.ProviderName := TSQLServerUniProvider.Create(
NIL).
Name;
thrReadDb.dbcon.ConnectString :=
'
Provider Name=SQL Server;Data Source=PsServer;Initial Catalog=ADatabase;Port=0;User ID=sa;Password=THREAD';
thrReadDb.dbQuery := TUniQuery.Create(
NIL);
thrReadDb.dbQuery.Connection := thrReadDb.dbcon;
end;
if thrReadDb.dbQuery.Active
then
thrReadDb.dbQuery.Close;
thrReadDb.dbQuery.SQL.Text :=
format('
select * from Cal_force where CalReportID = %d order by ID', [iID]);
thrReadDb.Resume;
{ thread starten }
end;
procedure TForm2.SyncReady(bValue: Boolean);
// Daten der kompletten Liste VST und TChart zuweisen
var
i: Integer;
Values: TValues;
begin
vstData.NodeDataSize := SizeOf(TValues);
vstData.BeginUpdate;
vstData.Clear;
System.TMonitor.Enter(lstData);
try
vstData.RootNodeCount := lstData.Count;
finally
System.TMonitor.Exit(lstData);
end;
vstData.EndUpdate;
Series3.Clear;
Series4.Clear;
System.TMonitor.Enter(lstData);
try
Values := TValues.Create;
for i := 0
to lstData.Count - 1
do
begin
Values := lstData.Items[i];
Series3.AddXY(Values.dtTime, Values.rForce);
Series4.AddXY(Values.dtTime, Values.rFtarget);
end;
finally
System.TMonitor.Exit(lstData);
end;
end;
procedure TForm2.vstDataGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TValues);
end;
procedure TForm2.vstDataGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType;
var CellText:
string);
// Daten in Zellen schreiben
var
Data: PValues;
begin
Data := Sender.GetNodeData(Node);
case Column
of
0: CellText := FormatDateTime('
yyyy-mm-dd hh.mm.ss.zzz', Data^.dtTime);
1: CellText := format('
%7.2f', [Data^.rForce]);
2: CellText := format('
%7.2f', [Data^.rFtarget]);
end;
end;
procedure TForm2.vstDataInitNode(Sender: TBaseVirtualTree;
ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
// Den Knoten in VST die Daten von lstData zuweisen
var
Data: PValues;
begin
Data := Sender.GetNodeData(Node);
begin
System.TMonitor.Enter(lstData);
try
Data^ := lstData[Node^.
Index];
finally
System.TMonitor.Exit(lstData);
end;
end;
end;
{ ======================== TThrReadDB ======================================== }
procedure TThrReadDb.Execute;
// Zuerst Query öffnen und dann alle Daten in lstData ablegen
var
Values: TValues;
iT, iT1 : LargeInt;
begin
inherited;
bThrReadDbIsRunning := true;
CoInitialize(
nil);
try
thrReadDb.dbQuery.Open;
while not thrReadDb.Terminated
and not thrReadDb.dbQuery.eof
do
begin
Values := TValues.Create;
Values.dtTime := thrReadDb.dbQuery.FieldByName('
ErstDat').Value;
Values.rForce := thrReadDb.dbQuery.FieldByName('
Fact').Value;
Values.rFtarget := thrReadDb.dbQuery.FieldByName('
Ftarget').Value;
System.TMonitor.Enter(lstData);
// Liste gegen Zweitzugriff sperren
try
lstData.Add(Values);
finally
System.TMonitor.Exit(lstData);
// Sperrung der Liste wieder aufheben
end;
thrReadDb.dbQuery.Next;
end;
if not thrReadDb.Terminated
then
begin
_Ready := true;
Synchronize(syncReadyEvent);
end;
finally
CoUnInitialize;
bThrReadDbIsRunning := false;
end;
end;
procedure TThrReadDb.syncReadyEvent;
// Formular benachrichtigen, dass Daten komplett in lstData vorliegen
begin
if assigned(_ReadyEvent)
then
_ReadyEvent(_Ready);
end;
end.