stooledit.pas

AlphaControls是一个Delphi标准控件的集合

end;

procedure TsFilenameEdit.SetOptions(Value: TOpenOptions);
begin
  if Value <> FDialog.Options then begin
    FMultipleDirs := ofAllowMultiSelect in Value;
    FDialog.Options := Value;
    if not FMultipleDirs then ClearFileList;
  end;
end;

procedure TsFilenameEdit.SetDialogTitle(const Value: string);
begin
  FDialog.Title := Value;
end;

{ TsDirectoryEdit }

constructor TsDirectoryEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sStyle.COC := COC_TsDirectoryEdit;
  FDefBmpName := 'BTN_OPENFOLDER';
  FOptions := [sdAllowCreate, sdPerformCreate, sdPrompt];
end;

procedure TsDirectoryEdit.ButtonClick;
var
  s: string;
  Flag: Boolean;
begin
  inherited;
  s := Text;
  if (s = '') then begin
    if (InitialDir <> '')
      then s := InitialDir
      else s := '\';
  end;
  if not DirExists(s)
    then s := '\'
    else ChDir(s);

//  Flag := SelectDirectory('1', '2', s);

  Flag := SelectDirectory(s, FOptions, Self.HelpContext);
  if CanFocus then SetFocus;
  if Flag then begin
//    SelText := '';
    if (Text = '') or not MultipleDirs
      then Text := s
      else Text := s + ';' + s;
    if (s <> '') and DirExists(s) then InitialDir := s;
  end;
end;

procedure TsDirectoryEdit.ReceptFileDir(const AFileName: string);
var
  s: string;
begin
  if FileExists(AFileName)
    then s := ExtractFilePath(AFileName)
    else s := AFileName;
  if (Text = '') or not MultipleDirs
    then Text := s
    else Text := Text + ';' + s;
end;

function TsDirectoryEdit.GetLongName: string;
var
  s: string;
  Pos: Integer;
begin
  if not MultipleDirs then Result := ShortToLongPath(Text)
  else begin
    Result := '';
    Pos := 1;
    while Pos <= Length(Text) do begin
      s := ShortToLongPath(ExtractSubstr(Text, Pos, [';']));
      if (Result <> '') and (s <> '') then Result := Result + ';';
      Result := Result + s;
    end;
  end;
end;

function TsDirectoryEdit.GetShortName: string;
var
  s: string;
  Pos: Integer;
begin
  if not MultipleDirs then Result := LongToShortPath(Text)
  else begin
    Result := '';
    Pos := 1;
    while Pos <= Length(Text) do begin
      s := LongToShortPath(ExtractSubstr(Text, Pos, [';']));
      if (Result <> '') and (s <> '') then Result := Result + ';';
      Result := Result + s;
    end;
  end;
end;

{ TsCustomDateEdit }

function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
begin
  if DateValue = NullDate then Result := DefaultValue
  else Result := DateValue;
end;

constructor TsCustomDateEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sStyle.COC := COC_TsCustomDateEdit;

  FBlanksChar := ' ';
  FTitle := NewStr('Date select');
  FStartOfWeek := dowLocaleDefault;
  FWeekends := [dowSunday];
  FWeekendColor := clRed;
  FYearDigits := dyFour;
  FCalendarHints := TStringList.Create;
  TStringList(FCalendarHints).OnChange := CalendarHintsChanged;
  FDefBmpName := 'BTN_DATE';
//  GlyphMode.AssignDefaultBitmap;

  ControlState := ControlState + [csCreating];
  Width := 86;
  try
    UpdateFormat;
    FPopupWindow := TsPopupCalendar.Create(Self);
    TsPopupCalendar(FPopupWindow).FEditor := Self;
  finally
    ControlState := ControlState - [csCreating];
  end;
end;

destructor TsCustomDateEdit.Destroy;
begin
  if FHooked then begin
    Application.UnhookMainWindow(FormatSettingsChange);
    FHooked := False;
  end;
  if Assigned(FPopupwindow) then FreeAndNil(FPopupWindow);
  TStringList(FCalendarHints).OnChange := nil;
  if Assigned(FCalendarHints) then FreeAndNil(FCalendarHints);
  DisposeStr(FTitle);
  inherited Destroy;
end;

procedure TsCustomDateEdit.CreateWindowHandle(const Params: TCreateParams);
begin
  inherited CreateWindowHandle(Params);
  if Handle <> 0 then begin
    UpdateMask;
    if not (csDesigning in ComponentState) and not (IsLibrary or FHooked) then begin
      Application.HookMainWindow(FormatSettingsChange);
      FHooked := True;
    end;
  end;
end;

procedure TsCustomDateEdit.DestroyWindowHandle;
begin
  if FHooked then begin
    Application.UnhookMainWindow(FormatSettingsChange);
    FHooked := False;
  end;
  inherited DestroyWindowHandle;
end;

procedure TsCustomDateEdit.UpdateFormat;
begin
  FDateFormat := DefDateFormat(FourDigitYear);
end;

function TsCustomDateEdit.GetDateFormat: string;
begin
  Result := FDateFormat;
end;

