⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sopendialog.pas

📁 Alpha Controls 界面控件包
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit sOpenDialog;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ToolWin,
  ComCtrls, sToolBar, sSkinProvider, Buttons, sSpeedButton, StdCtrls, sLabel, FileCtrl,
  ExtCtrls, sPanel, sEdit, sListView, sComboBox, sButton, Menus,
  sCheckBox, sFileCtrl, sComboBoxes, acShellCtrls, ActnList;

type

  TsSkinOpenDialog = class(TOpenDialog)
  end;

  TsOpenDialogForm = class(TForm)
    sSkinProvider1: TsSkinProvider;
    BackBtn: TsSpeedButton;
    UpBtn: TsSpeedButton;
    CreateDirBtn: TsSpeedButton;
    KindBtn: TsSpeedButton;
    FileNameEdit: TsEdit;
    FileTypeBox: TsFilterComboBox;
    sButton1: TsButton;
    sButton2: TsButton;
    BtnHelp: TsButton;
    PopupMenu1: TPopupMenu;
    List1: TMenuItem;
    Icons1: TMenuItem;
    Icons2: TMenuItem;
    HistMenu: TPopupMenu;
    CheckBoxReadOnly: TsCheckBox;
    FileListView: TsDlgShellListView;
    Smallicons1: TMenuItem;
    DriveComboBox: TsShellComboBox;
    ActionList1: TActionList;
    ActionOk: TAction;
    ActionCancel: TAction;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure List1Click(Sender: TObject);
    procedure Icons1Click(Sender: TObject);
    procedure Icons2Click(Sender: TObject);
    procedure FileListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure KindBtnClick(Sender: TObject);
    procedure UpBtnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BackBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FileTypeBoxChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure CreateDirBtnClick(Sender: TObject);
    procedure BtnHelpClick(Sender: TObject);
    procedure Smallicons1Click(Sender: TObject);
    procedure FileListViewDblClick(Sender: TObject);
    procedure DriveComboBoxChange(Sender: TObject);
  public
    FileName: string;
    HistList: TStringList;
    Owner: TOpenDialog;
    FileListViewWidth: Integer;
    OpenZipFiles : boolean;
    constructor Create(AOwner: TComponent); override;
    procedure AddNewHist(S: string);
    procedure DeleteHistMenu(MenuItem: TMenuItem);
    procedure OnHistClick(Sender: TObject);
    procedure FolderChanged;
    procedure AddPathToHistory(Path : string);
    procedure InitLngCaptions;
  end;


implementation

uses acUtils, sDialogs, sStrings, Commctrl;

var
  Returning: Boolean;

{$R *.DFM}

procedure TsOpenDialogForm.sButton1Click(Sender: TObject);
var
  i : integer;
