急!急!急!象股票大盘一样,涨的是红色,跌的是绿色,0是白色,用dbgrideh如何实现,help me!(30分)

  • 主题发起人 太平公主
  • 开始时间

太平公主

Unregistered / Unconfirmed
GUEST, unregistred user!
急!急!急!象股票大盘一样,涨的是红色,跌的是绿色,0是白色,用dbgrideh如何实现,help me!
 
在OnDrawDataCell中写代码根据数值设置颜色,再调用默认的DefaultDrawDataCell画单元格
 
dbgrideh的onGetCellParams中写入以下代码
procedure TForm1.DBGridEh2GetCellParams(Sender: TObject; Column: TColumnEh;
AFont: TFont; var Background: TColor; State: TGridDrawState);
begin
if '涨' then
afont.Color:=clRed
else if '跌' then
afont.color:=clGreen
else afont.color:=clwhite
end
 
这个简单,
在dbgrid的OnDrawColumnCel事件里重绘就可以了:
procedure TZcfzbForm.dbgZcfzbDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
var oldcolor:tcolor;
oldpm:tpenmode;//原先的画笔的状态
begin
//若当前列为年初数或者为期末数
if (Column.FieldName='NCS') or(Column.FieldName='QMS')then
begin
//若行号为空
if ZcfzbForm.ADOqryTempZcfzb.FieldByName('HC').asstring='' then
begin
oldpm:= dbgZcfzb.Canvas.pen.mode;
oldcolor:= dbgZcfzb.Canvas.font.color;
dbgZcfzb.Canvas.font.color:=clGrayText;
dbgZcfzb.Canvas.pen.mode:=pmmask;
dbgZcfzb.DefaultDrawColumnCell(Rect, DataCol, Column, State);
dbgZcfzb.Canvas.font.color:=oldcolor;
dbgZcfzb.Canvas.pen.mode:=oldpm
end;
//若列值小于0且若行号不为空
if (Column.Field.Value<0) and
(ZcfzbForm.ADOqryTempZcfzb.FieldByName('HC').asstring<>'') then
begin
oldpm:= dbgZcfzb.Canvas.pen.mode;
oldcolor:= dbgZcfzb.Canvas.font.color;
dbgZcfzb.Canvas.font.color:=clred;//字体为红色
dbgZcfzb.Canvas.pen.mode:=pmmask;
dbgZcfzb.DefaultDrawColumnCell(Rect, DataCol, Column, State);
dbgZcfzb.Canvas.font.color:=oldcolor;
dbgZcfzb.Canvas.pen.mode:=oldpm
end;
//若列值大于等于0且若行号不为空
if (Column.Field.Value>=0) and
(ZcfzbForm.ADOqryTempZcfzb.FieldByName('HC').asstring<>'')then
begin
oldpm:= dbgZcfzb.Canvas.pen.mode;
oldcolor:= dbgZcfzb.Canvas.font.color;
dbgZcfzb.Canvas.font.color:=clgreen;
dbgZcfzb.Canvas.pen.mode:=pmmask;
dbgZcfzb.DefaultDrawColumnCell(Rect, DataCol, Column, State);
dbgZcfzb.Canvas.font.color:=oldcolor;
dbgZcfzb.Canvas.pen.mode:=oldpm
end;
end;
end;
这是我以前做的一段程序的例子
若背景想改为其它颜色则用brush的颜色来控制
 
to 独酷求败
我已经按照你的方法试了,但是不行,dbgrideh全变成红色的了,我的dbgrideh是和table的一个字段相连的,如下:
if table1s3.Value>0 then
afont.Color:=clRed
else if table1s3.Value<0 then
afont.color:=clGreen
else afont.color:=clwhite
 
在ondrawdatacell中
if 涨 then
begin
TDBGrid(Sender).Canvas.Brush.Color := CodeForeColor;
end
else
begin
TDBGrid(Sender).Canvas.Brush.Color := NormalForeColor;
end;
TDBGrid(Sender).DefaultDrawDataCell(Rect, Field, State);
 
to zswenyun
我按你的方法也试了,好象也不行呀,你能不能给我讲讲事件重绘的原理和方法呀,这样我就好
理解了,谢谢了
 
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if Table1.FieldByName('size').AsInteger >=40 then
begin
DBGrid1.Canvas.Font.Color := clRed;
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
if (Table1.FieldByName('size').AsInteger >=30) and (Table1.FieldByName('size').AsInteger<40) then
begin
DBGrid1.Canvas.Font.Color := clBlue;
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
if (Table1.FieldByName('size').AsInteger >=20) and (Table1.FieldByName('size').AsInteger<30) then
begin
DBGrid1.Canvas.Font.Color := clYellow;
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
if (Table1.FieldByName('size').AsInteger >=10) and (Table1.FieldByName('size').AsInteger<20) then
begin
DBGrid1.Canvas.Font.Color := clLime;
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
end;

end.
 
to 白海森
太感谢了,基本上解决了,但是还有个问题,颜色改变时,整条记录都改了,我只想让一个字段
改变颜色,应该怎么做?
 
先把原来的颜色以变量保存,
DefaultDrawColumnCell后再把颜色复原为原来的颜色呀!
 
我做的一个存货报警报警的模块,请看看。
procedure TAlaForm.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
if Table1.Fields[4].AsInteger<0 then
DBGrid1.Canvas.Font.Color:=clRed;
if Table1.Fields[4].AsInteger>0 then
DBGrid1.Canvas.Font.Color:=clBlue;
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;

Fields[4]是和库存下限比较后的结果。
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
这一句很重要,没有就不行。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
717
import
I
I
回复
0
查看
600
import
I
顶部