dhtmlx+lotusscript周视图

前几天通过dhtmlx和ls做了一个日程管理的视图，周视图图片如下

 

本视图分了两部分，一部分是上面的日期显示和日历显示，另一部分是显示一周中每天的日程。

第一部分主要用js和dhtmlx的calendar控件做日历的，具体代码如下

<link rel="STYLESHEET" type="text/css" href="/resources/controls/dhtmlx/dhtmlxCalendar/dhtmlxcalendar.css">
<script src="/resources/controls/dhtmlx/grid/dhtmlxcommon.js"></script>
<script src="/resources/controls/dhtmlx/dhtmlxCalendar/dhtmlxcalendar.js"></script>

上面部分是引用dhtmlx的文件，下面是js通过url参数(如果没则显示当前日期)显示具体是哪个日期以及绑定用户点击日历的触发事件代码

var oldyear,oldmonth,oldday;
var mDCal,mDCal1;
var thetime = new Date();//取得当前时间
var thisYear = thetime.getYear();
//取得下个月(getMonth是以0开始),所以+2
var thisMonth = thetime.getMonth()+2;
if (thisMonth == 13)
{
thisYear = thisYear + 1;
thisMonth = 1;
}
//取得当月是几号
var thisDay = thetime.getDate();
//设置日历格式(
//var alltimes = thisMonth+"/"+thisDay+"/"+thisYear;

window.dhx_globalImgPath="/resources/controls/dhtmlx/dhtmlxCalendar/imgs";
//创建日历
window.onload = function(){
mDCal = new dhtmlxCalendarObject('dhtmlxDblCalendar',false,{
   isYearEditable:true,
   isMonthEditable:true
});
//设置时间范围
mDCal.setYearsRange(1990,2050);
//设置时间
mDCal.attachEvent("onClick",dayChange);
mDCal.options.weekstart = 1;
mDCal.draw();
mDCal1 = new dhtmlxCalendarObject('dhtmlxDblCalendar1',false,{
   isYearEditable:true,
   isMonthEditable:true
});
mDCal1.setYearsRange(1990,2050);
//添加事件
mDCal1.attachEvent("onClick",dayChange);
mDCal1.options.weekstart = 1;
mDCal1.draw();
dayChanges(new Date());
}

//加载日期
function dayChanges(date)
{
var thistime2;
var urls = window.location.href + "&";
var urlday = getParam(urls,"day");
var urlyear = getParam(urls,"year");
var urlmonth = getParam(urls,"month");

if (urlyear != "" && urlmonth != "" && urlday != "")
{
   thistime2 = new Date();
   thistime2.setYear(urlyear);
   thistime2.setMonth(urlmonth-1);
   thistime2.setDate(urlday);
   //mDCal1.setDate((urlmonth+1)+"/"+urlday+"/"+urlyear);
}
else
{
   thistime2 = new Date(date);
}
var theYear = thistime2.getYear();
var theMonth = thistime2.getMonth() + 1;
var theDay = thistime2.getDate();
mDCal.setDate(theMonth+"/"+theDay+"/"+theYear);
mDCal1.setDate((theMonth+1) + "/" + theDay + "/"+theYear);
//取得当天是星期几
var thisweekDay = thistime2.getDay();
if (thisweekDay == 0)
{
   thisweekDay = 7;
}
var theclickday = thistime2.getDate();
//上个月，当月，下个月
var prevMonth,theMonth,nextMonth;
//上个月天数，当月天数，下个月天数
var prevMonthdays,theMonthdays,nextMonthdays;
if (thistime2.getMonth() < 1)
{
   prevMonth = 12;
}
else
{
   prevMonth = thistime2.getMonth() ;
}
theMonth = prevMonth + 1;

if (theMonth > 12)
{
   theMonth = 1;
}
nextMonth = theMonth + 1;
if (nextMonth > 12)
{
   nextMonth = 1;
}
prevMonthdays = thetime.getMonthDays(prevMonth-1);
theMonthdays = thetime.getMonthDays(theMonth-1);
nextMonthdays = thetime.getMonthDays(nextMonth-1);
var isYun = thistime2.getYear() % 4 == 0 && thistime2.getYear() % 100 != 0
if ( isYun ||thistime2.getYear() % 400 == 0)
{
   if (theMonth == 2)
   {
    theMonthdays = theMonthdays + 1;
   }
}

//一个星期第一天和最后一天的分别日期
var weekStartMonth,weekEndMonth,weekStartDay,weekEndDay;
if (theclickday-thisweekDay < 0)
{
   weekStartMonth = prevMonth;
   weekStartDay = prevMonthdays + theclickday-thisweekDay+1;
}
else
{
   weekStartMonth = theMonth;
   weekStartDay = theclickday-thisweekDay+1;
}

if (theclickday + (7-thisweekDay) > theMonthdays)
{
   weekEndMonth = nextMonth;
   weekEndDay = theclickday + (7-thisweekDay)-theMonthdays;
}
else
{
   weekEndMonth = theMonth;
   weekEndDay = theclickday + 7 - thisweekDay;
}
oldyear = thistime2.getYear();
oldmonth = weekStartMonth;
oldday = weekStartDay;
var theday = document.getElementById("thedate");
theday.innerHTML = weekStartMonth + "月" + weekStartDay + "日 -<br>";
theday.innerHTML = theday.innerHTML + weekEndMonth + "月" + weekEndDay + "日";
}

