atimectl.pas

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

            Pixels[Left, Bottom] := clBtnFace;
            Pixels[Right, Top] := clBtnFace;
          end;
        end;
      end;
    end;
  end;

  procedure DrawArrows;
  var
    Hour, Min, Sec, MSec: Word;
    X, Y: Longint;
    Alpha: Extended;

    procedure DrawArrow(Alpha, Radius, Thickness: Extended;
      IsShadow: Boolean; Altitude: Integer);
    const
      Colors: array[Boolean] of TColor = (clTeal, clBtnHighlight);
    var
      FirstPart: Boolean;
      P: array[1..4] of TPoint;
      I: Byte;
    begin
      FirstPart := (Alpha <= -5/4 * Pi) or (Alpha >= -1/4 * Pi);
      with Bitmap.Canvas do
      begin
        FromPolarToCartesian(Alpha + Pi, 0.2 * Radius, P[1].X, P[1].Y);
        FromPolarToCartesian(Alpha + Pi/2, Thickness / 2 * Radius, P[2].X, P[2].Y);
        FromPolarToCartesian(Alpha, 0.8 * Radius, P[3].X, P[3].Y);
        P[4] := Point(CX, CY - 2);
        if IsShadow then
        begin
          for I := 1 to 3 do
          begin
            Inc(P[I].X, Altitude);
            Inc(P[I].Y, Altitude);
          end;
          Brush.Color := clBtnShadow;
        end
        else Brush.Color := Colors[FirstPart];
        Pen.Color := Brush.Color;
        Polygon(P);
        FromPolarToCartesian(Alpha - Pi/2, Thickness / 2 * Radius, P[2].X, P[2].Y);
        if IsShadow then
        begin
          Inc(P[2].X, Altitude);
          Inc(P[2].Y, Altitude);
        end;
        if not IsShadow then Brush.Color := Colors[not FirstPart];
        Pen.Color := Brush.Color;
        Polygon(P);
      end;
    end;

  begin
    DecodeTime(Time, Hour, Min, Sec, MSec);
    with Bitmap.Canvas do
    begin
      { second arrow }
      Alpha := Pi/2 - Sec / 30 * Pi;
      FromPolarToCartesian(Alpha, 0.85 * Radius, X, Y);
      Pen.Color := clBlack;
      MoveTo(CX, CY);
      LineTo(X, Y);
      { minute arrow }
      Alpha := Pi/2 - (Min + Sec / 60) / 30 * Pi;
      DrawArrow(Alpha, Radius, 0.1, True, 2);
      DrawArrow(Alpha, Radius, 0.1, False, 2);
      { hour arrow }
      Alpha := Pi/2 - (Hour + Min / 60 + Sec / SecondsPerHour) / 6 * Pi;
      if Alpha <= -2 * Pi then Alpha := Alpha + 2 * Pi;
      DrawArrow(Alpha, 0.8 * Radius, 0.18, True, 3);
      DrawArrow(Alpha, 0.8 * Radius, 0.18, False, 3);
    end;
  end;

  procedure DrawElectronClock;
  var
    TimeStr: string;
    Extent: TSize;
    R: TRect;
  begin
    TimeStr := TimeToStr(Time);
    if TimeStr[2] = TimeSeparator then TimeStr := '0' + TimeStr;
    with Bitmap.Canvas do
    begin
      GetTextExtentPoint(Handle, PChar(TimeStr), Length(TimeStr), Extent);
      SetRect(R, 0, 0, Extent.cX, Extent.cY);
      OffsetRect(R, (ClientWidth - Extent.cX) div 2,
        CY + (CY - Extent.cY) div 2);
      InflateRect(R, 3, 1);
      Brush.Color := clWindow;
      Font.Color := clWindowText;
      FillRect(R);
      DrawText(Handle, PChar(TimeStr), Length(TimeStr), R,
        DT_CENTER or DT_SINGLELINE or DT_VCENTER);
      InflateRect(R, 2, 2);
      DrawEdge(Handle, R, EDGE_SUNKEN, BF_RECT);
    end;
  end;

