Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi StringGrid-Komponente mit Checkbox (https://www.delphipraxis.net/89595-stringgrid-komponente-mit-checkbox.html)

BillieJoe90 2. Apr 2007 23:14


StringGrid-Komponente mit Checkbox
 
Hallo,
ich suche eine StringGrid-Komponente, in der eine Checkbox vorhanden ist, die IMMER sichtbar ist. Bisher habe ich nur eine kostenlose Komponente gefunden, bei der man erst im "Editier-Modus" einer Zelle die Checkbox sieht, und eine kostenpflichtige, die meinen Wunsch erfüllt. Aber 75$ sind mir zu viel Geld für dieses eine Feature.
Kennt jemand eine kostenlose StringGrid-Komponente, die das unterstützt?

Danke schonmal!

Johannes

Hansa 2. Apr 2007 23:17

Re: StringGrid-Komponente mit Checkbox
 
Wieso schreibst Du die nicht selber ?

BillieJoe90 2. Apr 2007 23:27

Re: StringGrid-Komponente mit Checkbox
 
Zitat:

Zitat von Hansa
Wieso schreibst Du die nicht selber ?

:lol:




weil ich das nicht kann...

Aber wie schwer wäre sowas denn? Ist das das richtige für den Anfang der Komponenten-Programmierung? Überlegt habe ich es sogarschonmal, nur hätteich keine Ahnung, wie ich da überhaupt anfangen sollte... Irgendwie halt die Methode überschreiben, in der er die Zellen zeichnet :gruebel:

Hansa 2. Apr 2007 23:33

Re: StringGrid-Komponente mit Checkbox
 
"Überschreiben" ist eine Binsenweisheit. Der Rest wird allerdings schon gebraucht. Stichwort : OnDrawCell. Der auszufüllende Source dürfte gleich kommen.

Hobby-Programmierer 3. Apr 2007 05:18

Re: StringGrid-Komponente mit Checkbox
 
Moin ...,
bei einem StringGrid bedeutet das ein nicht unerheblicher Aufwand. Wie Hansa schon schrieb, musst du dich dabei um alles selber kümmern. CheckBox erstellen, ausrichten, freigeben usw.!
Versuche lieber von TListView abzuleiten.
Wenn du es trotz alledem versuchen möchtest, hier eine kleine unvollständige Vorlage wie ich es mal gemacht hatte. Für eine Komponente musst du das natürlich anpassen!

Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
  with StringGrid1 do begin
    Cells[0,0]:= 'CheckBox';
    for i:= 1 to ColCount do Cells[i,0]:= 'Element '+ IntToStr(i);
    for i:= 1 to RowCount do Cells[1,i]:= IntToStr(i);
  end;

  AddCheckBox(0,1);
  AddCheckBox(1,2);
end;

procedure TForm1.MyCheckBoxClick(Sender: TObject);
begin
  ShowMessage('Click!');
end;

procedure TForm1.AddCheckBox(iCol, iRow: Integer);
var NewCheckBox: TCheckBox;
begin
  with StringGrid1 do begin
    if Objects[iCol,iRow] = nil then begin // wenn noch kein Objekt der Zelle zugew. wurde, dann ->
      NewCheckBox:= TCheckBox.Create(Application); // Objekt TCheckBox erstellen
      NewCheckBox.Parent:= Parent; // Eigenschaften zuweisen
      NewCheckBox.Color:= Color;
//      NewCheckBox.Caption:= 'MyCB';
      NewCheckBox.OnClick:= MyCheckBoxClick; // Ereignis zuweisen
      Objects[iCol,iRow]:= NewCheckBox; // CheckBox sagen zu welcher Zelle sie gehört
      Invalidate; // Neuzeichnen erzwingen
    end;
  end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var NewCheckBox: TCheckBox;
begin
  if not (gdFixed in State) then begin // FixedCell ?
    NewCheckBox:= (StringGrid1.Objects[ACol, ARow] as TCheckBox);

    if NewCheckBox <> nil then begin // wenn unsere CheckBox existiert
      NewCheckBox.Left:= Rect.Left +2; // plazieren wir sie innerhalb der Zelle
      NewCheckBox.Top:= Rect.Top +2;
      NewCheckBox.Width:= (Rect.Right - Rect.Left);
      NewCheckBox.Height:= (Rect.Bottom - Rect.Top);
    end;

  end;
end;
LG Mario

Blackheart 3. Apr 2007 08:12

Re: StringGrid-Komponente mit Checkbox
 
Schau mal hier, musst Du nur umstellen auf CheckBox vieleicht klappt das ja.
http://www.s170867368.online.de/delphi/grdbtn.php

Schaedel 3. Apr 2007 08:31

Re: StringGrid-Komponente mit Checkbox
 
Hi,

hier ein Beispiel wie du in eine bestimmte Col fortlaufend Checkboxen setzt....

Delphi-Quellcode:
DrawCell(Sender: TObject; ACol,ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  AktStr : string;
  SmallRect : TRect;
begin
  AktStr := trim(Grid.Cells[ACol, ARow]);
  if (AktStr = '0') then
    AktStr:='';
  if ((ACol=ChkCol1) or (ACol=ChkCol2)) and (ARow>=SGSndDat.FixedRows) then begin
    Grid.Canvas.FillRect(Rect);

    SmallRect:=Rect;
    SmallRect.Top:=Rect.Top + (Rect.Bottom - Rect.Top) div 2 - 7;
    SmallRect.Bottom:=SmallRect.Top + 15;

    if AktStr <> '' then begin
      DrawFrameControl(SGSndDat.Canvas.Handle,SmallRect,DFC_Button,DFCS_BUTTONCHECK or DFCS_CHECKED);
    end else begin
      DrawFrameControl(SGSndDat.Canvas.Handle,SmallRect,DFC_Button,DFCS_BUTTONCHECK);
    end;
  end else begin
    inherited;
  end;
end;
Wenn irgendetwas in der Cell steht ist die Checkbox checked!

Hansa 3. Apr 2007 20:27

Re: StringGrid-Komponente mit Checkbox
 
Das ist nicht gantz trivial, aber es geht. Aber da gibts einige Tricks mehr. Zunächst mal muss der Stringgrid-Zelleninhalt gesetzt werden. Um eben erst unterscheiden zu können, ob die Box gechecked ist, oder nicht. Dieser Wert wird dann im OnDrawCell ausgewertet und je nach Lage wird zunächst dann ein Rechteck gezeichnet. Dieses Rechteck wird dann eben gecheckt oder nicht.

Delphi-Quellcode:
        if ACol in CheckBoxCols then begin
// 0 für Unchecked, 1 für checked, 2 für nur anzeigen
          if StrToInt (sgArtNr.Cells [ACol,ARow]) in [1,2] then begin
            InflateRect(Rect,-1,-1);
            DrawState := ISChecked[StrToInt (sgArtNr.Cells [ACol,ARow]) = 1];
// ^ die 0/1, die aus dem DB-Original in sgArtNr steht beeinflusst, ob die
// CheckBox gecheckt ist ! D.h. sie wird im OnDrawCell je nach Wert gezeichnet !
            sgArtNr.Canvas.FillRect(Rect);// hinter Cells lieg. 0/1/2, aber das soll man nicht sehen
            DrawFrameControl(sgArtNr.Canvas.Handle,Rect,DFC_BUTTON,DrawState);
          end
          else begin  // Checkbox nicht anzeigen !!
            InflateRect(Rect,-1,-1);
            Canvas.FillRect(Rect);
          end;
Der Haupttrick ist der, dass die Stringgrid-Zelle tatsächlich nur aus 0/1/2 besteht, aber die Darstellung als CheckBox so geht. Und das wird quasi überschrieben. Aber nicht im Sinne von OOP, sondern es geht um den Bildschirm, bzw. die StringGrid-Zelle.

Hobby-Programmierer 4. Apr 2007 09:00

Re: StringGrid-Komponente mit Checkbox
 
Liste der Anhänge anzeigen (Anzahl: 1)
Moin ...,
@Schädel & Hansa: genialer Vorschlag von euch :thumb:
Ich habe ein wenig herumgespielt und herausgekommen ist dies:
Delphi-Quellcode:
var
  Form1: TForm1;
  Editing: Boolean;

Const CheckBoxCols = [1,2]; // Spalte 2 ohne Einträge

implementation
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
  for i:= 1 to StringGrid1.RowCount do begin
    StringGrid1.Cells[0,i]:= 'Zeile '+ IntToStr(i);
    StringGrid1.Cells[1,i]:= 'true';
  end;
  Editing:= true; // False = nur Anzeige, true = EditModus
end;

procedure TForm1.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 TForm1.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;
LG Mario

wschrabi 10. Apr 2017 17:11

AW: StringGrid-Komponente mit Checkbox
 
Liste der Anhänge anzeigen (Anzahl: 1)
hallo freunde,
danke für den tip hier.
Doch mein Probleme sind in meinem Prg 2:

1) Zeichne nur alle 2. Rows eine Checkbox. (rote Pfeile)
EDIT: Lösung zu 1 einfach mit mod einschränken
Delphi-Quellcode:
begin
  with TStringGrid(Sender) do
    if ((Arow mod 2)=0) and ((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;




2) Kann man zu jeder row in Col=0 die zweite nachfolgende Row zusammenfassen, so daß beide Zeilen in einer Cell drin sind. (grün Feile)

Mein Code:
Delphi-Quellcode:
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.

hoika 11. Apr 2017 06:04

AW: StringGrid-Komponente mit Checkbox
 
Hallo,
wenn ich den ganzen Code hier sehe, nehme ich doch lieber mein TAdvStringGrid (von TMS),
das kostet zwar etwas, aber die ganze Zeit investiere ch dann lieber in anderen Code.

PS: Das war keine Werbung ;)

yogie 11. Apr 2017 06:20

AW: StringGrid-Komponente mit Checkbox
 
Hallo zusammen
ich habe gute Erfahrungen mit NextGrid von BergSoft gemacht

http://www.bergsoft.net/en-us/downloads

Aviator 11. Apr 2017 07:41

AW: StringGrid-Komponente mit Checkbox
 
Oder kostenlos: VirtualTreeView

wschrabi 12. Apr 2017 09:45

AW: StringGrid-Komponente mit Checkbox
 
Danke für die INfos.
Aber der Punkt ist der, kann eine 3rd party componente 2 Zeilen in eine Cell zusammen anzeigen.
das ist eigenltich das Endproblem.
mfg
walter

hoika 12. Apr 2017 10:14

AW: StringGrid-Komponente mit Checkbox
 
Hallo,
ja, TAdvStringGrid kann Zellen mergen.
Das Beispiel zeigt das horizontale Mergen

AdvStringGrid1.MergeCells(1,6,10,1);
ab Cells[1,6] 10 Spalten mergen, 1 Zeile (also gar keine Zeilen mergen)

AdvStringGrid1.MergeCells(1,6,1,2);
Das würde Cells[1,6] und Cells[1,7] vertikal mergen.

https://www.tmssoftware.com/site/asg39.asp

wschrabi 12. Apr 2017 10:17

AW: StringGrid-Komponente mit Checkbox
 
danke wäre eine überlegung wert.Super Sache, was das kann.

Auch das hab ich gefunden: http://www.delphipages.com/forum/sho...d.php?t=211832

Whookie 12. Apr 2017 10:19

AW: StringGrid-Komponente mit Checkbox
 
Wenn es nur um ganze Zeilen geht, kannst du auch ein Zeile nehmen und sie doppelt so hoch machen...

wschrabi 12. Apr 2017 10:59

AW: StringGrid-Komponente mit Checkbox
 
dankdir, ja aber ich hab trotzdem das tool gekauft. Kann mir viel Arbeit damit sparen.

wschrabi 12. Apr 2017 11:00

AW: StringGrid-Komponente mit Checkbox
 
Zitat:

Zitat von hoika (Beitrag 1367293)
Hallo,


AdvStringGrid1.MergeCells(1,6,1,2);
Das würde Cells[1,6] und Cells[1,7] vertikal mergen.

https://www.tmssoftware.com/site/asg39.asp

Dank Dir genau das brauche ich, habe es mir gekauft. danke für den Tipp.:-D

wschrabi 12. Apr 2017 15:27

AW: StringGrid-Komponente mit Checkbox
 
Liste der Anhänge anzeigen (Anzahl: 1)
Lieber Hoika,
also da Mergen klappt damit super. Siehe bild.

Delphi-Quellcode:
         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];
          if checkbox3.Checked then
            AdvStringgrid1.Cells[1,1+(k*2+1)]:='true'
          else
            AdvStringgrid1.Cells[1,1+(k*2+1)]:='false'   ; // Checkbox state in col 1
          Advstringgrid1.RowCount:=2+(k*2+1);
         
         end;
Doch wie mache ich jetzt eine Checkbox in Spalte 1?
Kannst mir einen Tip geben?

Solution: https://www.tmssoftware.com/site/asg62.asp
DANKE

wschrabi 12. Apr 2017 15:33

AW: StringGrid-Komponente mit Checkbox
 
Und WIE bitte installiert man die HILFE Dateinen unter WIN 10 ?
Schade dass man das alles manuell machen muss. Nicht sehr konfortabel.
ws

wschrabi 12. Apr 2017 15:57

AW: StringGrid-Komponente mit Checkbox
 
Liste der Anhänge anzeigen (Anzahl: 1)
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


Alle Zeitangaben in WEZ +1. Es ist jetzt 18:20 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz