-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathon_draw_cell_v1.pas
136 lines (107 loc) · 3.74 KB
/
on_draw_cell_v1.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
//表格控件(TStringGrid)是我比较常用的一个控件,对它的 OnDrawCell 事件进行自定义可以得到非常多样的漂亮效果。
//
//这里是我实现过的多种效果的不同版本。
//之所以不同版本都独立生成一个文件是为了方便比对不同的方法,因为比较复杂,用比对软件看得比较清楚,大大地节约了时间
//希望以后的修改者也不要将它们合并为单一文件,那样的话很难对比维护。
//
//目前只用于 delphi7,其他版本需要自己动手修改下。
//
//这是第一个的版本
unit on_draw_cell_v1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
uTHttpThread, ActiveX,ComObj, GIFImage, pngimage, Grids, ShellAPI, ShlObj,
XMLIntf, uColorBorderEdit, StdCtrls, Wininet, WinSock,
XMLDoc,
Dialogs, ExtCtrls;
//自定义的表格控件绘制
procedure OnGridCzDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
implementation
//自定义的表格控件绘制
procedure OnGridCzDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
grid:TStringGrid;
uFormat, uFormat1,uFormat2:UINT;//画字的格式
begin
{
TStringGrid中表格分隔线的颜色
(in Grids.pas)
LineColor := clSilver;
if ColorToRGB(Color) = clSilver then LineColor := clGray;
在Delphi的源程序中已被固定
若要修改,可自己做一个TStringGrid构件
(可参考Grids.pas)
}
grid := sender as TStringGrid;
//--------------------------------------------------
//先画背景
begin
grid.Canvas.Brush.Color := grid.Color;
grid.Canvas.FillRect(Rect);
end;
//--------------------------------------------------
//再画线
if ARow = 0 then//第一行
begin
grid.Canvas.Brush.Color := $00F9F9F9;//clGray;
//grid.Canvas.Font.Color := clRed;
Rect.Bottom := Rect.Bottom + 1;//首行要去掉些东西
Rect.Right := Rect.Right + 1;//首行要去掉些东西
grid.Canvas.FillRect(Rect);
//grid.Canvas.Brush.Color := clSilver;//clRed;
//grid.Canvas.FrameRect(Rect);
//grid.Canvas.Brush.Color := $00F9F9F9;//clGray;
grid.Canvas.MoveTo(Rect.Left, Rect.Top);
grid.Canvas.LineTo(Rect.Right-1, Rect.Top);
grid.Canvas.LineTo(Rect.Right-1, Rect.Bottom-1);
grid.Canvas.LineTo(Rect.Left-1, Rect.Bottom-1);
//if ACol = 0 then//第一列,画左边框就行
end;
//else
if ACol = 0 then//第一列,画左边框就行
begin
grid.Canvas.Brush.Color := $00F9F9F9;//clGray;
grid.Canvas.Font.Color := clRed;
Rect.Bottom := Rect.Bottom + 1;//首行要去掉些东西
Rect.Right := Rect.Right + 1;//首行要去掉些东西
grid.Canvas.MoveTo(Rect.Left, Rect.Top);
grid.Canvas.LineTo(Rect.Left, Rect.Bottom-1);
end ;//Exit;
//else
//--------------------------------------------------
//感觉焦点框还是画上去比较好看//当然不画有不画的好看,或者可以画个自定义的框
if gdFocused in State then
begin
grid.Canvas.DrawFocusRect(rect);
end;
//--------------------------------------------------
grid.Canvas.Font.Color := grid.Font.Color;
Rect.Left := Rect.Left + 1;//不能太满
Rect.Right := Rect.Right - 1;//不能太满
//--------------------------------------------------
//画字的格式
uFormat1 := DT_SINGLELINE or //单行
DT_VCENTER or //正文水平居中(仅对单行)
DT_CENTER;
uFormat2 := //DT_SINGLELINE or //单行
DT_VCENTER or //正文水平居中(仅对单行)
DT_CENTER
or DT_EDITCONTROL or DT_WORDBREAK //DT_EDITCONTROL和DT_WORDBREAK组合使用才行,发现可以自动换行了。
;
uFormat := uFormat1;
if (ARow<>0)and(grid.Canvas.TextWidth(grid.Cells[ACol, ARow]) > Rect.Right - Rect.Left)
then uFormat := uFormat2;
grid.Canvas.Brush.Style := bsClear;
//grid.Canvas.TextRect(Rect, 0, 0, grid.Cells[ACol, ARow]+'aaa');
DrawText(grid.Canvas.Handle
, PChar(grid.Cells[ACol, ARow])
, -1
, Rect
,
uFormat
);
end;
end.