stooledit.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sTooledit;
{$I sDefs.inc}

interface

uses Windows, Classes, sConst, StdCtrls, Controls,
  Messages, SysUtils, Forms, Graphics, Menus, Buttons, sDialogs, Mask, sDateUtils,
  sCustomComboEdit, FileCtrl, comctrls, sPopupClndr, sStrings, Dialogs, sMonthCalendar,
  acntUtils, sDefaults {$IFDEF DELPHI6}, Variants{$ENDIF};

type

  TsFileDirEdit = class(TsCustomComboEdit)
{$IFNDEF NOTFORHELP}
  private
    FAcceptFiles: Boolean;
    FOnDropFiles: TNotifyEvent;
    procedure SetDragAccept(Value: Boolean);
    procedure SetAcceptFiles(Value: Boolean);
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  protected
    FMultipleDirs: Boolean;
    procedure CreateHandle; override;
    procedure DestroyWindowHandle; override;
    function GetLongName: string; virtual; abstract;
    function GetShortName: string; virtual; abstract;
    procedure ReceptFileDir(const AFileName: string); virtual; abstract;
    procedure ClearFileList; virtual;
    property MaxLength default 255;
  public
    constructor Create(AOwner: TComponent); override;
{$ENDIF} // NOTFORHELP
    property LongName: string read GetLongName;
    property ShortName: string read GetShortName;
    property AcceptFiles: Boolean read FAcceptFiles write SetAcceptFiles default False;
  published
{$IFNDEF NOTFORHELP}
    property OnDropFiles: TNotifyEvent read FOnDropFiles write FOnDropFiles;
{$ENDIF} // NOTFORHELP
  end;

{ TsFilenameEdit }

  TFileDialogKind = (dkOpen, dkSave);

  TsFilenameEdit = class(TsFileDirEdit)
{$IFNDEF NOTFORHELP}
  private
    FDialog: TOpenDialog;
    FDialogKind: TFileDialogKind;
    procedure CreateEditDialog;
    function GetFileName: string;
    function GetDefaultExt: string;
    function GetFileEditStyle: TFileEditStyle;
    function GetFilter: string;
    function GetFilterIndex: Integer;
    function GetInitialDir: string;
    function GetHistoryList: TStrings;
    function GetOptions: TOpenOptions;
    function GetDialogTitle: string;
    function GetDialogFiles: TStrings;
    procedure SetDialogKind(Value: TFileDialogKind);
    procedure SetFileName(const Value: string);
    procedure SetDefaultExt(Value: string);
    procedure SetFileEditStyle(Value: TFileEditStyle);
    procedure SetFilter(const Value: string);
    procedure SetFilterIndex(Value: Integer);
    procedure SetInitialDir(const Value: string);
    procedure SetHistoryList(Value: TStrings);
    procedure SetOptions(Value: TOpenOptions);
    procedure SetDialogTitle(const Value: string);
    function IsCustomTitle: Boolean;
    function IsCustomFilter: Boolean;
  protected
    procedure ButtonClick; override;
    procedure ReceptFileDir(const AFileName: string); override;
    procedure ClearFileList; override;
    function GetLongName: string; override;
    function GetShortName: string; override;
    property FileEditStyle: TFileEditStyle read GetFileEditStyle write SetFileEditStyle default fsEdit;
  public
    constructor Create(AOwner: TComponent); override;
    property Dialog: TOpenDialog read FDialog;
{$ENDIF} // NOTFORHELP
    property DialogFiles: TStrings read GetDialogFiles;
    property DialogTitle: string read GetDialogTitle write SetDialogTitle stored IsCustomTitle;
  published
{$IFNDEF NOTFORHELP}
    property DefaultExt: string read GetDefaultExt write SetDefaultExt;
    property FilterIndex: Integer read GetFilterIndex write SetFilterIndex default 1;
    property InitialDir: string read GetInitialDir write SetInitialDir;
{$ENDIF} // NOTFORHELP

    property DialogKind: TFileDialogKind read FDialogKind write SetDialogKind default dkOpen;
    property FileName: string read GetFileName write SetFileName stored False;
    property Filter: string read GetFilter write SetFilter stored IsCustomFilter;
    property HistoryList: TStrings read GetHistoryList write SetHistoryList;
    property DialogOptions: TOpenOptions read GetOptions write SetOptions default [ofHideReadOnly, ofEnableSizing];
  end;