begin
  inherited Paint;
  CX := ClientWidth div 2;
  CY := CX;
  Radius := Round(0.8 * CX);
  Bitmap := TBitmap.Create;
  Bitmap.Width := ClientWidth;
  Bitmap.Height := ClientHeight;
  with Bitmap.Canvas do
  begin
    Font := Self.Font;
    Brush.Color := clBtnFace;
    FillRect(ClientRect);
  end;
  DrawFace;
  DrawElectronClock;
  DrawArrows;
  Canvas.Draw(0, 0, Bitmap);
  Bitmap.Free;
end;

procedure TCustomAutoTimeControl.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  SetSize;
end;

procedure TCustomAutoTimeControl.SetSize;
begin
  if (not IsPopup and (Parent = nil)) or
    (csDestroying in ComponentState) then Exit;
  Height := GetHeight;
  RecreateWnd;
end;

procedure TCustomAutoTimeControl.Hide;
begin
  if IsPopup then DestroyHandle
  else inherited Hide;
  if Assigned(FOnHide) then FOnHide(Self);
end;

procedure TCustomAutoTimeControl.Show;
begin
  SetSize;
  if IsPopup then
  begin
    ShowWindow(Handle, SW_SHOW);
    SendMessage(TForm(Owner).Handle, WM_NCACTIVATE, Longint(True), 0);
    Windows.SetFocus(FTrackBar.Handle);
    ShowWindow(FTrackBar.Handle, SW_SHOW);
  end
  else inherited Show;
end;

{ TDropDownButton }

type
  TDropDownButton = class(TSpeedButton)
  private
    IsShowingPopup: Boolean;
    procedure HidePopup(Sender: TObject);
    procedure TimeChange(Sender: TObject);
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Click; override;
  end;

constructor TDropDownButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alRight;
  Cursor := crArrow;
  Width := GetSystemMetrics(SM_CXVSCROLL);
end;

procedure TDropDownButton.HidePopup(Sender: TObject);
var
  P: TPoint;
begin
  GetCursorPos(P);
  P := ScreenToClient(P);
  if (GetAsyncKeyState(VK_LBUTTON) shr 15 = 0) or
    not PtInRect(ClientRect, P) then
    IsShowingPopup := False;
end;

procedure TDropDownButton.TimeChange(Sender: TObject);
begin
  TCustomAutoTimeEdit(Parent).Time := TCustomAutoTimeControl(Sender).Time;
end;

procedure TDropDownButton.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if IsShowingPopup then IsShowingPopup := False
  else inherited;
end;

procedure TDropDownButton.Paint;
const
  EnabledStyles: array[Boolean] of Integer = (DFCS_INACTIVE, 0);
  DownStyles: array[Boolean] of Integer = (0, DFCS_PUSHED);
begin
  inherited Paint;
  with Canvas do
    DrawFrameControl(Handle, ClientRect, DFC_SCROLL, DFCS_SCROLLCOMBOBOX or
      EnabledStyles[Parent.Enabled] or DownStyles[FState = bsDown]);
end;

procedure TDropDownButton.Click;
var
  P: TPoint;
  R: TRect;
begin
  if TCustomAutoTimeEdit(Parent).ReadOnly then Exit;
  inherited Click;
  Parent.SetFocus;
  with Parent do
    P := Parent.ClientToScreen(Point(Left, Top + Height));
  with TCustomAutoTimeControl.Create(GetParentForm(Self)) do
  begin
    IsPopup := True;
    Left := P.X;
    Top := P.Y;
    Width := TCustomAutoTimeEdit(Self.Parent).DropDownWidth;
    Time := TCustomAutoTimeEdit(Self.Parent).Time;
    OnHide := HidePopup;
    OnTimeChange := TimeChange;
    SetSize;
    SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
    if Left < R.Left then Left := R.Left;
    if Left + Width > R.Right then
      Left := R.Right - Width;
    if Top + Height > R.Bottom then
      Top := Top - (Self.Parent.Height + Height);
    IsShowingPopup := True;
    Show;
  end;