//传入url参数
function dayChange(date)
{
var thistime2;
thistime2 = new Date(date);

if (oldyear == thistime2.getYear())
{
   var tempmonth = Math.abs(oldmonth - (thistime2.getMonth()+1));
   if (tempmonth <=1)
   {
    if (thistime2.getDate() >= oldday && thistime2.getDate() <= oldday+6 && tempmonth == 0)
    {
     return;
    }
    if (oldday-thistime2.getDate()>=25 && tempmonth != 0)
    {
     return;
    }
   }
}
//取得当前月和日
var weekStartDay = thistime2.getDate();
var weekStartMonth = thistime2.getMonth()+1;

var totalurl = window.location.href;
totalurl = totalurl.substring(0,totalurl.indexOf("?")+9);
if (document.all)
{
   url = "&year="+ thistime2.getYear();
}
else
{
   if (thistime2.getYear() < 1000)
   {
    url = "&year="+ (thistime2.getYear()+1900);
   }
   else
   {
    url = "&year="+ thistime2.getYear();
   }
}
url = url + "&month=" + weekStartMonth;
url = url + "&day=" + weekStartDay + "&SearchUser=" + document.all.SearchUser.value;
//xmlhttp = GetXmlHttpObject();
//xmlhttp.onreadystatechange = stateChangs;

totalurl = totalurl+url;
window.location=totalurl;
}
function getParam(urls,urlname)
{
var i,startpos,endpos;
var tempVal,tempPname;
tempPname = "&" + urlname;
i = urls.indexOf(tempPname);

if (i != -1)
{
   startpos = tempPname.length + i + 1;
   endpos = urls.indexOf("&",startpos);
   tempVal = urls.substring(startpos,endpos);
   return tempVal;
  
}
return "";
}

前面的js主要把第一部分完成了。

至于第二部分，之前有考虑继续用dhtmlx的控件，但是原来OA的日程管理已经用文档型数据库保存了，只有用lotusscript取得用户建立的日程。主要通过一个代理实现，把日程编译成html码加入到当前页面。页面上通过一个“富文本”域，并设置属性为“计算”接收html码

代码如下：

Sub Initialize
On Error Goto errhandle

Dim session As NotesSession
Set session = New NotesSession
Dim doc As NotesDocument
Set doc = session.DocumentContext
Dim db As NotesDatabase
Set db = session.CurrentDatabase

Set F = New f_default

'从QUERYSTRING中得到传过的url参数
Dim a_querystring As Variant
a_querystring = F.Quertstringtoarrary(doc.Query_String_Decoded(0),"&")

Dim this_year As String
Dim this_month As String
Dim this_day As String

this_year = F.QueryString("year",a_querystring)
this_month = F.QueryString("month",a_querystring)
this_day = F.QueryString("day",a_querystring)

'如果没有参数则设置当前日期
If this_year = "" Then
   this_year = Cstr(Year(Now))
End If

If this_month = "" Then
   this_month = Cstr(Month(Now))
End If

If this_day = "" Then
   this_day = Cstr(Day(Now))
End If
If this_month = 0 Then
   this_year = this_year -1
   this_month = 12
End If
If this_month = 13 Then
   this_year = this_year + 1
   this_month = 1
End If

'添加html文本以显示周视图
Call AppendTableHead(db,doc,"","TableMain",Cint(this_year),Cint(this_month),Cint(this_day))