{ TsDirectoryEdit }

  TsDirectoryEdit = class(TsFileDirEdit)
{$IFNDEF NOTFORHELP}
  private
    FOptions: TSelectDirOpts;
    FInitialDir: string;
    FDialogText: string;
    FRoot: TacRoot;
    FNoChangeDir: boolean;
  protected
    procedure ButtonClick; override;
    procedure ReceptFileDir(const AFileName: string); override;
    function GetLongName: string; override;
    function GetShortName: string; override;
  public
    constructor Create(AOwner: TComponent); override;
    property DialogText: string read FDialogText write FDialogText;
  published
    property InitialDir: string read FInitialDir write FInitialDir;
{$ENDIF} // NOTFORHELP
    property DialogOptions: TSelectDirOpts read FOptions write FOptions default [sdAllowCreate, sdPerformCreate, sdPrompt];
    property MultipleDirs: Boolean read FMultipleDirs write FMultipleDirs default False;
    property NoChangeDir : boolean read FNoChangeDir write FNoChangeDir default False;
    property Root: TacRoot read FRoot write FRoot;
  end;

{ TsCustomDateEdit }

  TYearDigits = (dyDefault, dyFour, dyTwo);

//type
  TOnAcceptDate = procedure(Sender: TObject; var aDate: TDateTime; var CanAccept: Boolean) of object;

  TsCustomDateEdit = class(TsCustomComboEdit)
{$IFNDEF NOTFORHELP}
  private
    FTitle: PString;
    FOnAcceptDate: TOnAcceptDate;
    FDefaultToday: Boolean;
    FHooked: Boolean;
    FCheckOnExit: Boolean;
    FBlanksChar: Char;
    FCalendarHints: TStrings;
    FStartOfWeek: TCalDayOfWeek;
    FWeekends: sConst.TDaysOfWeek;
    FWeekendColor: TColor;
    FYearDigits: TYearDigits;
    FDateFormat: string[10];
    FFormatting: Boolean;
    FMinDate: TDateTime;
    FMaxDate: TDateTime;
    FOnGetCellParams: TGetCellParams;
    FShowCurrentDate: boolean;
    function GetDate: TDateTime;
    procedure SetDate(Value: TDateTime);
    procedure SetYearDigits(Value: TYearDigits);
    function GetDialogTitle: string;
    procedure SetDialogTitle(const Value: string);
    function IsCustomTitle: Boolean;
    procedure SetCalendarHints(Value: TStrings);
    procedure CalendarHintsChanged(Sender: TObject);
    procedure SetWeekendColor(Value: TColor);
    procedure SetWeekends(Value: sConst.TDaysOfWeek);
    procedure SetStartOfWeek(Value: TCalDayOfWeek);
    procedure SetBlanksChar(Value: Char);
    function TextStored: Boolean;
    function FourDigitYear: Boolean;
    function FormatSettingsChange(var Message: TMessage): Boolean;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure SetMinDate(const Value: TDateTime);
    procedure SetMaxDate(const Value: TDateTime);
    procedure SetShowCurrentDate(const Value: boolean);
  protected
    procedure Change; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DestroyWindowHandle; override;
    function GetDateFormat: string;
    function DateIsStored : boolean;
    procedure ApplyDate(Value: TDateTime); virtual;
    procedure UpdateFormat;
    procedure UpdatePopup;
    procedure PopupWindowShow; override;
    property Formatting: Boolean read FFormatting;
    property EditMask stored False;
    property DialogTitle: string read GetDialogTitle write SetDialogTitle stored IsCustomTitle;
{$ENDIF} // NOTFORHELP
    property BlanksChar: Char read FBlanksChar write SetBlanksChar default ' ';
    property CalendarHints: TStrings read FCalendarHints write SetCalendarHints;
    property CheckOnExit: Boolean read FCheckOnExit write FCheckOnExit default False;
    property DefaultToday: Boolean read FDefaultToday write FDefaultToday default False;
    property MaxLength stored False;
    property StartOfWeek: TCalDayOfWeek read FStartOfWeek write SetStartOfWeek default dowLocaleDefault;
    property Weekends: sConst.TDaysOfWeek read FWeekends write SetWeekends default DefWeekends;
    property WeekendColor: TColor read FWeekendColor write SetWeekendColor default clRed;
    property YearDigits: TYearDigits read FYearDigits write SetYearDigits default dyFour;
