obcalendar.pas

还是日历控件。现在网上的日历控件显示的时候都是单个月份。希望有人上传显示全年的！

{-----------------------------------------------------------------------------
 Unit Name: OBCalendar
 Author:    叶志聪
 Date:      15-五月-2004
 CopyRight: 东莞胜蓝软件有限公司版权所有，作者：叶志聪 [e-mail]
            未经作者同意，不得直接或间接用于商业用途。
 History:

 v1.0 2004-05-15
 ================
 正式发布第一版本，不过还未加入农历
-----------------------------------------------------------------------------}

unit OBCalendar;

interface

uses
  SysUtils, Classes, Controls, Grids, Forms, StdCtrls, Windows, Graphics, Math,
  Buttons, OBDragObject;

type
  TCalcStyles = (csWindows, csCool);
  TFillDirection = (fdTopToBottom, fdBottomToTop, fdLeftToRight, fdRightToLeft);

  TOBColorDef = class(TObject)
  public
    TitleFontColor : TColor;
    TitleFontStyle : TFontStyle;
    WeekBackGroupColorStart : TColor;
    WeekBackGroupColorEnd : TColor;
    NullDateBackColor : TColor;
    SelDateFillColorStart : TColor;
    SelDateFillColorEnd : TColor;
    SelDateFontColor : TColor;
  end;

  TOBDrawBuffer = class(TComponent)
  private
    FBuffer1 : array[0..48] of TBitmap;
    FBuffer2 : array[0..48] of TBitmap;    
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetBuffer(X, Y : Integer;Selected : Boolean) : TBitmap;
    procedure ResetAllBuffer;
    procedure ResetBuffer(X, Y : Integer;Selected : Boolean);
  end;

  TCustomDrawCellEvent = procedure(ACanvas : TCanvas;X, Y, Day : Integer;ARect : TRect;Selected : Boolean;var Handled : Boolean) of object;
  TOBCalendar = class(TWinControl)
  private
    ColorDef : TOBColorDef;
    DateGrid : TStringGrid;
    DateLabel : TLabel;
    BtnPriorMonth : TSpeedButton;
    BtnNextMonth : TSpeedButton;
    FCalcStyle: TCalcStyles;
    FDate: TDate;
    FDrawBuf : TOBDrawBuffer;
    FOnDateChanged : TNotifyEvent;
    FOnMonthChanged : TNotifyEvent;
    FAbout: String;
    FOnCustomDrawCell: TCustomDrawCellEvent;
    procedure SetCalcStyle(const Value: TCalcStyles);
    procedure GridDrawCell(Sender: TObject; ACol, ARow: Integer;Rect: TRect;
      State: TGridDrawState);
    procedure GridSelectCell(Sender: TObject; ACol,ARow: Integer;
      var CanSelect: Boolean);
    procedure GridDBClick(Sender: TObject);
    procedure GridMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure OnGridStartDrag(Sender: TObject;var DragObject: TDragObject);
    procedure BtnPriorMonthClick(Sender: TObject);
    procedure BtnNextMonthClick(Sender: TObject);
    procedure ReBuilderCalcContent;
    procedure SetDate(const Value: TDate);
    procedure SelToDayCell;
    function  GetCellText(X, Y : Integer) : String;
    procedure SetDragMode(const Value: TDragMode);
    function GetDragMode: TDragMode;
  protected
    procedure Resize; override;
    procedure PaintWindow(DC: HDC); override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure InvalidateCell(X,Y : Integer);
    procedure InvalidateDay(Day : Integer);
    procedure InvalidateAllCell;
    function GetDayFromXYMousePos(X, Y : Integer) : Integer;
  published
    property About : String read FAbout write FAbout;
    property Align;
    property Anchors;
    property BevelEdges;
    property BevelInner;
    property BevelKind;
    property BevelOuter;
    property BevelWidth;
    property CalcStyle : TCalcStyles read FCalcStyle write SetCalcStyle;
    property Date : TDate read FDate write SetDate;
    property DragCursor;
    property DragKind;
    property DragMode : TDragMode read GetDragMode write SetDragMode;
    property Font;
    property ShowHint;
    property Visible;
    property OnDateChanged : TNotifyEvent read FOnDateChanged write FOnDateChanged;
    property OnMonthChanged : TNotifyEvent read FOnMonthChanged write FOnMonthChanged;
    property OnCustomDrawCell : TCustomDrawCellEvent read FOnCustomDrawCell write FOnCustomDrawCell;
    property OnDblClick;
    property OnDockDrop;
    property OnDragDrop;
    property OnDockOver;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnStartDock;
    property OnStartDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnResize;
    property OnClick;
    property OnEnter;
    property OnExit;
  end;

procedure Register;

implementation

uses DateUtils;

procedure Register;
begin
  RegisterComponents('OBControl',[TOBCalendar]);