errhandle:
Call F.printerrmsg(doc,"initialize")
Exit Sub
End Sub

 

 

'****************************************************************
'添加html文本到rtfname域里面
'****************************************************************
Public Sub AppendTableHead(db As NotesDatabase,doc As NotesDocument,tablehead As Variant,rtfname As String,this_year As Integer,this_month As Integer,this_days As Integer)
On Error Goto errhandle
'设置每月名称
Dim month_names(12) As String
month_names(1)="1月"
month_names(2)="2月"
month_names(3)="3月"
month_names(4)="4月"
month_names(5)="5月"
month_names(6)="6月"
month_names(7)="7月"
month_names(8)="8月"
month_names(9)="9月"
month_names(10)="10月"
month_names(11)="11月"
month_names(12)="12月"                                           'define month

'设置每月的天数
Dim days_in_month(12) As Integer                                  'define days
days_in_month(1)=31
days_in_month(2)=28
days_in_month(3)=31
days_in_month(4)=30
days_in_month(5)=31
days_in_month(6)=30
days_in_month(7)=31
days_in_month(8)=31
days_in_month(9)=30
days_in_month(10)=31
days_in_month(11)=30
days_in_month(12)=31

If (((this_year Mod 4 = 0) And (this_year Mod 100<> 0)) Or (this_year Mod 400 = 0)) Then
   days_in_month(2) = 29                                ' it's a leap year so change # days in Feb in array
Else
   days_in_month(2) = 28                                ' // not leap year - future use if multi year calendar built
End If

'设置星期名称
Dim weeks_names(7) As String
weeks_names(1) = "星期一"
weeks_names(2) = "星期二"
weeks_names(3) = "星期三"
weeks_names(4) = "星期四"
weeks_names(5) = "星期五"
weeks_names(6) = "星期六"
weeks_names(7) = "星期日"

Dim dates As String               '用户选定的日期
dates = ""
Dim view As NotesView
'取得日程管理记录
If doc.SearchUser(0)<>"All" Then
   Set view=db.getview("v_personCaldate_Person")
Else
   Set view=db.getview("v_personCaldate")
End If


'取得当天号数 是星期几
Dim thedate As Variant
thedate = Datenumber(this_year,this_month,this_days)
theweekday = Cint(Weekday(thedate)) -1
If theweekday = 0 Then
   theweekday = 7
End If


'设置当个星期起始天到结束天
Dim theweekinfo() As String
Redim theweekinfo(6,3)
'星期一日期
If this_days - theweekday < 0 Then
   If this_month-1 < 1 Then
    theweekinfo(0,0) = 12
    theweekinfo(0,3) = this_year-1
   Else
    theweekinfo(0,0) = this_month -1
   End If
   theweekinfo(0,1) = days_in_month(theweekinfo(0,0)) + this_days - theweekday + 1
   theweekinfo(0,2) = 1
   theweekinfo(0,3) = this_year
Else
   theweekinfo(0,0) = this_month
   theweekinfo(0,1) = this_days - theweekday + 1
   theweekinfo(0,2) = 1
   theweekinfo(0,3) = this_year
End If

'星期二日期
theweekinfo(1,1) = theweekinfo(0,1) + 1
theweekinfo(1,2) = 2
theweekinfo(1,3) = this_year
If theweekinfo(1,1) > days_in_month(theweekinfo(0,0)) Then
   theweekinfo(1,1) = 1
   theweekinfo(1,0) = theweekinfo(0,0) + 1
   If theweekinfo(1,0) > 12 Then
    theweekinfo(1,0) = 1
    theweekinfo(1,3) = this_year+1
   End If
Else
   theweekinfo(1,0) = theweekinfo(0,0)
End If
'星期三日期
theweekinfo(2,1) = theweekinfo(1,1) + 1
theweekinfo(2,2) = 3
theweekinfo(2,3) = this_year
If theweekinfo(2,1) > days_in_month(theweekinfo(1,0)) Then
   theweekinfo(2,1) = 1
   theweekinfo(2,0) = theweekinfo(1,0) + 1
   If theweekinfo(2,0) > 12 Then
    theweekinfo(2,0) = 1
    theweekinfo(2,3) = this_year+1
   End If
Else
   theweekinfo(2,0) = theweekinfo(1,0)
End If
'星期四
theweekinfo(3,1) = theweekinfo(2,1) + 1
theweekinfo(3,2) = 4
theweekinfo(3,3) = this_year
If theweekinfo(3,1) > days_in_month(theweekinfo(2,0)) Then
   theweekinfo(3,1) = 1
   theweekinfo(3,0) = theweekinfo(2,0) + 1
   If theweekinfo(3,0) > 12 Then
    theweekinfo(3,0) = 1
    theweekinfo(3,3) = this_year+1
   End If
Else
   theweekinfo(3,0) = theweekinfo(2,0)
End If
'星期五
theweekinfo(4,1) = theweekinfo(3,1) + 1
theweekinfo(4,2) = 5
theweekinfo(4,3) = this_year
If theweekinfo(4,1) > days_in_month(theweekinfo(3,0)) Then
   theweekinfo(4,1) = 1
   theweekinfo(4,0) = theweekinfo(3,0) + 1
   If theweekinfo(4,0) > 12 Then
    theweekinfo(4,0) = 1
    theweekinfo(4,3) = this_year+1
   End If
Else
   theweekinfo(4,0) = theweekinfo(3,0)
End If
'星期六
theweekinfo(5,1) = theweekinfo(4,1) + 1
theweekinfo(5,2) = 6
theweekinfo(5,3) = this_year
If theweekinfo(5,1) > days_in_month(theweekinfo(4,0)) Then
   theweekinfo(5,1) = 1
   theweekinfo(5,0) = theweekinfo(4,0) + 1
   If theweekinfo(5,0) > 12 Then
    theweekinfo(5,0) = 1
    theweekinfo(5,3) = this_year+1
   End If
Else
   theweekinfo(5,0) = theweekinfo(4,0)
End If
'星期日
theweekinfo(6,1) = theweekinfo(5,1) + 1
theweekinfo(6,2) = 7
theweekinfo(6,3) = this_year
If theweekinfo(6,1) > days_in_month(theweekinfo(5,0)) Then
   theweekinfo(6,1) = 1
   theweekinfo(6,0) = theweekinfo(5,0) + 1
   If theweekinfo(6,0) > 12 Then
    theweekinfo(6,0) = 1
    theweekinfo(6,3) = this_year+1
   End If
Else
   theweekinfo(6,0) = theweekinfo(5,0)
End If


'添加内容并设置样式
Dim th As String
th = "<TABLE width=""100%"" style=""border:1px solid #000;border-collapse:collapse""><tr>"

