卖了、卖了、卖血了，200分求助StringGrid的Canvas问题(200分)

E

exam

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-15

• #1

在StringGrid上点中一个cell时，在cell底下画一条自左向右的线
当colcount*defaultcolwidth <= stringgrid.width
(也就是不能出现水平滚动条)时可以实行,大于时
就不行，怎么办呀！怎么办呀！！

图示
1 cell 1
1-------------------------------------------1
1 1
我写的代码
procedure TForm1.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
StringGrid1.Invalidate;
end;

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
DownRect,lastRect : TRect;
begin
with stringgrid1 do
begin
DownRect := cellRect(Col,Row) ;
lastRect := cellrect(colcount-1,row);
canvas.moveto(0,DownRect.Bottom);
canvas.lineto(lastRect.right,DownRect.Bottom);
end;
end;

 

V

VeryCoolBoy

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-15

• #2

cellRect只对可视的CELL有效,所以你得计算出可视的CELL如下
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
DownRect,lastRect : TRect;
i:integer;
begin
with stringgrid1 do
begin
DownRect := cellRect(Col,Row) ;
lastRect := cellrect(colcount-1,row);
i:=colcount-1;
while lastRect.Right <=0 do
begin
dec(i);
lastRect := cellrect(i,row);
end;
canvas.moveto(0,DownRect.Bottom);
canvas.lineto(lastRect.right,DownRect.Bottom);
end;
end

给分吧

 

V

VeryCoolBoy

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-16

• #3

昨天给你回贴时比较赶时间，所以，有点毛糙，完整的答案如下

procedure TForm1.DrawLine; //定义的一个划线方法
var
DownRect,lastRect : TRect;
i:integer;
begin
with stringgrid1 do
begin
DownRect := cellRect(Col,Row) ;
lastRect := cellrect(colcount-1,Row);
i:=colcount-1;
while lastRect.Right <=0 do
begin
dec(i);
lastRect := cellrect(i,Row);
end;
canvas.moveto(0,lastRect.Bottom); //注意，这里应该用lastRect，下面的也一样
canvas.lineto(lastRect.right,lastRect.Bottom);
end;
end;

//在OnDrawCell中划线，可保证即时刷新
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
DrawLine;
end;

procedure TForm1.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
StringGrid1.Invalidate;
end;

 

E

exam

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-18

• #4

hehe,效果不错，但还有一点小问题，我再看盾，不过200分你拿定了。

 

E

exam

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-18

• #5

to: VeryCoolBoy
用方向键时，当向下翻过一页，按UP键不放有Error

 

V

VeryCoolBoy

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-18

• #6

因为你只在OnMouseDown里重画，我原来以为你只要达到这个效果。
其实你将OnMouseDown里面的代码放到OnSelectCell中即可,那么就不用MouseDown了

 

V

VeryCoolBoy

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-18

• #7

我再测试了一下，或许你将
canvas.moveto(0,lastRect.Bottom);
canvas.lineto(lastRect.right,lastRect.Bottom);
改为
canvas.moveto(0,lastRect.Bottom-1);
canvas.lineto(lastRect.right,lastRect.Bottom-1);
并见参上贴，效果更好

 

V

VeryCoolBoy

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-18

• #8

这样还存在一点问题,如果用鼠票标点击垂直滚动条程序会死掉,可将DrawCell处的代码改为
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if cellRect(0,StringGrid1.Row).Bottom<=0 then exit;
//避开所选定的行被翻到上面的情况
DrawLine;
end;

 

E

exam

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-18

• #9

To: veaycoolboy
加上这条if cellRect(0,StringGrid1.Row).Bottom<=0 then exit;
后,移到后面列时不在画线。
我也觉的在这个位置加上一个判断，试了一上午没有好的办法。

- 1 后有焦点的Cell下画不出线。

 

V

VeryCoolBoy

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-18

• #10

你的e-mail??

 

E

exam

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-18

• #11

ly_delphi@163.net

 

E

exam

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-18

• #12

我这QQ上不了，当fixedCols := 0 时有上面的问题。你再看看

 

V

VeryCoolBoy

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-18

• #13

cellRect只对可视的CELL有效，还是这个原因
procedure TForm1.DrawLine;
var
DownRect,lastRect : TRect;
i:integer;
begin
with stringgrid1 do
begin
DownRect := cellRect(Col,Row);
lastRect := cellrect(colcount-1,Row);
for i:=StringGrid1.ColCount -1 downto 0 do //改用for,避开while造成的死循环
begin
lastRect := cellrect(i,Row);
if (lastRect.Right>0) then break;
end;
if lastRect.Right <=0 then exit;
canvas.moveto(0,lastRect.Bottom-1);
canvas.lineto(lastRect.right,lastRect.Bottom-1);
end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
DrawLine;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
StringGrid1.Invalidate;
end;

 

E

exam

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2001-06-19

• #14

问题解决了，谢谢VeryCoolBoy。先给你200分

如果Edit=False;怎样去掉焦点框，另外有分。
解决后给我发Mail.