end;

{ TOBCalendar }

function WidthOf(R: TRect): Integer;
begin
  Result := R.Right - R.Left;
end;

function HeightOf(R: TRect): Integer;
begin
  Result := R.Bottom - R.Top;
end;

procedure GradientFillRect(Canvas: TCanvas; ARect: TRect; StartColor,
  EndColor: TColor; Direction: TFillDirection; Colors: Byte);
var
  StartRGB: array[0..2] of Byte;    { Start RGB values }
  RGBDelta: array[0..2] of Integer; { Difference between start and end RGB values }
  ColorBand: TRect;                 { Color band rectangular coordinates }
  I, Delta: Integer;
  Brush: HBrush;
begin
  if IsRectEmpty(ARect) then Exit;
  if Colors < 2 then begin
    Brush := CreateSolidBrush(ColorToRGB(StartColor));
    FillRect(Canvas.Handle, ARect, Brush);
    DeleteObject(Brush);
    Exit;
  end;
  StartColor := ColorToRGB(StartColor);
  EndColor := ColorToRGB(EndColor);
  case Direction of
    fdTopToBottom, fdLeftToRight: begin
      { Set the Red, Green and Blue colors }
      StartRGB[0] := GetRValue(StartColor);
      StartRGB[1] := GetGValue(StartColor);
      StartRGB[2] := GetBValue(StartColor);
      { Calculate the difference between begin and end RGB values }
      RGBDelta[0] := GetRValue(EndColor) - StartRGB[0];
      RGBDelta[1] := GetGValue(EndColor) - StartRGB[1];
      RGBDelta[2] := GetBValue(EndColor) - StartRGB[2];
    end;
    fdBottomToTop, fdRightToLeft: begin
      { Set the Red, Green and Blue colors }
      { Reverse of TopToBottom and LeftToRight directions }
      StartRGB[0] := GetRValue(EndColor);
      StartRGB[1] := GetGValue(EndColor);
      StartRGB[2] := GetBValue(EndColor);
      { Calculate the difference between begin and end RGB values }
      { Reverse of TopToBottom and LeftToRight directions }
      RGBDelta[0] := GetRValue(StartColor) - StartRGB[0];
      RGBDelta[1] := GetGValue(StartColor) - StartRGB[1];
      RGBDelta[2] := GetBValue(StartColor) - StartRGB[2];
    end;
  end; {case}
  { Calculate the color band's coordinates }
  ColorBand := ARect;
  if Direction in [fdTopToBottom, fdBottomToTop] then begin
    Colors := Max(2, Min(Colors, HeightOf(ARect)));
    Delta := HeightOf(ARect) div Colors;
  end
  else begin
    Colors := Max(2, Min(Colors, WidthOf(ARect)));
    Delta := WidthOf(ARect) div Colors;
  end;
  with Canvas.Pen do begin { Set the pen style and mode }
    Style := psSolid;
    Mode := pmCopy;
  end;
  { Perform the fill }
  if Delta > 0 then begin
    for I := 0 to Colors do begin
      case Direction of
        { Calculate the color band's top and bottom coordinates }
        fdTopToBottom, fdBottomToTop: begin
          ColorBand.Top := ARect.Top + I * Delta;
          ColorBand.Bottom := ColorBand.Top + Delta;
        end;
        { Calculate the color band's left and right coordinates }
        fdLeftToRight, fdRightToLeft: begin
          ColorBand.Left := ARect.Left + I * Delta;
          ColorBand.Right := ColorBand.Left + Delta;
        end;
      end; {case}
      { Calculate the color band's color }
      Brush := CreateSolidBrush(RGB(
        StartRGB[0] + MulDiv(I, RGBDelta[0], Colors - 1),
        StartRGB[1] + MulDiv(I, RGBDelta[1], Colors - 1),
        StartRGB[2] + MulDiv(I, RGBDelta[2], Colors - 1)));
      FillRect(Canvas.Handle, ColorBand, Brush);
      DeleteObject(Brush);
    end;
  end;
  if Direction in [fdTopToBottom, fdBottomToTop] then
    Delta := HeightOf(ARect) mod Colors
  else Delta := WidthOf(ARect) mod Colors;
  if Delta > 0 then begin
    case Direction of
      { Calculate the color band's top and bottom coordinates }
      fdTopToBottom, fdBottomToTop: begin
        ColorBand.Top := ARect.Bottom - Delta;
        ColorBand.Bottom := ColorBand.Top + Delta;
      end;
      { Calculate the color band's left and right coordinates }
      fdLeftToRight, fdRightToLeft: begin
        ColorBand.Left := ARect.Right - Delta;
        ColorBand.Right := ColorBand.Left + Delta;
      end;
    end; {case}
    case Direction of
      fdTopToBottom, fdLeftToRight:
        Brush := CreateSolidBrush(EndColor);
      else {fdBottomToTop, fdRightToLeft }
        Brush := CreateSolidBrush(StartColor);
    end;
    FillRect(Canvas.Handle, ColorBand, Brush);
    DeleteObject(Brush);
  end;
end;

procedure TOBCalendar.BtnNextMonthClick(Sender: TObject);
begin
  FDate := IncMonth(FDate);
  ReBuilderCalcContent;
  FDrawBuf.ResetAllBuffer;
  SelToDayCell;
  DateLabel.Caption := FormatDateTime('YYYY''年''MM''月''',FDate);

  if Assigned(FOnMonthChanged) then FOnMonthChanged(Self);
end;

procedure TOBCalendar.BtnPriorMonthClick(Sender: TObject);
begin
  FDate := IncMonth(FDate,-1);
  ReBuilderCalcContent;
  FDrawBuf.ResetAllBuffer;
  SelToDayCell;
  DateLabel.Caption := FormatDateTime('YYYY''年''MM''月''',FDate);

  if Assigned(FOnMonthChanged) then FOnMonthChanged(Self);
end;

constructor TOBCalendar.Create(AOwner: TComponent);
begin
  inherited;
  ColorDef := nil;
  ColorDef := TOBColorDef.Create;

  FDrawBuf := nil;
  FDrawBuf := TOBDrawBuffer.Create(Self);

  DateGrid := nil;
  DateGrid := TStringGrid.Create(Self);
  with DateGrid do
  begin
    Parent := Self;
    Left := 0;
    Top := 30;
    BorderStyle := bsNone;
    FixedCols := 0;
    FixedRows := 0;
    ScrollBars := ssNone;
    RowCount := 7;
    ColCount := 7;
    Options := [goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine];
    DefaultDrawing := False;
    OnDrawCell := GridDrawCell;
    OnSelectCell := GridSelectCell;
    OnStartDrag := OnGridStartDrag;
    OnDragOver := Self.OnDragOver;
    OnMouseDown := Self.OnMouseDown;
    OnMouseMove := GridMouseMove;
    OnDblClick := GridDBClick;
  end;

  DateLabel := nil;
  DateLabel := TLabel.Create(Self);
  with DateLabel do
  begin
    Parent := Self;
    AutoSize := False;
    Alignment := taCenter;
    Left := 10;
    Top := 8;
    Font.Style := [fsBold];
    Transparent := True;
    DateLabel.Caption := FormatDateTime('YYYY''年''MM''月''',SysUtils.Date());
  end;

  BtnPriorMonth := nil;
  BtnNextMonth := nil;
  if not (csDesigning in ComponentState) then
  begin
    BtnPriorMonth := TSpeedButton.Create(Self);
    with BtnPriorMonth do
    begin
      BtnPriorMonth.Parent := Self;
      BtnPriorMonth.Left := 0;
      BtnPriorMonth.Top := 2;
      BtnPriorMonth.Width := 15;
      BtnPriorMonth.Height := 26;
      BtnPriorMonth.Caption := '3';
      BtnPriorMonth.Font.Charset := SYMBOL_CHARSET;
      BtnPriorMonth.Font.Name := 'Marlett';
      BtnPriorMonth.Font.Size := 9;
      BtnPriorMonth.Font.Style := [];
      BtnPriorMonth.Flat := True;
      BtnPriorMonth.Hint := '显示上月';
      BtnPriorMonth.ShowHint := True;
      OnClick := BtnPriorMonthClick;
    end;

    BtnNextMonth := TSpeedButton.Create(Self);
    with BtnNextMonth do
    begin
      BtnNextMonth.Parent := Self;
      BtnNextMonth.Left := Self.Width - 30;
      BtnNextMonth.Top := 2;
      BtnNextMonth.Width := 15;
      BtnNextMonth.Height := 26;
      BtnNextMonth.Caption := '4';
      BtnNextMonth.Font.Charset := SYMBOL_CHARSET;
      BtnNextMonth.Font.Name := 'Marlett';
      BtnNextMonth.Font.Size := 9;
      BtnNextMonth.Font.Style := [];
      BtnNextMonth.Flat := True;
      BtnNextMonth.Hint := '显示下月';
      BtnNextMonth.ShowHint := True;
      BtnNextMonth.OnClick := BtnNextMonthClick;
    end;
  end;

  BevelKind := bkFlat;
  CalcStyle := csWindows;
  Width := 329;
  Height := 225;
  FDate := SysUtils.Date();
  ReBuilderCalcContent;
end;

destructor TOBCalendar.Destroy;
begin
  FreeAndNil(DateGrid);
  FreeAndNil(ColorDef);
  FreeAndNil(FDrawBuf);
  FreeAndNil(DateLabel);
  FreeAndNil(BtnPriorMonth);
  FreeAndNil(BtnNextMonth);
  inherited;
end;