stooledit.pas

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

    NewDialog.FileEditStyle := FDialog.FileEditStyle;
    NewDialog.FileName := FDialog.FileName;
    NewDialog.Filter := FDialog.Filter;
    NewDialog.FilterIndex := FDialog.FilterIndex;
    NewDialog.InitialDir := FDialog.InitialDir;
    NewDialog.HistoryList := FDialog.HistoryList;
    NewDialog.Files.Assign(FDialog.Files);
    NewDialog.Options := FDialog.Options;
    FDialog.Free;
  end
  else begin
    NewDialog.Filter := SDefaultFilter;
    NewDialog.Options := [ofHideReadOnly, ofEnableSizing];
  end;
  FDialog := NewDialog;
end;

function TsFilenameEdit.IsCustomTitle: Boolean;
begin
  Result := CompareStr(LoadStr(s_FileOpen), FDialog.Title) <> 0;
end;

function TsFilenameEdit.IsCustomFilter: Boolean;
begin
  Result := CompareStr(sDefaultFilter, FDialog.Filter) <> 0;
end;

procedure TsFilenameEdit.ButtonClick;
var
  Temp: string;
  Flag: Boolean;
begin
  inherited;
  Temp := inherited Text;
  Flag := True;
  if not Flag then Exit;
  if ValidFileName(Temp) then begin
    if DirectoryExists(ExtractFilePath(Temp)) then SetInitialDir(ExtractFilePath(Temp));
    if (ExtractFileName(Temp) = '') or not ValidFileName(ExtractFileName(Temp)) then Temp := '';
    FDialog.FileName := Temp;
  end;
  FDialog.HelpContext := Self.HelpContext;
  Flag := FDialog.Execute;
  if Flag then Temp := FDialog.FileName;
  if CanFocus then SetFocus;
  if Flag then begin
    inherited Text := Temp;
    SetInitialDir(ExtractFilePath(FDialog.FileName));
  end;
end;

function TsFilenameEdit.GetFileName: string;
begin
  Result := inherited Text;
end;

procedure TsFilenameEdit.SetFileName(const Value: string);
begin
  if (Value = '') or ValidFileName(Value) then begin
    inherited Text := Value;//ExtFilename(Value); v4.10
    ClearFileList;
  end
  else raise Exception.CreateFmt('Invalid file name', [Value]);
end;

function TsFilenameEdit.GetLongName: string;
begin
//  Result := ShortToLongFileName(FileName);
  Result := FileName;
end;

function TsFilenameEdit.GetShortName: string;
begin
//  Result := LongToShortFileName(FileName);
  Result := FileName;
end;

procedure TsFilenameEdit.ClearFileList;
begin
  FDialog.Files.Clear;
end;

procedure TsFilenameEdit.ReceptFileDir(const AFileName: string);
begin
  if FMultipleDirs then begin
    if FDialog.Files.Count = 0 then SetFileName(AFileName);
    FDialog.Files.Add(AFileName);
  end
  else SetFileName(AFileName);
end;

function TsFilenameEdit.GetDialogFiles: TStrings;
begin
  Result := FDialog.Files;
end;

function TsFilenameEdit.GetDefaultExt: string;
begin
  Result := FDialog.DefaultExt;
end;

function TsFilenameEdit.GetFileEditStyle: TFileEditStyle;
begin
  Result := FDialog.FileEditStyle;
end;

function TsFilenameEdit.GetFilter: string;
begin
  Result := FDialog.Filter;
end;

function TsFilenameEdit.GetFilterIndex: Integer;
begin
  Result := FDialog.FilterIndex;
end;

function TsFilenameEdit.GetInitialDir: string;
begin
  Result := FDialog.InitialDir;
end;

function TsFilenameEdit.GetHistoryList: TStrings;
begin
  Result := FDialog.HistoryList;
end;

function TsFilenameEdit.GetOptions: TOpenOptions;
begin
  Result := FDialog.Options;
end;

function TsFilenameEdit.GetDialogTitle: string;
begin
  Result := FDialog.Title;
end;

procedure TsFilenameEdit.SetDialogKind(Value: TFileDialogKind);
begin
  if FDialogKind <> Value then begin
    FDialogKind := Value;
    CreateEditDialog;
  end;
end;

procedure TsFilenameEdit.SetDefaultExt(Value: string);
begin
  FDialog.DefaultExt := Value;
end;

procedure TsFilenameEdit.SetFileEditStyle(Value: TFileEditStyle);
begin
  FDialog.FileEditStyle := Value;
end;

procedure TsFilenameEdit.SetFilter(const Value: string);
begin
  FDialog.Filter := Value;
end;

procedure TsFilenameEdit.SetFilterIndex(Value: Integer);
begin
  FDialog.FilterIndex := Value;
end;

procedure TsFilenameEdit.SetInitialDir(const Value: string);
begin
  FDialog.InitialDir := Value;
end;

procedure TsFilenameEdit.SetHistoryList(Value: TStrings);
begin
  FDialog.HistoryList := Value;
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);
  SkinData.COC := COC_TsDirectoryEdit;
  FDefBmpName := 'BTN_OPENFOLDER';
  FOptions := [sdAllowCreate, sdPerformCreate, sdPrompt];
  FRoot := SRFDesktop;
end;

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

  if SkinData.Skinned then begin
    PathDialogForm := TPathDialogForm.Create(Application);
    PathDialogForm.InitLngCaptions;

    PathDialogForm.sBitBtn3.Visible := sdAllowCreate in DialogOptions;

    try
      PathDialogForm.sShellTreeView1.Root := FRoot;
      if (s <> '') and DirectoryExists(s) then PathDialogForm.sShellTreeView1.Path := s;
      if PathDialogForm.ShowModal = mrOk then begin
        s := PathDialogForm.sShellTreeView1.Path;
        if (s <> '') and DirectoryExists(s) then begin
          InitialDir := s;
          Text := s;
        end;
      end;
    finally
      FreeAndNil(PathDialogForm);
    end;
  end
  else begin
  //  Flag := SelectDirectory(s, FOptions, Self.HelpContext);
    if SelectDirectory('', FRoot, s) then begin
      if (Text = '') or not MultipleDirs then Text := s else Text := s + ';' + s;
      if (s <> '') and DirectoryExists(s) then InitialDir := s;
    end;
    if CanFocus then SetFocus;
  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);
  SkinData.COC := COC_TsCustomDateEdit;

  FBlanksChar := ' ';
  FTitle := NewStr('Date select');
  FStartOfWeek := dowLocaleDefault;
  FWeekends := DefWeekends;
  FWeekendColor := clRed;
  FYearDigits := dyFour;
  FCalendarHints := TStringList.Create;
  TStringList(FCalendarHints).OnChange := CalendarHintsChanged;
  FDefBmpName := 'BTN_DATE';
  Button.Parent := nil;
  GlyphMode.AssignDefaultBitmap;
  Button.Parent := Self;
  FShowCurrentDate := True;

  ControlState := ControlState + [csCreating];
  Width := 86;
  try
    UpdateFormat;
  finally
    ControlState := ControlState - [csCreating];
  end;
end;

destructor TsCustomDateEdit.Destroy;
begin
  if FHooked then begin
    Application.UnhookMainWindow(FormatSettingsChange);
    FHooked := False;
  end;
  if Assigned(FPopupwindow) then FPopupWindow := nil;
  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