unit QMC_neu;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.Grids,
FMX.TextLayout, System.UIConsts, AdvUtil, AdvObj, BaseGrid, AdvGrid ;
type
Tinputvec =
array of integer;
Tarrayofchar =
array[1..1]
of char;
TForm2 =
class(TForm)
ButtonQMCcalc: TButton;
Memo1: TMemo;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
Label1: TLabel;
Edit1: TEdit;
Memo2: TMemo;
ButtonTTCreate: TButton;
//StringGrid1: TStringGrid;
Label2: TLabel;
CheckBox3: TCheckBox;
AdvStringGrid1: TAdvStringGrid;
procedure ButtonQMCcalcClick(Sender: TObject);
procedure ButtonTTCreateClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure AdvStringGrid1CheckBoxClick(Sender: TObject; ACol, ARow: Integer;
State: Boolean);
private
{ Private declarations }
procedure Split(Delimiter: Char; Str:
string; ListOfStrings: TStrings) ;
function readTTSetting(): Tinputvec ;
procedure LadeDLL(Sender: TObject);
(* procedure Stringgrid1DrawCellOverstrike(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState); *)
public
{ Public declarations }
end;
const
MAX = 2047;
var
Form2: TForm2;
implementation
{$R *.dfm}
(*
//int __declspec(dllexport) __stdcall calcsum(double a, double b, double c){
function calcsum(a: double; b: double):integer ; stdcall; external 'qmc_dll_Project1.dll';
//char* __declspec(dllexport)__stdcall calcmain(int m_MTCOunt, const char* strInputvec) {
function calcmain( MTCount: integer; INputvec: string): string ; stdcall; external 'qmc_dll_Project1.dll';
//char* __declspec(dllexport)__stdcall getttterms(int m_MTCOunt) {
function getttterms( MTCount: integer): string ; stdcall; external 'qmc_dll_Project1.dll';
//char * __declspec(dllexport)__stdcall calcmaindummy()
function calcmaindummy( ): string ; stdcall; external 'qmc_dll_Project1.dll';
//int __declspec(dllexport) __stdcall calcsum(double a, double b, double c){
*)
var
Editing: Boolean;
hmod : THandle;
calcmain:
function ( MTCount: integer; INputvec: PAnsichar): PAnsiChar ;
stdcall;
calcsum:
function ( a: integer; b: integer; c: integer): integer ;
stdcall;
getttterms:
function ( MTCount: integer): PAnsiChar ;
stdcall;
dummystdcall:
procedure (inp: PAnsiChar) ;
stdcall;
displaytt:
procedure (a: integer) ;
stdcall;
Const CheckBoxCols = [1,2];
// Spalte 2 ohne Einträge
procedure TForm2.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
FreeLibrary(hmod);
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
Editing:=true;
AdvStringgrid1.Cells[0,0]:='
Term';
AdvStringgrid1.ColWidths[0]:=440;
AdvStringgrid1.Cells[1,0]:='
Checked=1 Unchecked=0';
AdvStringgrid1.ColWidths[1]:=240;
LadeDLL( Sender);
end;
procedure TForm2.LadeDLL(Sender: TObject);
begin
hmod := LoadLibrary('
QMC2.dll');
//hmod := LoadLibrary('QMC_DLL_Project1v2.dll');
if (hmod <> 0)
then begin
calcmain := GetProcAddress(hmod, '
calcmain');
if (@calcmain <>
nil)
then begin
//ShowMessage('calmain geladen');
end
else
ShowMessage('
GetProcAddress failed');
getttterms := GetProcAddress(hmod, '
getttterms');
if (@getttterms <>
nil)
then begin
//ShowMessage('getttterms geladen');
end
else
ShowMessage('
GetProcAddress failed');
displaytt := GetProcAddress(hmod, '
displaytt');
if (@displaytt <>
nil)
then begin
//ShowMessage('displaytt geladen');
end
else
ShowMessage('
GetProcAddress failed');
calcsum := GetProcAddress(hmod, '
calcsum');
if (@calcsum <>
nil)
then begin
//ShowMessage(Format('Calcsum geladen: UND TEST: SUM(1,2,3) = %d',[calcsum(1,2,3)]));
end
else
ShowMessage('
GetProcAddress failed');
(*
dummystdcall := GetProcAddress(hmod, 'dummystdcall');
if (@dummystdcall <> nil) then begin
//ShowMessage(Format('dummystdcall geladen: UND Return; = %s',[dummystdcall(PChar('www'))]));
ShowMessage('dummystdcall geladen');
dummystdcall(PAnsiChar('www'));
end
else
ShowMessage('GetProcAddress failed');
*)
end
else
begin
ShowMessage('
LoadLibrary Failed!' + sLineBreak + SysErrorMessage(GetLastError));
end;
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:');
AdvStringgrid1.Cells[0,0]:='
Term';
AdvStringgrid1.Cells[1,0]:='
Checked=1 Unchecked=0';
//stringgrid1.FixedRows:=1;
Advstringgrid1.RowCount:=2;
TTTOutPutListmNeg := TStringList.Create;
TTTOutPutList := TStringList.Create;
//displaytt( strtoint(trim(edit1.Text)));
QMC_TTT:=getttterms( strtoint(trim(edit1.Text)));
//ShowMessage(Format(' Return String is: %s',[QMC_TTT]));
Split('
#', QMC_TTT , TTTOutPutListmNEG) ;
advstringgrid1.FixedCols := 0;
//advstringgrid1.ColWidths[1] := 20;
advstringgrid1.Options := advstringgrid1.Options + [goRowSelect, goEditing];
Advstringgrid1.RowCount:=2+((TTTOUtputlistmNEG.count-2)*2+1);
//advstringgrid1.RowCount := 20;
advstringgrid1.ShowSelection := false;
for k := 1
to advstringgrid1.RowCount -1
do
advstringgrid1.AddCheckBox(1,k,false,false);
//advstringgrid1.RandomFill(false,100);
for k := 0
to TTTOUtputlistmNEG.count-2
do
begin
Split('
;', TTTOUtputlistmNEG[k] , TTTOutPutList) ;
Memo2.Lines.Add(TTTOutPutList[0]);
Memo2.Lines.Add(TTTOutPutList[1]);
AdvStringGrid1.MergeCells(0,1+(k*2),1,2);
AdvStringGrid1.MergeCells(1,1+(k*2),1,2);
AdvStringgrid1.Cells[0,1+(k*2)]:=TTTOutPutList[0]+#10+TTTOutPutList[1];
// AdvStringgrid1.Cells[0,1+(k*2+1)]:=TTTOutPutList[1];
AdvStringGrid1.SetCheckBoxState(1,1+(k*2),checkbox3.Checked);
Advstringgrid1.RowCount:=2+(k*2+1);
end;
finally
//CPPClass.Free;
TTTOutPutList.Free;
TTTOutPutListmNeg.Free;
end;
end;
procedure TForm2.AdvStringGrid1CheckBoxClick(Sender: TObject; ACol,
ARow: Integer; State: Boolean);
begin
advstringgrid1.RowSelect[Arow] := State;
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;
function TForm2.readTTSetting(): tinputvec ;
var
I: Integer;
num: integer;
ptrinresult: ^tinputvec ;
inresult: tinputvec ;
state: boolean;
begin
num:=2
shl (strtoint(trim(edit1.Text))-1);
// 2^num
SetLength(inresult,num);
for I := 0
to num-1
do
begin
inresult[i]:=0;
end;
for I := Low(inresult)
to num
do
begin
Advstringgrid1.GetCheckBoxState(1,i,state);
if state
then
inresult[i]:=1
else
inresult[i]:=0;
end;
Result:=inresult;
end;
procedure TForm2.ButtonQMCcalcClick(Sender: TObject);
var
OutPutList: TStringList;
QMC_RESULT: Ansistring;
ptrInputVec: ^TInputvec ;
InputVec: TInputvec ;
strInputVec: ansistring ;
maxrun,num: integer;
I,k: Integer;
begin
if checkbox2.Checked
then maxrun:=300
else maxrun:=1;
for I := 1
to maxrun
do
begin
try
num:=round(2
shl (strtoint(trim(edit1.Text))-1));
// 2^num
GetMem(ptrINputVec, num*SizeOf(Integer));
INputVec:= readTTSetting();
// 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(trim(Edit1.text));
// As I have problems in doing it with an array of int I do it with str
strINPUTVec := '
';
for k := 0
to num-1
do
begin
strINPUTVec:=strINPUTVec+Format('
%d',[INputVec[k]]);
end;
QMC_Result:=calcmain( strtoint(trim(Edit1.text)), PAnsiChar(strINputvec));
//(CPPCLass.text);
Split('
:', QMC_Result , OutPutList) ;
Memo1.Lines.Add(Format('
%s',[OutPutList[0]]));
Memo1.Lines.Add(Format('
Result for RUN-Nummer: %3d %s',[i,OutPutList[1]]));
finally
//CPPClass.Free;
OutPutList.Free;
FreeMem(ptrINputVec);
end;
end;
end;
end.