For i=0 To 5
   th = th & "<td width=""50%"" height=""200px"" style=""padding-top:0px;padding-left:0px;VERTICAL-ALIGN: top"">"
   th = th & "<table width=""100%"" style=""border-bottom:1px solid #000;border-right:1px solid #000;"">"
   th = th & "<tr><td height=30px width=""100%"" style=""font-size:18px;background-color:#f0f0f0;border-bottom:1px solid #000;"">"
  
   th = th & month_names(theweekinfo(i,0)) & theweekinfo(i,1) & "日 " & weeks_names(theweekinfo(i,2))
  
   th = th & "</td></tr>"
   th = th & "<tr><td height=200px width=""100%"" style=""VERTICAL-ALIGN: top"" "
  
   dates = Cstr(theweekinfo(i,3))
   If (theweekinfo(i,0) < 10) Then
    dates = dates + "-0" + theweekinfo(i,0)
   Else
    dates = dates + "-" + theweekinfo(i,0)
   End If
   If (theweekinfo(i,1) < 10) Then
    dates = dates + "-0" + theweekinfo(i,1)
   Else
    dates = dates + "-" + theweekinfo(i,1)
   End If
  
   th = th & "onMouseOver=""this.bgColor='#fafafa'"" onMouseOut=""this.bgColor='#ffffff'"" title='双击新增' ondblclick='AddNewInfo(""" & dates & """);'>"
  
   '取得当天的所有日程
   If Len(doc.SearchUser(0))=32 Then
    th = AddDocumentGroup(db,doc,dates,view,th)
   Else
    th = AddDocument(db,doc,dates,view,th)
   End If
  
   th = th & "</td></tr>"
   th = th & "</table>"
   th = th & "</td>"
   If i Mod 2 = 1 Then
    th = th & "</tr><tr>"
   End If
  
   If i=5 Then
    th = th & "<td width=""50%"" height=""150px"" style=""padding-top:0px;padding-left:0px;VERTICAL-ALIGN: top"">"
    th = th & "<table width=""100%"" style=""border-bottom:1px solid #000;border-right:1px solid #000;"">"
    th = th & "<tr><td height=30px width=""100%"" style=""font-size:18px;background-color:#f0f0f0;border-bottom:1px solid #000;"">"
   
    th = th & month_names(theweekinfo(6,0)) & theweekinfo(6,1) & "日 " & weeks_names(theweekinfo(6,2))
   
    th = th & "</td></tr>"
    th = th & "<tr><td height=150px width=""100%"" style=""VERTICAL-ALIGN: top"" "
   
    dates = Cstr(theweekinfo(i+1,3))
    If (theweekinfo(6,0) < 10) Then
     dates = dates + "-0" + theweekinfo(6,0)
    Else
     dates = dates + "-" + theweekinfo(6,0)
    End If
    If (theweekinfo(6,1) < 10) Then
     dates = dates + "-0" + theweekinfo(6,1)
    Else
     dates = dates + "-" + theweekinfo(6,1)
    End If
   
    th = th & "onMouseOver=""this.bgColor='#fafafa'"" onMouseOut=""this.bgColor='#ffffff'"" title='双击新增' ondblclick='AddNewInfo(""" & dates & """);'>"
    '取得当天的所有日程
    If Len(doc.SearchUser(0))=32 Then
     th = AddDocumentGroup(db,doc,dates,view,th)
    Else
     th = AddDocument(db,doc,dates,view,th)
    End If
   
    th = th & "</td></tr>"
    th = th & "</table>"
    th = th & "</td></tr>"
   End If
Next


th = th & "</table>"
'清除域原来内容和添加内容
Call F.clearrtf(doc,rtfname)
Call F.appendhtmltortf(doc,rtfname,th)

errhandle:
F.ErrRaise("AppendTableHead")
Exit Sub
End Sub

 

'****************************************************************
'添加日程管理内容到指定日期
'****************************************************************
Function AddDocument(db As NotesDatabase,doc As notesdocument,dates As String,view As NotesView,thbefore As String) As String
On Error Goto errhandle
Dim dc As notesdocumentcollection
Dim tempdoc As NotesDocument
Dim key(0) As String
Dim k As Integer
Dim th As String
th = ""
Dim vc As NotesViewEntryCollection
Dim entry As NotesViewEntry

'根据日期和用户设置关键字
If doc.SearchUser(0)<>"All" Then
   key(0) = dates + doc.SearchUser(0)
Else
   key(0) = dates
End If

'Set dc=view.getalldocumentsbykey(key,True)
Set vc = view.GetAllEntriesByKey(key)
''''''''''''''''''''''''''''''''''''''''''''
If Not (vc Is Nothing) And vc.count<>0 Then
   For k=1 To vc.count
    'Set tempdoc = dc.GetNthDocument(k)
    Set entry = vc.GetNthEntry(k)
    Set tempdoc = entry.Document
   
    If tempdoc.Subject(0)<>"" Then
    
     Dim temptime As String
     temptime = ""
     If Format(tempdoc.starttimeday(0),"YYYY-MM-DD") =Format(dates,"YYYY-MM-DD") And Format(tempdoc.endtimeday(0),"YYYY-MM-DD") = Format(dates,"YYYY-MM-DD") Then
      temptime = temptime & tempdoc.starttimehour(0) & ":" & tempdoc.startminute(0) & "-" & tempdoc.endtimehour(0) & ":" & tempdoc.endminute(0)
     Elseif Format(dates,"YYYY-MM-DD") = Format(tempdoc.starttimeday(0),"YYYY-MM-DD") And Format(dates,"YYYY-MM-DD") <> Format(tempdoc.endtimeday(0),"YYYY-MM-DD") Then
      temptime = temptime & tempdoc.starttimehour(0) & ":" & tempdoc.startminute(0) & "至" & Format(tempdoc.endtimeday(0),"MM-DD")
     Elseif Format(dates,"YYYY-MM-DD") <> Format(tempdoc.starttimeday(0),"YYYY-MM-DD") And Format(dates,"YYYY-MM-DD") = Format(tempdoc.endtimeday(0),"YYYY-MM-DD") Then
      temptime = temptime & Format(tempdoc.starttimeday(0),"MM-DD") & "至" & tempdoc.endtimehour(0) & ":" & tempdoc.endminute(0)
     Elseif Format(dates,"YYYY-MM-DD") <> Format(tempdoc.starttimeday(0),"YYYY-MM-DD") And Format(dates,"YYYY-MM-DD") <> Format(tempdoc.endtimeday(0),"YYYY-MM-DD") Then
      temptime = temptime & "全天"
     End If
    
    
     th = th & "<font size=10 color='#000000'>"
     th = th & OpenHtml(db,tempdoc,"[" & temptime & "]" & tempdoc.Subject(0),k,doc)
    
     If tempdoc.Content(0)<>"" Then
      'If tempdoc.Creater(0)=doc.curuser(0) Then
       'th =th+ {<a href="javascript:openCenterWindow('}+doc.Sys_CURDB2(0) + "/fwrite/" + "?EditDocument"+{','600','600')">}+{"<img src=/oadata/e_personcal.nsf/vwicn082.gif>"</a>}
      th =th+ {"<img src=/oadata/e_personcal.nsf/vwicn082.gif>"}
     
      'Else
       'th =th+ {<a href="javascript:openCenterWindow('}+doc.Sys_CURDB2(0) + "/fwrite/" + "?OpenDocument"+{','600','600')">}+{"<img src=/oadata/e_personcal.nsf/vwicn082.gif>"</a>}
     
      'End If
     Else
     
     
      If tempdoc.Creater(0)=doc.curuser(0) Then
       th =th+ {<a href="javascript:openCenterWindow('}+doc.Sys_CURDB2(0) + "/fwrite/" + tempdoc.UniversalID + "?EditDocument"+{','600','600')">}+{</a>}
      Else  
       th =th+ {<a href="javascript:openCenterWindow('}+doc.Sys_CURDB2(0) + "/fwrite/" + tempdoc.UniversalID + "?OpenDocument"+{','600','600')">}+{</a>}
       'th=th+"0000"
      End If
     End If
    
%REM
     If Format(tempdoc.starttimeday(0),"YYYY-MM-DD") =Format(dates,"YYYY-MM-DD") And Format(tempdoc.endtimeday(0),"YYYY-MM-DD") = Format(dates,"YYYY-MM-DD") Then
      th = th & tempdoc.starttimehour(0) & ":" & tempdoc.startminute(0) & "-" & tempdoc.endtimehour(0) & ":" & tempdoc.endminute(0) & "<BR>"
     Elseif Format(dates,"YYYY-MM-DD") = Format(tempdoc.starttimeday(0),"YYYY-MM-DD") And Format(dates,"YYYY-MM-DD") <> Format(tempdoc.endtimeday(0),"YYYY-MM-DD") Then
      th = th & tempdoc.starttimehour(0) & ":" & tempdoc.startminute(0) & "至" & Format(tempdoc.endtimeday(0),"MM-DD") & "<BR>"
     Elseif Format(dates,"YYYY-MM-DD") <> Format(tempdoc.starttimeday(0),"YYYY-MM-DD") And Format(dates,"YYYY-MM-DD") = Format(tempdoc.endtimeday(0),"YYYY-MM-DD") Then
      th = th & Format(tempdoc.starttimeday(0),"MM-DD") & "至" & tempdoc.endtimehour(0) & ":" & tempdoc.endminute(0)   & "<BR>"
     Elseif Format(dates,"YYYY-MM-DD") <> Format(tempdoc.starttimeday(0),"YYYY-MM-DD") And Format(dates,"YYYY-MM-DD") <> Format(tempdoc.endtimeday(0),"YYYY-MM-DD") Then
      th = th & "全天" & "<BR>"
     End If
%ENDREM
    End If
   
   Next
   th =th & "</TD>"
Else
   th=th & "</TD>"
End If
''''''''''''''''''''''''''''''''''''''''''''

th = thbefore & th
AddDocument = th
Exit Function
errhandle:
F.ErrRaise("AddDocument")
Exit Function
End Function

 

'****************************************************************
'为日程管理内容提供链接
'****************************************************************
Function OpenHtml(db As NotesDatabase,doc As NotesDocument,showtext As String, i As Integer,curdoc As NotesDocument) As String
Dim tempstr As String
'判断是否是当前用户的日程 如果是则链接到可编辑否则只是打开
If doc.Creater(0)=curdoc.curuser(0) Then
   tempstr = "<a target=_blank class=""a1"" href='/" & F.getCurDBPath(db) & "Fwrite/" & doc.UniversalID & "?EditDocument' title="
   tempstr = tempstr & Showtext &">"&"&nbsp;"
Else
   tempstr = "<a target=_blank class=""a1"" href='/" & F.getCurDBPath(db) & "Fwrite/" & doc.UniversalID & "?OpenDocument' title="
   tempstr = tempstr & Showtext &">"&"&nbsp;"
End If

'tempstr = "<a target=_blank class=""a1"" href='/" & F.getCurDBPath(db) & "Fwrite/" & doc.UniversalID & "?EditDocument' title="
'tempstr = tempstr & Showtext &">"&"(" +Cstr(i) &")&nbsp;"

'If doc.Creater(0)<>F.GetCurUser() Then
' tempstr = tempstr & "" & showtext & "[" & doc.CreaterShortName(0) & "]</a><br>"
'Else
' tempstr = tempstr & "" & showtext & "</a><br>"
'End If
tempstr = tempstr & showtext &"</a><br>"

OpenHtml = tempstr
End Function

 

Function AddDocumentGroup(db As NotesDatabase,doc As notesdocument,dates As String,view As NotesView,thbefore As String) As String
On Error Goto errhandle
Dim dc As notesdocumentcollection
Dim tempdoc As NotesDocument
Dim groupdoc As NotesDocument
Dim key(0) As String
Dim a As Integer
Dim k As Integer
Dim th As String
th = ""

If doc.SearchUser(0)<>"" Then
   Set groupdoc = db.GetDocumentByUNID(doc.SearchUser(0))
   If Not groupdoc Is Nothing Then
    For a=0 To Ubound(groupdoc.Members)
     If groupdoc.Members(a) <> "" Then
      key(0) = dates + groupdoc.Members(a)
      Set dc=view.getalldocumentsbykey(key,True)
                     ''''''''''''''''''''''''''''''''''''''''''''
      If Not (dc Is Nothing) And dc.count<>0 Then
       For k=1 To dc.count
        Set tempdoc = dc.GetNthDocument(k)
        If tempdoc.Subject(0)<>"" Then
         th = th & "<font size=3 color='#000000'>"
         th = th & OpenHtml(db,tempdoc,tempdoc.Subject(0),k,doc)
        
         If Format(tempdoc.starttimeday(0),"YYYY-MM-DD") =Format(dates,"YYYY-MM-DD") And Format(tempdoc.endtimeday(0),"YYYY-MM-DD") = Format(dates,"YYYY-MM-DD") Then
          th = th & tempdoc.starttimehour(0) & ":" & tempdoc.startminute(0) & "-" & tempdoc.endtimehour(0) & ":" & tempdoc.endminute(0) & "<BR>"
         Elseif Format(dates,"YYYY-MM-DD") = Format(tempdoc.starttimeday(0),"YYYY-MM-DD") And Format(dates,"YYYY-MM-DD") <> Format(tempdoc.endtimeday(0),"YYYY-MM-DD") Then
          th = th & tempdoc.starttimehour(0) & ":" & tempdoc.startminute(0) & "至" & Format(tempdoc.endtimeday(0),"MM-DD") & "<BR>"
         Elseif Format(dates,"YYYY-MM-DD") <> Format(tempdoc.starttimeday(0),"YYYY-MM-DD") And Format(dates,"YYYY-MM-DD") = Format(tempdoc.endtimeday(0),"YYYY-MM-DD") Then
          th = th & Format(tempdoc.starttimeday(0),"MM-DD") & "至" & tempdoc.endtimehour(0) & ":" & tempdoc.endminute(0)   & "<BR>"
         Elseif Format(dates,"YYYY-MM-DD") <> Format(tempdoc.starttimeday(0),"YYYY-MM-DD") And Format(dates,"YYYY-MM-DD") <> Format(tempdoc.endtimeday(0),"YYYY-MM-DD") Then
          th = th & "全天" & "<BR>"
         End If
        
        End If
       
       Next
      End If
                     ''''''''''''''''''''''''''''''''''''''''''''
     End If
    Next
   End If
End If


th=th & "</TD>"

th = thbefore & th
AddDocumentGroup = th

Exit Function
errhandle:
F.ErrRaise("AddDocumentGroup")
Exit Function
End Function

 

这个代理主要有好几个方法分别取得url参数，添加html代码，添加用户已建立的日程，添加链接这四个功能