//    property Text stored TextStored; Alex Golubev
    {:@event}
    property OnAcceptDate: TOnAcceptDate read FOnAcceptDate write FOnAcceptDate;
{$IFNDEF NOTFORHELP}
  public
    procedure Loaded; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function CheckValidDate : boolean;
    function GetDateMask: string;
    procedure WndProc (var Message: TMessage); override;
    procedure UpdateMask; virtual;
{$ENDIF} // NOTFORHELP
    property Date: TDateTime read GetDate write SetDate;
    property Text stored DateIsStored;
  published
    property MinDate : TDateTime read FMinDate write SetMinDate;
    property MaxDate : TDateTime read FMaxDate write SetMaxDate;
    property ShowCurrentDate : boolean read FShowCurrentDate write SetShowCurrentDate default True;
    property OnGetCellParams : TGetCellParams read FOnGetCellParams write FOnGetCellParams;
  end;

{ TsDateEdit }

  TsDateEdit = class(TsCustomDateEdit)
{$IFNDEF NOTFORHELP}
  public
    constructor Create(AOwner: TComponent); override;
    property EditMask;
  published
    property BlanksChar;
    property CalendarHints;
    property CheckOnExit;
    property ClickKey;
    property Date;
    property DefaultToday;
    property DialogTitle;
    property MaxDate;
    property MinDate;
    property PopupAlign;
    property PopupWidth;
    property StartOfWeek;
    property Text;
    property Weekends;
    property WeekendColor;
    property YearDigits;
    {:@event}
    property OnAcceptDate;
    property OnButtonClick;
    property OnChange;
    property OnContextPopup;
{$ENDIF} // NOTFORHELP
  end;

{$IFNDEF NOTFORHELP}
procedure DateFormatChanged;
function StrToDateFmt(const DateFormat, S: string): TDateTime;
function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
{$ENDIF} // NOTFORHELP

implementation

uses ShellAPI, Consts, sMessages, sStyleSimply, acPathDialog, acShellCtrls, sSkinManager;

const
  sFileBmp = 'FEDITBMP'; { Filename and directory editor button glyph }
  sDateBmp = 'DEDITBMP'; { Date editor button glyph }

{ TsFileDirEdit }

constructor TsFileDirEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SkinData.COC := COC_TsFileDirEdit;

//  OEMConvert := True; v4.80
  MaxLength := 255;
end;

procedure TsFileDirEdit.CreateHandle;
begin
  inherited CreateHandle;
  if FAcceptFiles then SetDragAccept(True);
end;

procedure TsFileDirEdit.DestroyWindowHandle;
begin
  SetDragAccept(False);
  inherited DestroyWindowHandle;
end;

procedure TsFileDirEdit.SetDragAccept(Value: Boolean);
begin
  if not (csDesigning in ComponentState) and (Handle <> 0) then DragAcceptFiles(Handle, Value);
end;

procedure TsFileDirEdit.SetAcceptFiles(Value: Boolean);
begin
  if FAcceptFiles <> Value then begin
    SetDragAccept(Value);
    FAcceptFiles := Value;
  end;
end;

procedure TsFileDirEdit.WMDropFiles(var Msg: TWMDropFiles);
var
  FileName: string;
  i, Num: Cardinal;
begin
  Msg.Result := 0;
  Num := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0);
  if Num > 0 then begin
    ClearFileList;
    for i := 0 to Num - 1 do begin
      DragQueryFile(Msg.Drop, i, PChar(FileName), Length(FileName) - 1);
      ReceptFileDir(FileName);
      if not FMultipleDirs then Break;
    end;
    if Assigned(FOnDropFiles) then FOnDropFiles(Self);
  end;
  DragFinish(Msg.Drop);
end;

procedure TsFileDirEdit.ClearFileList;
begin
end;

{ TsFilenameEdit }

constructor TsFilenameEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SkinData.COC := COC_TsFilenameEdit;
  FDefBmpName := 'BTN_OPENFILE';
  CreateEditDialog;
end;

procedure TsFilenameEdit.CreateEditDialog;
var
  NewDialog: TOpenDialog;
begin
  case FDialogKind of
    dkOpen: begin
      NewDialog := TsOpenDialog.Create(Self);
      TsOpenDialog(NewDialog).ZipShowing := zsAsFile;
    end;
    dkSave: begin
      NewDialog := TsSaveDialog.Create(Self);
    end
    else NewDialog := nil;
  end;
  if FDialog <> nil then begin
    NewDialog.DefaultExt := FDialog.DefaultExt;