var frm_Calendar: Tfrm_Calendar; cbblist: TComboBox; cbbPanel: TPanel;
implementation
uses DateUtils;
{$R *.dfm} procedure Tfrm_Calendar.sbtbtn1Click(Sender: TObject); var Col,Row:Integer; Year,Month,Day,Week,DysOfMn:Word; begin
Year := Round(edt_Year.Value); for Col := 1 to 12 do begin DysOfMn := DaysInMonth(StrToDate(IntToStr(Year) + '-' + IntToStr(Col) + '-01' )); for Row := 1 to 31 do begin Month := Col; Day := Row; if Row > DysOfMn then begin sgd_Cd.Cells[Col,Row] := ''; Continue; end;
if IsValidDate(year,Month,Day) then begin Week := DayOfTheWeek(StrToDate(IntToStr(Year) + '-' + IntToStr(Month) + '-' + IntToStr(Day))); cbblist.ItemIndex := Week - 1; sgd_Cd.Cells[Col,Row] := cbblist.Items[Week - 1]; end; end; end; end;
procedure Tfrm_Calendar.sbtbtn3Click(Sender: TObject); begin close; end;
procedure Tfrm_Calendar.FormCreate(Sender: TObject); var Rect :TRect; Col,Row:Integer; CRPanle:TPanel; begin Self.DoubleBuffered := True;
sgd_Cd.Cells[0,0] := ' 日';
for Col := 1 to 12 DO begin sgd_Cd.Cells[Col,0] := ' '+ IntToStr(Col) + '月'; end;
for Row := 1 to 31 DO begin sgd_Cd.Cells[0,Row] := ' 第' + IntToStr(Row) + '日' ; end;
//这里仅仅需要改变Cell的值,就会在DrawCell中发现变化,并执行相应改变 procedure Tfrm_Calendar.cbb1Change(Sender: TObject); var Tex : String; begin Tex := cbblist.Text; if Trim(sgd_Cd.Cells[sgd_Cd.Col,sgd_Cd.Row]) = '' then Exit; sgd_Cd.Cells[sgd_Cd.Col,sgd_Cd.Row] := Tex; end;
//该事件是由Timer驱动的不停扫描的,所以该事件一旦定义就会不断执行,当扫描到符合判断条件执行响应代码 procedure Tfrm_Calendar.sgd_CdDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin if (ACol = 0) and (ARow = 0) then Exit; if gdFixed in State then Exit;
With TStringGrid(Sender) do begin if (TStringGrid(Sender).Cells[ACol,ARow] = '周六') or (TStringGrid(Sender).Cells[ACol,ARow] = '周日') then begin Canvas.Brush.Color :=clYellow;// ClBlue; Canvas.FillRect(Rect); Canvas.font.color:=clRed; Canvas.TextOut(rect.left + 5 , rect.top + 5 , cells[acol, arow]); end else begin Canvas.Brush.Color :=clWindow; Canvas.FillRect(Rect); Canvas.font.color:=ClBlack; Canvas.TextOut(rect.left + 5 , rect.top + 5, cells[acol, arow]); end; end;
end;
//该事件是在Cell选择时,触发的 procedure Tfrm_Calendar.sgd_CdSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); var Rect :TRect; begin Rect:= sgd_Cd.CellRect(ACol,ARow); cbbPanel.Left := rect.Left; cbbPanel.Top := rect.Top; cbbPanel.Width := Rect.Right - Rect.Left; cbbPanel.Height := Rect.Bottom - Rect.Top; cbbPanel.Visible := True; end;