function TsCustomDateEdit.TextStored: Boolean;
begin
  Result := not IsEmptyStr(Text, [#0, ' ', DateSeparator, FBlanksChar]);
end;

procedure TsCustomDateEdit.CheckValidDate;
begin
  if TextStored then
    try
      FFormatting := True;
      try
        SetDate(StrToDateFmt(FDateFormat, Text));
      finally
        FFormatting := False;
      end;
    except
      if CanFocus then SetFocus;
      raise;
    end;
end;

procedure TsCustomDateEdit.Change;
begin
  if not FFormatting then inherited Change;
end;

procedure TsCustomDateEdit.CMExit(var Message: TCMExit);
begin
  if not (csDesigning in ComponentState) and CheckOnExit then CheckValidDate;
  if FMaxDate <> 0 then begin
    if Date > FMaxDate then Date := FMaxDate;
  end;
  if FMinDate <> 0 then begin
    if Date < FMinDate then Date := FMinDate;
  end;
  inherited;
end;

procedure TsCustomDateEdit.SetBlanksChar(Value: Char);
begin
  if Value <> FBlanksChar then begin
    if (Value < ' ') then Value := ' ';
    FBlanksChar := Value;
    UpdateMask;
  end;
end;

procedure TsCustomDateEdit.UpdateMask;
var
  DateValue: TDateTime;
  OldFormat: string[10];
begin
  DateValue := GetDate;
  OldFormat := FDateFormat;
  UpdateFormat;
  if (GetDateMask <> EditMask) or (OldFormat <> FDateFormat) then begin
    { force update }
    EditMask := '';
    EditMask := GetDateMask;
  end;
  UpdatePopup;
  SetDate(DateValue);
end;

function TsCustomDateEdit.FormatSettingsChange(var Message: TMessage): Boolean;
begin
  Result := False;
  if (Message.Msg = WM_WININICHANGE)
      and Application.UpdateFormatSettings then
    UpdateMask;
end;

function TsCustomDateEdit.FourDigitYear: Boolean;
begin
  Result := (FYearDigits = dyFour);
  Result := Result or ((FYearDigits = dyDefault) and sDateUtils.NormalYears);
end;

function TsCustomDateEdit.GetDateMask: string;
begin
  Result := DefDateMask(FBlanksChar, FourDigitYear);
end;

function TsCustomDateEdit.GetDate: TDateTime;
begin
  if DefaultToday
    then Result := SysUtils.Date
    else Result := NullDate;
  Result := StrToDateFmtDef(FDateFormat, Text, Result);
end;

procedure TsCustomDateEdit.SetDate(Value: TDateTime);
var
  D: TDateTime;
begin
  if not ValidDate(Value) or (Value = NullDate) then begin
    if DefaultToday then Value := SysUtils.Date
    else Value := NullDate;
  end;
  D := Date;
  if Value = NullDate
    then Text := ''
    else Text := FormatDateTime(FDateFormat, Value);
  Modified := D <> Date;
end;

procedure TsCustomDateEdit.ApplyDate(Value: TDateTime);
begin
  SetDate(Value);
  SelectAll;
end;

function TsCustomDateEdit.GetDialogTitle: string;
begin
  Result := FTitle^;
end;

procedure TsCustomDateEdit.SetDialogTitle(const Value: string);
begin
  AssignStr(FTitle, Value);
end;

function TsCustomDateEdit.IsCustomTitle: Boolean;
begin
  Result := (CompareStr('Date select', DialogTitle) <> 0) and
    (FTitle <> NullStr);
end;

procedure TsCustomDateEdit.UpdatePopup;
var
  i : integer;
begin
  if (FPopupWindow <> nil) and (TsPopupCalendar(FPopupWindow).FCalendar <> nil) then begin
    TsPopupCalendar(FPopupWindow).FCalendar.StartOfWeek := FStartOfWeek;
    TsPopupCalendar(FPopupWindow).FCalendar.Weekends := FWeekends;
    TsPopupCalendar(FPopupWindow).FCalendar.WeekendColor := FWeekendColor;
    TsPopupCalendar(FPopupWindow).FFourDigitYear := FourDigitYear;
    for i := 0 to CalendarHints.Count -1 do begin
      TsPopupCalendar(FPopupWindow).FCalendar.FBtns[i].Hint := CalendarHints[i];
      TsPopupCalendar(FPopupWindow).FCalendar.FBtns[i].ShowHint := ShowHint;
      if i = 3 then break;
    end;
  end;
end;

procedure TsCustomDateEdit.SetYearDigits(Value: TYearDigits);
begin
  if FYearDigits <> Value then begin
    FYearDigits := Value;
    UpdateMask;
  end;
end;

procedure TsCustomDateEdit.SetCalendarHints(Value: TStrings);
begin
  FCalendarHints.Assign(Value);
end;

procedure TsCustomDateEdit.CalendarHintsChanged(Sender: TObject);
begin
  TStringList(FCalendarHints).OnChange := nil;
  try
    while (FCalendarHints.Count > 4) do
      FCalendarHints.Delete(FCalendarHints.Count - 1);
  finally
    TStringList(FCalendarHints).OnChange := CalendarHintsChanged;
  end;
  if not (csDesigning in ComponentState) then UpdatePopup;
end;

procedure TsCustomDateEdit.SetWeekendColor(Value: TColor);
begin
  if Value <> FWeekendColor then begin
    FWeekendColor := Value;
    UpdatePopup;
  end;
end;

procedure TsCustomDateEdit.SetWeekends(Value: sConst.TDaysOfWeek);
begin
  if Value <> FWeekends then begin
    FWeekends := Value;
    UpdatePopup;
  end;
end;

procedure TsCustomDateEdit.SetStartOfWeek(Value: TCalDayOfWeek);
begin
  if Value <> FStartOfWeek then begin
    FStartOfWeek := Value;
    UpdatePopup;
  end;
end;

procedure TsCustomDateEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN,
                         VK_ADD, VK_SUBTRACT]) and DroppedDown then begin
    TsPopupCalendar(FPopupWindow).FCalendar.FGrid.KeyDown(Key, Shift);
    Key := 0;
  end
  else if (Shift = []) and DirectInput then begin
    case Key of
      VK_ADD: begin
        ApplyDate(NvlDate(Date, Now) + 1);
        Key := 0;
      end;
      VK_SUBTRACT: begin
        ApplyDate(NvlDate(Date, Now) - 1);
        Key := 0;
      end;
    end;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TsCustomDateEdit.KeyPress(var Key: Char);
