StringGrid-Komponente mit Checkbox

[wschrabi]

Und WIE bitte installiert man die HILFE Dateinen unter WIN 10 ?
Schade dass man das alles manuell machen muss. Nicht sehr konfortabel.
ws

[wschrabi]

Gelöst: Besten DANK für diesen Tipp:

Jetzt ist es fertig so wie es sein soll.

Delphi-Quellcode:

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.

:thumb::-D:-D:-D