licjdate.pas

关于日期类型的应用的组件,可以很好的设置日期的

unit licjDate;
{*******************************************************
项目名称:浦东邮件处理中心信息系统
作者: 李成军
MAIL:[e-mail]
创建日期:2004-3-10
描述: 好多日期控件不好用,于是自己写一个吧.

更新列表:
日期　    作者　　描述
04-3-13    licj   Add 格式化显示


TODO:
1.运行后,SPEEDBUTTON的图标有时候不能刷新.
2.text现在为只读,要不要可以修改?
*******************************************************}
interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls,Buttons,
  Dialogs,Graphics;

type
  TLCalendar = class(TEdit)
  private
    FDate: TdateTime;
    SB:TspeedButton;
    FSbCaption: string;
    FSbGlyph: Tbitmap;
    FCanvas:TCanvas;
    FDisplayFormat: string;
    procedure SetDate(const Value: TdateTime);
    procedure SetText(sender:Tobject);
    procedure SBclick(sender:Tobject);
    procedure SetSbCaption(const Value: string);
    procedure SetSbGlyph(const Value: Tbitmap);
    procedure SetDisplayFormat(const Value: string);
    { Private declarations }
  protected
  public
    procedure clear; override;
    procedure wmpaint(var Message: Twmpaint); message wm_paint;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;//Self.Text变化时引发的消息.
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property SbCaption:string read FSbCaption write SetSbCaption;
    property SbGlyph:Tbitmap  read FSbGlyph write SetSbGlyph;
    property DisplayFormat:string read FDisplayFormat write SetDisplayFormat;
    property Date:TdateTime read FDate write SetDate;
  end;

procedure Register;

implementation

uses myCalendar;

procedure Register;
begin
  RegisterComponents('Samples', [TLCalendar]);
end;


procedure TLCalendar.clear;
begin
  self.Date :=-1;
  self.Text :='';
end;

constructor TLCalendar.Create(AOwner: TComponent);
var
  TodayStr:string;
begin
  inherited Create(AOwner);
  FSbGlyph:=TbitMap.Create ;
  FCanvas:=TCanvas.Create ;

  //原来SETDATE(DATE);此DATE(今天)与DATE(属性)冲突!
  TodayStr:=FormatDatetime('yyyy-mm-dd',now);
  SetDate(strtodate(TodayStr));
  sb:=Tspeedbutton.Create(self);
  sb.Parent :=self;
  sb.Caption :='';
  sb.Top :=self.Top ;
  sb.Width :=16 ;
  sb.Align :=AlRight;
  SB.OnClick :=SBclick;
  sb.Cursor :=crHandPoint;

  //self.ReadOnly :=true;
  self.OnDblClick :=SBclick;
  //Fonchange:=self.OnChange;
  
end;

destructor TLCalendar.Destroy;
begin
  FCanvas.Free;
  if sb<>nil then
  sb.free;
  inherited;
end;

procedure TLCalendar.SBclick(sender: Tobject);
begin
  SetDate(GetDate(self.date));
  self.SetFocus;
end;

procedure TLCalendar.SetDate(const Value: TdateTime);
begin
  FDate := Value;
  if Value=-1 then
  begin
    clear;
    exit;
  end;
  if FDisplayFormat='' then
    Self.Text :=datetostr(FDate)
  else
    try
      Self.Text :=FormatDatetime(FdisplayFormat,Fdate);
    except
      ShowMessage('请输入有效的显示格式！');
    end;
end;

procedure TLCalendar.SetSbGlyph(const Value: Tbitmap);
var
  Glyphs: Integer;
begin
  Invalidate;
  FsbGlyph.Assign(Value);
  if (Value <> nil) and (Value.Height > 0) then
  begin
    if Value.Width mod Value.Height = 0 then
    begin
      Glyphs := Value.Width div Value.Height;
      if Glyphs > 4 then Glyphs := 1;
      SB.NumGlyphs :=Glyphs;
    end;
  end;

  sb.Glyph.Assign(FsbGlyph);
end;

procedure TLCalendar.SetSbCaption(const Value: string);
begin
  FsbCaption:=value;
  sb.Caption :=FsbCaption;
end;

procedure TLCalendar.wmpaint(var Message: Twmpaint);
var
  Glyphs: Integer;
begin
  sb.Glyph:=nil;
  Glyphs:=2;
  if FsbGlyph.Height<>0 then
    Glyphs := FsbGlyph.Width div FsbGlyph.Height;
  if Glyphs > 4 then Glyphs := 1;
  sb.NumGlyphs :=Glyphs;
  sb.Glyph.Assign(FsbGlyph); 
  inherited ;
end;

procedure TLCalendar.SetText(sender:Tobject);
begin
  try
    if self.Text='' then exit;
    Date:=strtodate(self.Text);
  except
    showMessage('请输入有效日期格式!');
    self.SetFocus ;
  end;
end;


procedure TLCalendar.CNCommand(var Message: TWMCommand);
begin
  if not (Message.NotifyCode = EN_CHANGE) then
    exit;
  inherited change;

  //SetText(self);
end;

procedure TLCalendar.SetDisplayFormat(const Value: string);
begin
  FDisplayFormat := Value;
end;

end.