utaskchart.pas

DELPHI 一个可以实现排期的控件 显示排期

{********************************************
作者: 张浩然
时间: 2004-05-13
********************************************}
unit UTaskChart;

interface

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, Buttons, ComCtrls, ExtCtrls ;


type

//组件编辑器
{_______________________________________________________________________________}
  { TSampleEditor = class (TComponentEditor)

   private
   //   procedure SayHello;virtual;
   public

   end;    }


//显示三D日期
{_______________________________________________________________________________}
  TSolidLabel = class(TLabel)

  private
     { Private declarations }
    procedure Draw3dText(R: TRect);
  protected
     { Protected declarations }
    procedure paint; override;
  public
     { Public declarations }
  published
     { Published declarations }

  end;


//时间条
{_______________________________________________________________________________}


    TlstTimeBar = class(TList)
    private

      lstLabDate:TList;        //显示每天日期指针链
      //所在容器
      Parent: TWinControl;
      //时间条的面板
      TimePanel: TPanel;
      //记录开始结束时间
      StartDate, EndDate: TDateTime;
      //上一次画完刻度的位置
      iPreLeft:Integer;
      //正在画的一年
      iCurYear:Integer;
      //第一次开刻度标志
      bStartFlag:bool;
 
        { Private declarations }
      //生成放时间刻度的面板
      procedure NewTimePanel();
      //画一天的刻度
      procedure DrawDay(day,month:Integer;sbDatePanel:TWinControl);
      //画一月的刻度
      procedure DrawMonth(startDay,endDay,month:Integer;sbDatePanel:TWinControl);
      //画一天具体日期
      procedure DrawDateLabel(day,month:Integer;sbDatePanel:TWinControl);
      //画最后个条长线
      procedure DrawEndBar(sbDatePanel:TWinControl);
      //获取一个月的总天数
      function getDayCount(month,year:Integer):Integer;

      //设定间距倍数
      procedure setSpaceIncreaseVal(InceaseVal:Integer);
      //设定时间刻度起始位置
      procedure setStartLeftVal(LeftVal:Integer);
      //按开始时间返回坐标值
      function GetValueByTime(dDate: TDateTime):Integer;
      //按坐标值返回时间
      function GetTimeByValue(Value: Integer):TDateTime;
    published

    public
      scrbMother: TScrollBox;
      //清空时间刻度指针(bevel)和日期指针(label)
      procedure ClearPointerList();

    constructor Create(); overload;
    destructor  Destroy;  overload;
      //设定显示宽度
      procedure AutoSizeScale(p:TPanel);

    //返回每小时任务所对应当前时间刻度的长度
    function getLendthByHour(dHour:Double):Integer;
    //显示任务时间刻度
    procedure ShowDateScale(StartDate,EndDate:TDateTime;sbDatePanel:TScrollBox;iScale:Integer);
end;


 {____TShapeType___________________________________________________________}

  TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
    stEllipse, stCircle,stMyShape);

  TTaskShape = class(TControl)//  TControl)//   TWinControl) //
  private

    FCanvas: TCanvas;
    FCaption: TCaption;
    FParent: TWinControl;
    FPen: TPen;
    FBrush: TBrush;
    //显示图形
    FShape: TShapeType;

    FActionLink: TControlActionLink ;
    OldColor: TColor;



    //设置并显示Caption
    procedure  SetText(const Value: TCaption);
    procedure SetBrush(Value: TBrush);
    procedure SetPen(Value: TPen);
    procedure WMPaint(var Message: TWMPaint);  message WM_PAINT;

    //设置显示形状
    procedure SetShape(Value: TShapeType);
    //设置颜色
    procedure SetColor(Value: TColor);
    //获取颜色
    function GetColor(): TColor  ;
    //设置边框颜色
    procedure SetBorderColor(Value: TColor);
    //获取边框颜色
    function GetBorderColor(): TColor;
    property  Brush: TBrush read FBrush write SetBrush;
    property  Pen:   TPen   read FPen   write SetPen;


  protected
    property  Canvas : TCanvas read FCanvas;
    //画出图形及Caption
    procedure Paint;    // override;
    procedure StyleChanged(Sender: TObject);
    property  ActionLink: TControlActionLink read FActionLink write FActionLink;
    property  Align;
    property  Anchors;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnStartDock;
    property OnStartDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    
  public


    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  //  property    Parent: TWinControl read FParent write SetParent;
  published

    property  BorderColor  : TColor read GetBorderColor write SetBorderColor;
    property  Caption      : TCaption read FCaption write SetText ;  //stored IsCaptionStored;
    property  Color        : TColor read   GetColor write SetColor;



    property Constraints;
    property ParentShowHint;

    property Shape: TShapeType read FShape write SetShape default stRoundRect;
    property ShowHint;
    property Visible;



    property PopupMenu;  
 
  end;


