atimectl.pas

来自「delphi编程控件」· PAS 代码 · 共 747 行 · 第 1/2 页

unit atimectl;
(*
 COPYRIGHT (c) RSD Software 1997 - 98
 All Rights Reserved.
*)

{$I aclver.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Mask, Buttons, ComCtrls, CommCtrl;

type
  TCustomAutoTimeControl = class(TCustomControl)
  private
    FTime: TDateTime;
    FTrackBar: TTrackBar;
    FOnHide: TNotifyEvent;
    FOnTimeChange: TNotifyEvent;

    function GetHeight: Integer;
    function GetTabStop: Boolean;
    procedure SetTabStop(Value: Boolean);
    procedure SetTime(Value: TDateTime);

    procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMMouseActivate(var Message: TWMMouseActivate);
      message WM_MOUSEACTIVATE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoTimeChange; dynamic;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
    procedure SetParent(AParent: TWinControl); override;
    procedure SetSize;
  public
    IsPopup: Boolean;
    constructor Create(AOwner: TComponent); override;
    procedure Hide;
    procedure Show;
    property TabStop: Boolean read GetTabStop write SetTabStop;
    property Time: TDateTime read FTime write SetTime;
    property OnHide: TNotifyEvent read FOnHide write FOnHide;
    property OnTimeChange: TNotifyEvent read FOnTimeChange write FOnTimeChange;
  end;

  TAutoTimeControl = class(TCustomAutoTimeControl)
  published
    property Align;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Time;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnHide;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnTimeChange;
  end;

  TEditingPlace = (epError, epHour, epMin, epSec);

  TCustomAutoTimeEdit = class(TCustomMaskEdit)
  private
    DropDownButton: TSpeedButton;
    FDropDownWidth: Integer;
    FOnTimeChange: TNotifyEvent;
    function GetTime: TDateTime;
    procedure SetTime(Value: TDateTime);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoTimeChange; dynamic;
    function EditingPlace: TEditingPlace;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    property OnTimeChange: TNotifyEvent read FOnTimeChange write FOnTimeChange;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property Time: TDateTime read GetTime write SetTime;
    property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth;
  end;

  TAutoTimeEdit = class(TCustomAutoTimeEdit)
  published
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property DropDownWidth;
    property Enabled;
    property Font;
  {$IFDEF DELPHI3_0}
    property ImeMode;
    property ImeName;
  {$ENDIF}
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Time;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnTimeChange;
  end;

var
  TimeFormat: string;

implementation

const
  MinutesPerDay = 24 * 60;
  SecondsPerDay = MinutesPerDay * 60;
  SecondsPerHour = 60 * 60;

procedure DecodeSeconds(Seconds: Integer; var Hour, Min, Sec: Word);
begin
  Sec := Seconds mod 60;
  Min := Seconds mod SecondsPerHour div 60;
  Hour := Seconds div SecondsPerHour;
end;

function EncodeSeconds(Hour, Min, Sec: Word): Integer;
begin
  Result := SecondsPerHour * Hour + 60 * Min + Sec;
end;

{ TTimeTrackBar }

type
  TTimeTrackBar = class(TTrackBar)
  private
    procedure TrackBarChange(Sender: TObject);
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

constructor TTimeTrackBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alBottom;
  Color := clBtnFace;
  Height := 30;
  Min := 0;
  Max := SecondsPerDay - 1;
  LineSize := 60;
  PageSize := 60 * 60;
  Frequency := PageSize;
  OnChange := TrackBarChange;
end;

procedure TTimeTrackBar.TrackBarChange(Sender: TObject);
var
  Hour, Min, Sec: Word;
begin
  DecodeSeconds(Position, Hour, Min, Sec);
  Sec := 0;
  TCustomAutoTimeControl(Parent).Time := EncodeTime(Hour, Min, Sec, 0);
end;

procedure TTimeTrackBar.WMLButtonUp(var Message: TWMLButtonUp);
begin
  inherited;
  with TCustomAutoTimeControl(Parent) do
    if IsPopup then Hide;
end;

procedure TTimeTrackBar.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  with TCustomAutoTimeControl(Parent) do
    if IsPopup and ((Key = VK_ESCAPE) or (Key = VK_RETURN)) then Hide;
end;

{ TCustomAutoTimeControl }

constructor TCustomAutoTimeControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 165;
  inherited TabStop := False;
  FTrackBar := TTimeTrackBar.Create(Self);
  FTrackBar.Parent := Self;
  Time := SysUtils.Time;
end;

function TCustomAutoTimeControl.GetHeight: Integer;
begin
  Result := Width + FTrackBar.Height;
end;

function TCustomAutoTimeControl.GetTabStop: Boolean;
begin
  Result := FTrackBar.TabStop;
end;

procedure TCustomAutoTimeControl.SetTabStop(Value: Boolean);
begin
  FTrackBar.TabStop := Value;
end;

procedure TCustomAutoTimeControl.SetTime(Value: TDateTime);
var
  Hour, Min, Sec, MSec: Word;
begin
  if FTime <> Value then
  begin
    FTime := Value;
    DecodeTime(FTime, Hour, Min, Sec, MSec);
    FTrackBar.Position := SecondsPerHour * Hour + 60 * Min { + Sec};
    Invalidate;
    DoTimeChange;
  end;
end;

procedure TCustomAutoTimeControl.WMActivate(var Message: TWMActivate);
begin
  inherited;
  if IsPopup and (Message.Active = WA_INACTIVE) then Hide;
end;

procedure TCustomAutoTimeControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TCustomAutoTimeControl.WMMouseActivate(var Message: TWMMouseActivate);
begin
  inherited;
  if not (csDesigning in ComponentState) then
    if IsPopup then Message.Result := MA_NOACTIVATE
    else
      if Message.Result = MA_ACTIVATE then SetFocus;
end;

procedure TCustomAutoTimeControl.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  Windows.SetFocus(FTrackBar.Handle);
end;

procedure TCustomAutoTimeControl.WMSize(var Message: TWMSize);
begin
  inherited;
  Height := GetHeight;
end;

procedure TCustomAutoTimeControl.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if IsPopup then
    begin
      Style := WS_BORDER or WS_CLIPCHILDREN or WS_POPUP;
      ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
    end
    else
    begin
      Style := Style and not WS_TABSTOP or WS_CLIPCHILDREN;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
    WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  end;
end;

procedure TCustomAutoTimeControl.DoTimeChange;
begin
  if Assigned(FOnTimeChange) then FOnTimeChange(Self);
end;

procedure TCustomAutoTimeControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if IsPopup then Hide;
end;

procedure TCustomAutoTimeControl.Paint;
var
  CX, CY: Integer;
  Radius: Extended;
  Bitmap: TBitmap;

  procedure FromPolarToCartesian(Alpha, Radius: Extended; var X, Y: Longint);
  begin
    X := Round(CX + Radius * Cos(Alpha));
    Y := Round(CY - Radius * Sin(Alpha));
  end;

  procedure DrawFace;
  var
    I, X, Y: Longint;
    Alpha: Extended;
    R: TRect;
    IsUp: Boolean;
  begin
    with Bitmap.Canvas do
    begin
      for I := 0 to 59 do
      begin
        Alpha := Pi/2 - I / 30 * Pi;
        FromPolarToCartesian(Alpha, Radius, X, Y);
        SetRect(R, X - 1, Y - 1, X + 1{2}, Y + 1{2});
        IsUp := (I mod 5 = 0);
        if IsUp then InflateRect(R, 1, 1);
        with R do
        begin
          if IsUp then Pen.Color := clAqua
          else Pen.Color := clBtnShadow;
          MoveTo(Left, Bottom);
          LineTo(Left, Top);
          LineTo(Right, Top);
          if IsUp then Pen.Color := clBlack
          else Pen.Color := clWhite;
          LineTo(Right, Bottom);
          LineTo(Left, Bottom);
          if IsUp then
          begin
            Brush.Color := clTeal;
            Inc(Left);
            Inc(Top);
            FillRect(R);
          end
          else
          begin