StringGrid-Komponente mit Checkbox

[Hobby-Programmierer]

Moin ...,
@Schädel & Hansa: genialer Vorschlag von euch
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]

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]

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]

Hallo zusammen
ich habe gute Erfahrungen mit NextGrid von BergSoft gemacht

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

[Aviator]

Oder kostenlos: VirtualTreeView

[wschrabi]

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]

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