begin
  if FileListView.IsEditing then begin
    FileListView.AutoRefresh := False;
    ModalResult := mrNone;
    ListView_EditLabel(FileListView.Handle, -1);
    FileListView.AutoRefresh := True;
  end
  else if FileListView.Focused and Assigned(FileListView.Selected) and
    FileListView.Folders[FileListView.Selected.Index].IsFolder(FileListView.Folders[FileListView.Selected.Index].PathName, OpenZipFiles) then begin
    ModalResult := mrNone;
    FileListView.SetPathFromID(FileListView.Folders[FileListView.Selected.Index].AbsoluteID);
  end
  else begin
    if FileNameEdit.Text = '' then Exit;
    if pos('*', FileNameEdit.Text) > 0 then begin
      for i := 0 to FileTypeBox.MaskList.Count - 1 do begin
        if FileTypeBox.MaskList[i] = FileNameEdit.Text then begin
          FileTypeBox.ItemIndex := i;
        end;
      end;
      FileListView.Mask := FileNameEdit.Text;
      ModalResult := mrNone;
      Exit;
    end;
    if DirectoryExists(FileNameEdit.Text) then begin
      SetCurrentDir(FileNameEdit.Text);
      DriveComboBox.Path := FileNameEdit.Text;
      FileListView.TreeUpdate(DriveComboBox.Folders[DriveComboBox.ItemIndex].AbsoluteID);
      Exit;
    end;
    if Owner.Files.Count > 1
      then FileName := Owner.Files[Owner.Files.Count - 1]
      else FileName := DriveComboBox.Path + FileNameEdit.Text;

    // Added 12/11/05 by Richard Shotbolt
    if (ExtractFileExt(FileName) = '') and (Owner.DefaultExt <> '') then
      FileName := FileName + '.' + Owner.DefaultExt;
    //-----------------------------------
    // ofOverWritePrompt
    if (ofOverWritePrompt in Owner.Options) and ((Owner is TsSaveDialog) or
      (Owner is TsSavePictureDialog)) and FileExists(FileName) then begin
    // Changed 12/11/05 by Richard Shotbolt
   //    if CustomRequest(ExtractFilePath(FileName) +
      if CustomRequest(ExtractFileName(FileName) +
    //-------------------------------------------------
        #13#10'File exists. Overwrite?') then ModalResult := mrOk;
      Exit;
    end;
    // ofPathMustExist
    if (ofPathMustExist in Owner.Options) and not
      DirectoryExists(ExtractFilePath(FileName)) then begin
      ShowWarning(ExtractFilePath(FileName) + #13#10'Path not found');
      Exit;
    end;
    if not FileExists(FileName) then begin
      // ofCreatePrompt
      if (ofCreatePrompt in Owner.Options) then
        if CustomRequest(FileName + #13#10'File not found. Create?') then begin
          FileCreate(FileName);
        end
        else
          Exit;
      // ofFileMustExist
      if (ofFileMustExist in Owner.Options) and not FileExists(FileName) then begin
        ShowWarning(FileName + #13#10'File not found');
        Exit;
      end;
    end;
    ModalResult := mrOk;
  end;
end;

procedure TsOpenDialogForm.sButton2Click(Sender: TObject);
begin
  if FileListView.IsEditing then begin
    FileListView.AutoRefresh := False;
    ModalResult := mrNone;
    ListView_EditLabel(FileListView.Handle, -1);
    FileListView.AutoRefresh := True;
  end
  else ModalResult := mrCancel;
end;

procedure TsOpenDialogForm.List1Click(Sender: TObject);
begin
  FileListView.ViewStyle := vsList;
  List1.Checked := True;
  Icons1.Checked := False;
  Icons2.Checked := False;
  SmallIcons1.Checked := False;
end;

procedure TsOpenDialogForm.Icons1Click(Sender: TObject);
begin
  FileListView.ViewStyle := vsReport;
  List1.Checked := False;
  Icons1.Checked := True;
  Icons2.Checked := False;
  SmallIcons1.Checked := False;
end;

procedure TsOpenDialogForm.Icons2Click(Sender: TObject);
begin
  FileListView.ViewStyle := vsIcon;
  List1.Checked := False;
  Icons1.Checked := False;
  Icons2.Checked := True;
  SmallIcons1.Checked := False;
end;

procedure TsOpenDialogForm.FileListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange);
var
  CurItem: TListItem;
  i : integer;
begin
  if (Change <> ctState) or
       not Assigned(FileListView.Selected) or
         (Item <> FileListView.Items[FileListView.Selected.Index]) or
           FileListView.Folders[FileListView.Selected.Index].IsFolder(FileListView.Folders[FileListView.Selected.Index].PathName, OpenZipFiles) then Exit;
  if (csDestroying in ComponentState) or not Assigned(Owner) or (csDestroying in Owner.ComponentState) then Exit;
  if FileListView.MultiSelect and (FileListView.Items.Count > 0) then begin
    FileNameEdit.Text := '';
    Owner.Files.Clear;
    CurItem := nil;
    while True do begin
      CurItem := FileListView.GetNextItem(CurItem, sdAll, [isSelected]);
      if CurItem = nil then Break;
      if FileListView.Folders[CurItem.Index].IsFile then begin
        Owner.Files.Add({ExtractFileName(}FileListView.Folders[CurItem.Index].PathName{)});
      end;
    end;
    if Owner.Files.Count < 2 then begin
      Owner.FileName := FileListView.Folders[FileListView.Selected.Index].PathName;
      FileNameEdit.Text := ExtractFileName(FileListView.Folders[FileListView.Selected.Index].PathName);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -