delphi实现执勤表

按周循环排班, 员工人数及值班人数可自定义.

单元文件

unit Unit15;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls;type  TForm15 = class(TForm)    mmo1: TMemo;    cbb_Month: TComboBox;    procedure FormCreate(Sender: TObject);    procedure cbb_MonthChange(Sender: TObject);  private    type      //定义周      TWeekEnum = (wkSunday, wkMonday, wkTuesday, wkWednesday, wkThursday, wkFriday, wkSaturday);    const      //定义每周中各天的值班人数      weekArr: array[TWeekEnum] of Integer = (2, 1, 1, 1, 1, 1, 2);      //定义值班员工数      FEmployeeCount = 13;    { Private declarations }  private    FCurrEmployee : integer;  public    { Public declarations }  end;var  Form15: TForm15;implementationuses DateUtils;{$R *.dfm}procedure TForm15.FormCreate(Sender: TObject);var  i: Integer;begin  FCurrEmployee := 1; //从第1个员工开始  //初始化月份  cbb_Month.Clear;  for i := 1 to 12 do    cbb_Month.Items.Add(IntToStr(i));  cbb_Month.ItemIndex := 0;   //从1月开始排班  cbb_MonthChange(cbb_Month); //触发排班事件end;procedure TForm15.cbb_MonthChange(Sender: TObject);  //获得当天值班的员工名单  function getEmployees(const AweekDay : TWeekEnum) : string;    function getEmployee: string;    begin      Result := Format('员工%d ', [FCurrEmployee]);      Inc(FCurrEmployee);      if FCurrEmployee > FEmployeeCount then        FCurrEmployee := 1;    end;  var    i: Integer;  begin    Result := '';    for i := 1 to weekArr[AweekDay] do      Result := Result + getEmployee;  end;var  i: Integer;  vWeekDay: TWeekEnum;  days : integer;begin  //当月天数  days := DaysInAMonth(2013, strtoint(cbb_Month.Text));  //当月第一天的星期起始数  vWeekDay := TWeekEnum(DayOfWeek(StrToDateTime('2013' + DateSeparator + cbb_Month.Text + DateSeparator + '01')) - 1);  //打印排班表  mmo1.Lines.BeginUpdate;  try    mmo1.clear;    for i := 1 to days do    begin      mmo1.Lines.Add(Format( '2013-%s-%d(星期%d), 值班员工:%s',        [cbb_Month.Text, i, Ord(vWeekDay), getEmployees(vWeekDay)]        ));      if vWeekDay = wkSaturday then        vWeekDay := wkSunday      else        vWeekDay := TWeekEnum(ord(vWeekDay) + 1);    end;  finally    mmo1.Lines.EndUpdate;  end;end;end.

窗体文件

object Form15: TForm15  Left = 0  Top = 0  Caption = 'Form15'  ClientHeight = 562  ClientWidth = 712  Color = clBtnFace  Font.Charset = DEFAULT_CHARSET  Font.Color = clWindowText  Font.Height = -12  Font.Name = 'Tahoma'  Font.Style = []  OldCreateOrder = False  OnCreate = FormCreate  PixelsPerInch = 106  TextHeight = 14  object mmo1: TMemo    Left = 216    Top = 72    Width = 481    Height = 482    Lines.Strings = (      'mmo1')    ScrollBars = ssBoth    TabOrder = 0  end  object cbb_Month: TComboBox    Left = 8    Top = 72    Width = 145    Height = 22    TabOrder = 1    OnChange = cbb_MonthChange  endend