drawcell事件
If e.Form.Controls("BL_日历_当前选择年月").text = "" Then Return
Dim Fnt As Font = New Font("微软雅黑",9)
Dim Fnt1 As Font = New Font("微软雅黑",5)
If e.Form.Width > 300 Then
Fnt1 = New Font("微软雅黑",7)
End If
Dim MyMonth =CDate(e.Form.Controls("BL_日历_当前选择年月").text).Month
Dim points(1) As Point
points(0) = New Point(e.x,e.y)
points(1) = New Point(e.x , (e.y + e.Height))
Dim BJ_标题 As New LinearGradientBrush(points(0),points(1),Color.MediumSpringGreen,Color.SeaGreen) '封装标题栏的背景的渐变色
If e.Row.Index = 0 Then '绘制标题
e.Graphics.FillRectangle(BJ_标题,New Rectangle(e.X,e.Y,e.Width,e.Height))
End If
If e.Row.Index > 0 Then '非标题
Dim x,y As Integer
Dim MyText As String = e.Text
Dim MyDate As Date
If (Date.TryParse(MyText,MyDate)) '如果文本可以转为日期
Dim ZT_当月 As SolidBrush = New SolidBrush(Color.Black)
Dim ZT_非当月 As SolidBrush = New SolidBrush(Color.OliveDrab)
Dim BJ_非当月 As SolidBrush = New SolidBrush(Color.DarkGray)
Dim BJ_当月 As New LinearGradientBrush(points(0),points(1),Color.LightBLue,Color.LightCyan) '封装当月日期背景的渐变色
Dim BJ_今天 As New LinearGradientBrush(points(0),points(1),Color.plum,Color.MediumOrchid) '封装当月日期背景的渐变色
Dim Int_月 As Integer = MyDate.Month
Dim BJ_排班完成 As New LinearGradientBrush(points(0),points(1),Color.CornflowerBlue,Color.LightSteelBlue)
Dim BJ_排班未完成 As New LinearGradientBrush(points(0),points(1),Color.yellow,Color.Beige)
Dim BJ_没有排班 As New LinearGradientBrush(points(0),points(1),Color.Red,Color.Beige)
Dim str As String = Functions.Execute("LunarStr",MyDate) '取农历字符
If str.Contains("初一") Then
ZT_当月 = New SolidBrush(Color.Red)
End If
Dim sf As New StringFormat(StringFormatFlags.NoClip)
sf.Alignment = StringAlignment.Center '文本对中
Dim 公历 As RectangleF = new RectangleF(e.X + 2,e.Y + 2,(e.Width - 4),e.Height/2)
Dim 农历 As RectangleF = new RectangleF((e.X +2),(e.Y + e.Height/2),(e.Width - 4),(e.Height-4))
Dim 单元格 As RectangleF = new RectangleF(e.X,e.Y,e.Width,e.Height)
If Int_月 = MyMonth Then '本月日历
If MyDate = Date.Today Then
e.Graphics.FillRectangle(BJ_今天,单元格)
Else
e.Graphics.FillRectangle(BJ_当月,单元格)
End If
Dim t As Table = Tables("医生排班表")
Dim Filter="日期=#" & MyDate & "#"
Dim ys As String = t.DataTable.GetComboListString("医生姓名", Filter)
If ys = Nothing Then
e.Graphics.FillRectangle(BJ_没有排班,单元格)
Else
Dim drs As List (of DataRow) = DataTables("医生名单").Select("医生姓名 not in ('" & ys.Replace("|", "','") & "')")
If drs.count > 0 Then
e.Graphics.FillRectangle(BJ_排班未完成,单元格)
Else
Dim fdr1 As DataRow = DataTables("医生排班表").find("病房夜班 = true and " & Filter)
Dim fdr2 As DataRow = DataTables("医生排班表").find("(上午 is null or 下午 is null) and " & Filter)
If fdr1 IsNot Nothing AndAlso fdr2 Is Nothing Then
e.Graphics.FillRectangle(BJ_排班完成,单元格)
Else
e.Graphics.FillRectangle(BJ_排班未完成,单元格)
End If
End If
End If
If e.Form.Width < 200 Then
e.Graphics.DrawString(MyDate.Day ,Fnt,ZT_当月,单元格,sf)
Else
e.Graphics.DrawString(MyDate.Day ,Fnt,ZT_当月,公历,sf)
e.Graphics.DrawString(str,Fnt1,ZT_当月,农历,sf)
End If
Else '非本月日历
e.Graphics.FillRectangle(BJ_非当月 ,单元格)
If e.Form.Width < 200 Then
e.Graphics.DrawString(MyDate.Day ,Fnt,ZT_非当月,单元格,sf)
Else
e.Graphics.DrawString(MyDate.Day ,Fnt,ZT_非当月,公历,sf)
e.Graphics.DrawString(str,Fnt1,ZT_非当月,农历,sf)
End If
End If
End If
End If