标签：style blog http color os for ar 2014
在ERP实现排程的模块中，我们希望能直观展现个机台每天的排单情况，一直苦恼Delphi没有合适的控件，没办法，先自己动手。
效果图：
绘制日历关键代码
procedure TForm1.DrawCalender; var iDay, iProcess, days: Integer; row,col:Integer; begin //sgCalender. days := DaysInAMonth(StrToInt(cbbYear.Text), StrToInt(cbbMonth.Text)); sgCalender.ColCount := days + 1; sgCalender.RowCount := MachineNumber+1; sgCalender.RowHeights[0]:= 25; sgCalender.ColWidths[0]:= 80; for iDay := 1 to days do begin sgCalender.Cells[iDay, 0] := IntToStr(iDay); end; for iProcess := 1 to MachineNumber do begin sgCalender.Cells[0, iProcess] := ‘機台‘ + IntToStr(iProcess); end; for row := 1 to MachineNumber do begin for col := 1 to days do begin sgCalender.Cells[col, row] := Format(‘排單數：%d‘ + ‘|‘ + ‘完成數：%d‘+ ‘|‘ + ‘製成率：%d‘,[Random(10000),Random(10000),Random(100)]) ; end; end; end;
在做的时候，由于cell内容不能换行，所以需要在DrawCell处理一下
procedure TForm1.sgCalenderDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
s, item: string;
d: TStringGrid;
I,num: Integer;
begin
d := TStringGrid(sender);
s := d.Cells[ACol, ARow];
begin
d.Canvas.Font.Assign(d.Font); //制定字体
with d.Canvas do
begin
Brush.Color := clWindow; //制定单元格颜色
if gdFixed in State then
Brush.Color := d.FixedColor;
Font.Color := clWindowText;
FillRect(Rect);
with d do
begin
num:=0;
//根据‘|‘ 字符换行
if Pos( ‘|‘,s) >0 then
begin
for I := 0 to Length(s) - 1 do
begin
if s[i] <> ‘|‘ then
begin
item := item + s[i];
end
else
begin
Rect.Top := Rect.Top + num * 30;
DrawText(Canvas.Handle, PChar(trim(item)), Length(Trim(item)), Rect, DT_Left or DT_SINGLELINE or DT_VCENTER);
item := ‘‘;
Inc(num);
end;
end;
if item<>‘‘ then
begin
Rect.Top := Rect.Top + 30;
DrawText(Canvas.Handle, PChar(trim(item)), Length(Trim(item)), Rect, DT_Left or DT_SINGLELINE or DT_VCENTER);
end;
end
else
begin
// Draw Fixed Row Col
DrawText(Canvas.Handle, PChar(s), Length(s), Rect, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
end;
end;
end;
end;
end;
利用Delphi TStringGrid控件实现日历排程,布布扣,bubuko.com
标签：style blog http color os for ar 2014
原文地址：http://www.cnblogs.com/huce/p/3926853.html
