Флажки в 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
будет вызвано рисование соответствующего состояния проверки.