end;

{ TCustomAutoTimeEdit }

constructor TCustomAutoTimeEdit.Create(AOwner: TComponent);
var
  OldDefaultBlank: Char;
begin
  inherited Create(AOwner);
  OldDefaultBlank := DefaultBlank;
  DefaultBlank := '0';
  EditMask := '00:00:00';
  MaxLength := 8;
  DefaultBlank := OldDefaultBlank;
  FDropDownWidth := 165;
  DropDownButton := TDropDownButton.Create(Self);
  DropDownButton.Parent := Self;
  Time := SysUtils.Time;
end;

function TCustomAutoTimeEdit.GetTime: TDateTime;
begin
  Result := StrToTime(EditText);
end;

procedure TCustomAutoTimeEdit.SetTime(Value: TDateTime);
begin
  if Value <> Time then
  begin
    EditText := FormatDateTime(TimeFormat, Value);
    Update;
    DoTimeChange;
  end;
end;

procedure TCustomAutoTimeEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  R: TRect;
begin
  R := ClientRect;
  Dec(R.Right, GetSystemMetrics(SM_CXVSCROLL));
  FillRect(Message.DC, R, Brush.Handle);
  Message.Result := 1;
end;

procedure TCustomAutoTimeEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or ES_MULTILINE;
end;

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

function TCustomAutoTimeEdit.EditingPlace: TEditingPlace;
var
  S: string;
  Pos: Integer;
begin
  S := UpperCase(TimeFormat);
  Pos := SelStart + 1;
  if Pos > MaxLength then Pos := MaxLength;
  case S[Pos] of
    'H': Result := epHour;
    'N': Result := epMin;
    'S': Result := epSec;
  else Result := epError;
  end;
end;

procedure TCustomAutoTimeEdit.KeyDown(var Key: Word; Shift: TShiftState);

  procedure ChangeValue(Delta: Integer);
  var
    OldSelStart, OldSelStop: Integer;
    Hour, Min, Sec, MSec: Word;
    Seconds: Integer;
  begin
    GetSel(OldSelStart, OldSelStop);
    DecodeTime(Time, Hour, Min, Sec, MSec);
    Seconds := EncodeSeconds(Hour, Min, Sec);
    case EditingPlace of
      epHour: Inc(Seconds, SecondsPerHour * Delta);
      epMin: Inc(Seconds, 60 * Delta);
      epSec: Inc(Seconds, Delta);
      else Exit;
    end;
    if (Seconds < 0) or (Seconds >= SecondsPerDay) then Exit;
    DecodeSeconds(Seconds, Hour, Min, Sec);
    Time := EncodeTime(Hour, Min, Sec, 0);
    SetSel(OldSelStart, OldSelStop);
  end;

begin
  if not ReadOnly then
    case Key of
      VK_DOWN:
        if Shift = [ssAlt] then DropDownButton.Click
        else ChangeValue(-1);
      VK_UP: ChangeValue(1);
      VK_F4: if Shift = [] then DropDownButton.Click;
    end;
  inherited KeyDown(Key, Shift);
end;

procedure TCustomAutoTimeEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  R: TRect;
  W: Integer;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if HandleAllocated then
  begin
    Perform(EM_GETRECT, 0, Longint(@R));
    W := GetSystemMetrics(SM_CXVSCROLL);
    if BorderStyle = bsSingle then Dec(W);
    if (R.Right - R.Left <= ClientWidth - W) or
      (Width = 0) or (Height = 0) then Exit;
    Dec(R.Right, W);
    Perform(EM_SETRECT, 0, Longint(@R));
    DropDownButton.Height := ClientHeight;
  end;
end;

initialization
  TimeFormat := 'hh:nn:ss';

end.