Флажки в StringGrid не переключаются нормально: Delphi

Я изменил код Delphi, найденный здесь, чтобы сохранить состояние флажка в сетке из трех столбцов. Проблема в том, что вам нужно дважды щелкнуть ячейку, чтобы включить ее. Если я установлю goEditing, то вы можете установить состояние одним щелчком мыши, но еще один щелчок делает флажок невидимым. Как я могу предотвратить эти проблемы редактирования состояния?

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids;

type
  TForm1 = class(TForm)
    gridOwnerDraw: TStringGrid;//must set goEditing True
    procedure gridOwnerDrawDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure gridOwnerDrawClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    FInMouseClick: boolean;
    function GetBtnRect(ACol, ARow: integer; complete: boolean): TRect;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  TXT_MARG: TPoint = (x: 4; y: 2);
  BTN_WIDTH = 12;
var
  Checked1: array[1..4] of boolean = (false, true, false, true);
  Checked2: array[1..4] of boolean = (true, false, true, false);

//Returns rectangle where button will be drawn:
procedure TForm1.FormResize(Sender: TObject);
begin
  gridOwnerDraw.Invalidate;
end;

function TForm1.GetBtnRect(ACol, ARow: integer; complete: boolean): TRect;

  function MakeBtnRect(Alignment: TAlignment; cellrect: TRect; complete: boolean): TRect;
  var
    rowHeight: integer;
  begin
    result := cellrect;
    rowheight := cellrect.bottom - cellrect.top;

    case Alignment of
      taLeftJustify:
        begin
          result.Right := cellrect.left + BTN_WIDTH + TXT_MARG.x + (TXT_MARG.x div 2);
          if not complete then
          begin
            result.Top := cellrect.Top + ((RowHeight - BTN_WIDTH) div 2);
            result.Left := cellrect.Left + ((RowHeight - BTN_WIDTH) div 2);
            result.Bottom := result.Top + BTN_WIDTH;
            result.Right := result.Left + BTN_WIDTH;
          end;
        end;
      taRightJustify:
        begin
          result.Left := cellrect.Right - BTN_WIDTH - TXT_MARG.x - TXT_MARG.x;
          if result.left < cellrect.left then
            result.left := Cellrect.left;

          if not complete then
          begin
            result.top := cellrect.top + ((RowHeight - BTN_WIDTH) div 2);
            result.left := result.left + TXT_MARG.x;
            result.right := Result.left + BTN_WIDTH;
            result.Bottom := result.top + BTN_WIDTH;
          end;
        end;
      taCenter:
        begin
          result.left := result.left + ((cellrect.Right - cellrect.left) div 2) - (BTN_WIDTH div 2) - TXT_MARG.x;
          if result.left < cellrect.Left then
            result.left := cellrect.left;
          result.right := result.left + BTN_WIDTH + TXT_MARG.x + TXT_MARG.x;
          if not complete then
          begin
            result.Top := cellrect.Top + ((RowHeight - BTN_WIDTH) div 2);
            result.Left := result.Left + TXT_MARG.x;
            result.Bottom := result.Top + BTN_WIDTH;
            result.Right := result.Left + BTN_WIDTH;
          end;
        end;
    end;
  end;

var
  cellrect: TRect;
begin
  result := Rect(0, 0, 0, 0);

  //Get complete cellrect for the current cell:
  cellrect := gridOwnerDraw.CellRect(ACol, ARow);

  //Last visible row sometimes get truncated so we need to fix that
  if (cellrect.Bottom - cellrect.Top) < gridOwnerDraw.DefaultRowHeight then
    cellrect.Bottom := cellrect.top + gridOwnerDraw.DefaultRowheight;

  if ARow > 0 then
  begin
    //Additional lines have two buttons:
    case ACol of
      1: result := MakeBtnRect(taCenter, cellrect, complete);
      2: result := MakeBtnRect(taCenter, cellrect, complete);
    end;
  end;
end;

procedure TForm1.gridOwnerDrawClick(Sender: TObject);
var
  where: TPoint;
  ACol, ARow: integer;
  btnRect: TRect;
begin
  //Again, check to avoid recursion:
  if not FInMouseClick then
  begin
    FInMouseClick := true;
    try
      //Get clicked coordinates and cell:
      where := Mouse.CursorPos;
      where := gridOwnerDraw.ScreenToClient(where);
      gridOwnerDraw.MouseToCell(where.x, where.y, ACol, ARow);
      if ARow > 0 then
      begin
        //Get buttonrect for clicked cell:
        btnRect := GetBtnRect(ACol, ARow, false);
        InflateRect(btnrect, 2, 2);  //Allow 2px 'error-range'...

        //Check if clicked inside buttonrect:
        if PtInRect(btnRect, where) then
        begin
          case ACol of
            1: Checked1[ARow]:= Not Checked1[ARow];
            2: Checked2[ARow]:= Not Checked2[ARow];
          end;
        end;
      end;
    finally
      FInMouseClick := false;
    end;
  end;
