unit DelphiForm;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.Grids;
type
TForm2 =
class(TForm)
ButtonQMCcalc: TButton;
Memo1: TMemo;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
Label1: TLabel;
Edit1: TEdit;
Memo2: TMemo;
ButtonTTCreate: TButton;
StringGrid1: TStringGrid;
procedure ButtonQMCcalcClick(Sender: TObject);
procedure ButtonTTCreateClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
procedure Split(Delimiter: Char; Str:
string; ListOfStrings: TStrings) ;
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
uses
DelphiAbstractClass;
var
CPPClass : TAbstractClass;
Editing: Boolean;
Const CheckBoxCols = [1,2];
// Spalte 2 ohne Einträge
procedure TForm2.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
CPPClass.Free;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
CPPClass := CreateCppDescendant;
Editing:=true;
end;
procedure TForm2.ButtonTTCreateClick(Sender: TObject);
var
TTTOutPutList: TStringList;
TTTOutPutListmNEG: TStringList;
QMC_TTT: Ansistring;
k: Integer;
begin
try
// if I make the CPPCLass locally then the prg crashes
// at the second click on Create-True-Table
// whithout the routine in CPPClass.cpp
// char* outputTerm(char* pcTTT, int bitfield, int mask, int num)
// it works fine.
// Workarount, make CPPCLass global and call Create of this Class
// at the beginning only once.
//CPPClass := CreateCppDescendant;
Memo2.Clear;
memo2.Lines.Add('
Input TrueTable:');
Stringgrid1.Cells[0,0]:='
Term';
Stringgrid1.Cells[1,0]:='
Checked=1 Unchecked=0';
TTTOutPutListmNeg := TStringList.Create;
TTTOutPutList := TStringList.Create;
CPPClass.MTCount:=strtoint(Edit1.text);
if checkbox1.checked
then CPPClass.Dummy := 1
else CPPClass.Dummy:=0;
CPPClass.DoTTable;
//DOES NOT WORK! Even not for dummy
QMC_TTT:=(CPPClass.TTT);
//QMC_TTT:=' ;xyz#'; //(CPPClass.TTT);
//Memo2.Lines.Add(Format('RUN-Nummer: %d',[i]));
Split('
#', QMC_TTT , TTTOutPutListmNEG) ;
for k := 0
to TTTOUtputlistmNEG.count-2
do
begin
Split('
;', TTTOUtputlistmNEG[k] , TTTOutPutList) ;
Memo2.Lines.Add(TTTOutPutList[0]);
Memo2.Lines.Add(TTTOutPutList[1]);
Stringgrid1.Cells[0,1+(k*2)]:=TTTOutPutList[0];
Stringgrid1.Cells[0,1+(k*2+1)]:=TTTOutPutList[1];
Stringgrid1.Cells[1,1+(k*2+1)]:='
true';
// Checkbox state in col 1
stringgrid1.RowCount:=1+(k*2+1);
end;
finally
//CPPClass.Free;
TTTOutPutList.Free;
TTTOutPutListmNeg.Free;
end;
end;
procedure Tform2.Split(Delimiter: Char; Str:
string; ListOfStrings: TStrings) ;
begin
ListOfStrings.Clear;
ListOfStrings.Delimiter := Delimiter;
ListOfStrings.StrictDelimiter := True;
// Requires D2006 or newer.
ListOfStrings.DelimitedText := Str;
end;
procedure TForm2.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
function CheckBox(Value:
String): Cardinal;
begin
result:= DFCS_INACTIVE;
// no Entry
if Value = '
true'
then // Checked
result:= DFCS_BUTTONCHECK
or DFCS_CHECKED
else if Value = '
false'
then // not Checked
result:= DFCS_BUTTONCHECK;
if not Editing
then
result:= result
or DFCS_MONO;
// no Editing
end;
begin
with TStringGrid(Sender)
do
if (ACol
in CheckBoxCols)
and not (gdFixed
in State)
then begin
Canvas.FillRect(Rect);
InflateRect(Rect, -4, -4);
DrawFrameControl(Canvas.Handle, Rect,DFC_Button,
CheckBox(Trim(Cells[ACol, ARow])));
end;
// if gdFixed in State
end;
procedure TForm2.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var iCol, iRow: Integer;
begin
with TStringGrid(Sender)
do
if (Button = mbLeft)
and Editing
then begin
MouseToCell(x, y, iCol, iRow);
if (iCol > 0)
and (iRow > 0)
then begin
if Cells[iCol, iRow] = '
true'
then // Checked
Cells[iCol, iRow]:= '
false'
else if Cells[iCol, iRow] = '
false'
then // not Checked
Cells[iCol, iRow]:= '
true';
end;
end;
end;
procedure TForm2.ButtonQMCcalcClick(Sender: TObject);
var
OutPutList: TStringList;
QMC_RESULT: Ansistring;
maxrun: integer;
I: Integer;
begin
if checkbox2.Checked
then maxrun:=300
else maxrun:=1;
for I := 0
to maxrun
do
begin
try
// if I make the CPPCLass locally then the prg crashes
// at the second click on Create-True-Table
// whithout the routine in CPPClass.cpp
// char* outputTerm(char* pcTTT, int bitfield, int mask, int num)
// it works fine.
// Workarount, make CPPCLass global and call Create of this Class
// at the beginning only once.
//CPPClass := CreateCppDescendant;
OutPutList := TStringList.Create;
CPPCLass.MTCount:=strtoint(Edit1.text);
if checkbox1.checked
then CPPClass.Dummy := 1
else CPPCLass.Dummy:=0;
CPPClass.DoSomething;
QMC_Result:=(CPPCLass.text);
Split('
:', QMC_Result , OutPutList) ;
Memo1.Lines.Add(Format('
RUN-Nummer: %d',[i]));
Memo1.Lines.Add(OutPutList[0]);
Memo1.Lines.Add(OutPutList[1]);
finally
//CPPClass.Free;
OutPutList.Free;
end;
end;
end;
end.