begin
  if (Key in ['T', 't', '+', '-']) and DroppedDown then begin
    TsPopupCalendar(FPopupWindow).FCalendar.FGrid.KeyPress(Key);
    Key := #0;
  end
  else if DirectInput then begin
    case Key of
      'T', 't': begin
        ApplyDate(Trunc(Now));
        Key := #0;
      end;
      '+', '-': begin
        Key := #0;
      end;
    end;
  end;
  inherited KeyPress(Key);
end;

procedure TsCustomDateEdit.PopupWindowShow;
var
  sC : TsControlsManager;
begin
  if sStyle.sC = nil then sStyle.sC := GetsEditorsManager(GetParentForm(Self), 0);
  if Self.Date <> NullDate then begin
    TsPopupCalendar(FPopupWindow).FCalendar.CalendarDate := Self.Date
  end
  else begin
    TsPopupCalendar(FPopupWindow).FCalendar.CalendarDate := SysUtils.Date
  end;
  TsPopupCalendar(FPopupWindow).FEditor := Self;
  if not TsPopupCalendar(FPopupWindow).sControlsManager1.Active then begin
    sC := GetsControlsManager(GetParentForm(Self), sStyle.GroupIndex);
    if sC <> nil then begin
      TsPopupCalendar(FPopupWindow).sControlsManager1.Assign(sC);
    end;
  end;
  inherited;
end;

procedure TsCustomDateEdit.Loaded;
begin
  inherited;
  Self.UpdateMask;
end;

procedure TsCustomDateEdit.WndProc(var Message: TMessage);
begin
  if Assigned (FPopupWindow) then begin
    case Message.Msg of
      SM_REMOVESKIN, SM_CLEARINDEXES, SM_SETNEWSKIN, SM_REFRESH : begin
        BroadCastS(FPopupWindow, Message);
      end;
    end;
  end;
  inherited;
end;

procedure TsCustomDateEdit.SetMinDate(const Value: TDateTime);
begin
  if (FMaxDate <> NullDate) and (Value > FMaxDate) then Exit;
  if (FMinDate <> Value) then begin
    FMinDate := Value;
    if Date < FMinDate then Date := FMinDate;
  end;
end;

procedure TsCustomDateEdit.SetMaxDate(const Value: TDateTime);
begin
  if (FMaxDate <> Value) and (Value >= FMinDate) then begin
    FMaxDate := Value;
    if Date > FMaxDate then Date := FMaxDate;
  end;
end;

{ TsDateEdit }

constructor TsDateEdit.Create(AOwner: TComponent);
//var
//  d: TDateTime;
begin
  inherited Create(AOwner);
  sStyle.COC := COC_TsDateEdit;
  EditMask := '!90/90/0000;1; ';
  UpdateMask;
end;

{ Utility routines }

procedure DateFormatChanged;

  procedure IterateControls(AControl: TWinControl);
  var
    I: Integer;
  begin
    with AControl do
      for I := 0 to ControlCount - 1 do begin
        if Controls[I] is TsCustomDateEdit then
          TsCustomDateEdit(Controls[I]).UpdateMask
        else if Controls[I] is TWinControl then
          IterateControls(TWinControl(Controls[I]));
      end;
  end;

var
  I: Integer;
begin
  if Screen <> nil then
    for I := 0 to Screen.FormCount - 1 do
      IterateControls(Screen.Forms[I]);
end;

function StrToDateFmt(const DateFormat, S: string): TDateTime;
begin
  if not InternalStrToDate(DateFormat, S, Result) then
    raise EConvertError.CreateFmt('Invalid Date', [S]);
end;

function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
begin
  if not InternalStrToDate(DateFormat, S, Result) then
    Result := Trunc(Default);
end;

end.