-1

我已经修改了此处找到的 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.
4

1 回答 1

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将被称为绘制适当的检查状态。

于 2014-06-22T00:37:54.090 回答