{____ TTask ___________________________________________________________}

   //任务数据状态
   TDataStatus= (dsAdd, dsUpdate, dsDelete, dsNone);

   //任务运行状态
   TTaskStatus = (tsRunning, tsNone);

   TTask = class(TTaskShape)//)  TPanel

   private
       //所在机器名称,  状态
       FMachineName,  FStatus:String;
       //任务开始时间,结束时间
       FBeginTime, FEndTime: TDateTime;
       //重量, 数量 ,时间数(小时)
       FWeight, FQuantity ,FValue: Double;
       //caption
       FCaption: String;
       //PopupMenu
       FPopupMenu: TPopupMenu;
       //任务数据状态
       FDataStatus: TDataStatus;
       //任务运行状态
       FTaskStatus: TTaskStatus;
       //原始机器名称
       OldMachineName : string;
       //原始开始时间,结束时间
       OldBeginTime, OldEndTime: TDateTime;
       //获取任务数据状态是否为新添
       function  getTaskIsNew():boolean;
       //设置任务数据状态为新添
       procedure SetTaskIsNew(Value: Boolean);

       procedure setTaskName(taskName:String);
       //返回任务所在的机器名称
       function GetMachineNameByTask(Value: TTask):String;
       //返回任务时间(结束时间减开始时间,单位小时)
       function   getTaskValue():Double;
       //设置任务时间
       procedure setTaskValue(Value: Double);
   protected

   public

 
        //覆盖构造函数
      constructor Create(AOwner: TComponent); override ;
       //析构函数
      destructor  Destroy;  override;
   published
      //边框色
   //   property  BorderColor   ;
      //底色
   //   property  Color         ;
      property  Caption;
      //机器名称
      property MachineName: String  read FMachineName write FMachineName ;
      //状态
      property TaskStatus:  TTaskStatus  read FTaskStatus write FTaskStatus ;
      //开始时间
      property BeginTime:   TDateTime  read FBeginTime write FBeginTime ;
      //结束时间
      property EndTime:     TDateTime  read FEndTime write FEndTime ;
      //任务时间(小时)
      property Value: Double read getTaskValue write setTaskValue;
      //重量
      property Weight:      Double  read FWeight write FWeight ;
      //数量
      property Quantity:    Double  read FQuantity write FQuantity ;
      //新任务(外部接口)
      property IsNew:       Boolean read getTaskIsNew write setTaskIsNew default false;
       //任务状态
      property DataStatus:  TDataStatus read FDataStatus write FDataStatus;

end;


{___ TMachine ______________________________________________________________________}
     TMachine = class(TCustomControl)

     private
        //显示机器名称的控件
        NameControl: TWinControl;

        //最早任务开始时间,最迟任务结束时间
        FBeginTime, FEndTime: TDateTime;
        //任务间隔时间
        FSetTime: Double;
        //返回任务数量
        function GetTaskCount():Integer;
        //返回任务对象
        function GetTask(Index: Integer): TTask;
        //设置任务间隔时间(单位: 小时)
        procedure SetSpaceTime(Value: Double);



    protected
       procedure Paint(); override;



    //del   property Alignment;
       property Anchors;
       property AutoSize;
       property BevelInner;
       property BevelOuter;
       property BevelWidth;
       property BiDiMode;
       property BorderWidth;
    //del   property BorderStyle;
       property Caption;
       property Canvas;
       property Constraints;
       property Ctl3D;
       property UseDockManager default True;
       property DockSite;
       property DragCursor;
       property DragKind;
       property DragMode;
       property Enabled;
       property Height;
     //del  property FullRepaint;
       property Font;
     //del  property Locked;
       property ParentBiDiMode;
       property ParentColor;
       property ParentCtl3D;
       property ParentFont;
       property ParentShowHint;


       property TabOrder;
       property TabStop;
       property Visible;
       property OnCanResize;
       property OnClick;
       property OnConstrainedResize;
       property OnContextPopup;
       property OnDockDrop;
       property OnDockOver;
       property OnDblClick;
       property OnDragDrop;
       property OnDragOver;
       property OnEndDock;
       property OnEndDrag;
       property OnEnter;
       property OnExit;
       property OnGetSiteInfo;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;
       property OnResize;
       property OnStartDock;
       property OnStartDrag;
       property OnUnDock;

     public

        constructor Create(AOwner: TComponent); override;
        //按任务名称返回任务对象
        function FindTakByName(TaskName: String):TTask;
        property Items[Index: Integer]: TTask read GetTask;   //数组只能放在public

     published

        property Align;
        //背景色
        property Color;
        //任务数量
        property  Count: Integer read GetTaskCount;
        //开始时间
        property BeginTime: TDateTime  read FBeginTime write FBeginTime ;
       //结束时间
        property EndTime: TDateTime  read FEndTime write FEndTime ;
        //任务间隔时间
        property SetTime: Double read FSetTime write SetSpaceTime;

        property ShowHint;
        property PopupMenu;

end;

{____ TTimeBar _____________________________________________________________________}

    TTimeBar = class(TBevel)
    private
        ptyDateTime  :TDateTime;
    protected