end;

procedure TForm1.gridOwnerDrawDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  txtRect: TRect;
  btnRect: TRect;
  btnState: integer;
  focusRect: TRect;
begin
  //If header is to be drawn:
  if ARow = 0 then
  begin
  end

  //For the rest of the rows:
  else
  begin
    //Setting canvas properties and erasing old cellcontent:
    gridOwnerDraw.Canvas.Brush.Color := clWindow;
    gridOwnerDraw.Canvas.Brush.Style := bsSolid;
    gridOwnerDraw.Canvas.Pen.Style := psClear;
    gridOwnerDraw.Canvas.FillRect(rect);

    //Textposition:
    txtRect := Rect;
    focusRect := Rect;
    if ACol = 1 then
    begin
      txtRect.Left := Rect.left + BTN_WIDTH + TXT_MARG.x + TXT_MARG.x;
      focusRect.Left := txtRect.Left;
    end
    else if ACol = 2 then
    begin
      txtRect.Left := Rect.left + TXT_MARG.x;
    end;

    //Drawing selection:
    gridOwnerDraw.Canvas.Font.Style := [];
    if (gdSelected in State) then
    begin
      gridOwnerDraw.Canvas.Brush.Color := clbtnFace;
      gridOwnerDraw.Canvas.Font.Color := clBlue;
    end
    else
    begin
      gridOwnerDraw.Canvas.Brush.Color := clWindow;
      gridOwnerDraw.Canvas.Font.Color := clWindowText;
    end;
    gridOwnerDraw.canvas.FillRect(Rect);

    //Drawing buttons:
    if ACol > 0 then
    begin
      //Clear buttonarea:
      btnRect := GetBtnRect(ACol, ARow, true);
      gridOwnerDraw.canvas.Brush.Color := clWindow;
      gridOwnerDraw.canvas.FillRect(btnrect);

      //Get buttonposition and draw checkbox:
      btnRect := GetBtnRect(ACol, ARow, false);
      btnState := DFCS_BUTTONCHECK or DFCS_FLAT;
      if (ACol=1) and Checked1[ARow] then
        btnState := btnState or DFCS_CHECKED
      else if (ACol=1) then
        btnState := btnState or DFCS_BUTTONCHECK
      else if (ACol=2) and Checked2[ARow] then
        btnState := btnState or DFCS_CHECKED
      else if (ACol=2) then
        btnState := btnState or DFCS_BUTTONCHECK;
      DrawFrameControl(gridOwnerDraw.canvas.handle, btnRect, DFC_BUTTON, btnState)
    end;

    //If selected, draw focusrect:
    if gdSelected in State then
    begin
      gridOwnerDraw.canvas.pen.Style := psInsideFrame;
      gridOwnerDraw.canvas.pen.Color := clBtnShadow;
      gridOwnerDraw.canvas.Polyline([Point(focusRect.left-1, focusRect.Top), Point(focusRect.right-1, focusRect.Top)]);
      gridOwnerDraw.canvas.Polyline([Point(focusRect.left-1, focusRect.Bottom-1), Point(focusRect.right-1, focusRect.Bottom-1)]);
      if ACol = 1 then
        gridOwnerDraw.canvas.Polyline([Point(focusRect.left-1, focusRect.Top), Point(focusRect.left-1, focusRect.Bottom-1)])
      else if ACol = gridOwnerDraw.ColCount - 1 then
        gridOwnerDraw.canvas.Polyline([Point(focusRect.right-1, focusRect.Top), Point(focusRect.right-1, focusRect.Bottom-1)]);
    end;
  end;
end;

end.

1 ответ

Решение

Вам нужно два щелчка, потому что вы не запускаете рисование после того, как определили, что щелчок находится на границе флажка. Второй щелчок лишает законной силы ранее выбранную ячейку, независимо от того, является ли она той же самой ячейкой или нет, следовательно, теперь отражается переключенное состояние флажка.

Снимите флажок, чтобы перекрасить его:

procedure TForm1.gridOwnerDrawClick(Sender: TObject);
var
  where: TPoint;
  ACol, ARow: integer;
  btnRect: TRect;
begin
      ..
        ...
        if PtInRect(btnRect, where) then
        begin
          case ACol of
            1: Checked1[ARow]:= Not Checked1[ARow];
            2: Checked2[ARow]:= Not Checked2[ARow];
          end;
          InvalidateRect(gridOwnerDraw.Handle, @btnRect, True);  // <-Here
        end;
      end;
    finally
      FInMouseClick := false;
    end;
  end;
end;

Из-за недействительности ваш gridOwnerDrawDrawCell будет вызвано рисование соответствующего состояния проверки.

Другие вопросы по тегам