spskinshellctrls.pas

一套及时通讯的原码

  TspSkinFileEdit = class(TspSkinEdit)
  protected
    FDlgSkinData: TspSkinData;
    FDlgCtrlSkinData: TspSkinData;
    OD: TspSkinOpenDialog;
    FLVHeaderSkinDataName: String;
    function GetFilter: String;
    procedure SetFilter(Value: String);
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ButtonClick(Sender: TObject);
  published
    property Filter: String read GetFilter write SetFilter;
    property DlgSkinData: TspSkinData read FDlgSkinData write FDlgSkinData;
    property DlgCtrlSkinData: TspSkinData read FDlgCtrlSkinData write FDlgCtrlSkinData;
    property LVHeaderSkinDataName: String
      read FLVHeaderSkinDataName write FLVHeaderSkinDataName;
  end;

  TspSkinSaveFileEdit = class(TspSkinEdit)
  protected
    FDlgSkinData: TspSkinData;
    FDlgCtrlSkinData: TspSkinData;
    OD: TspSkinSaveDialog;
    FLVHeaderSkinDataName: String;
    function GetFilter: String;
    procedure SetFilter(Value: String);
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ButtonClick(Sender: TObject);
  published
    property Filter: String read GetFilter write SetFilter;
    property DlgSkinData: TspSkinData read FDlgSkinData write FDlgSkinData;
    property DlgCtrlSkinData: TspSkinData read FDlgCtrlSkinData write FDlgCtrlSkinData;
    property LVHeaderSkinDataName: String
      read FLVHeaderSkinDataName write FLVHeaderSkinDataName;
  end;

  TspOpenPictureDlgForm = class(TForm)
  private
    FromFLV: Boolean;
    FromFTV: Boolean;
    FromDCB: Boolean;
    SaveMode: Boolean;
  public
    FileName: String;
    DSF: TspDynamicSkinForm;
    DirTreeViewPanel: TspSkinExPanel;
    FileListViewPanel,
    BottomPanel: TspSkinPanel;
    Splitter, Splitter2: TspSkinSplitter;
    DTVHScrollBar, DTVVScrollBar,
    FLVHScrollBar, FLVVScrollBar: TspSkinScrollBar;
    DirTreeView: TspSkinDirTreeView;
    FileListView: TspSkinFileListView;
    FileNameEdit: TspSkinEdit;
    FilterComboBox: TspSkinFilterComboBox;
    OpenButton, CancelButton: TspSkinButton;
    OpenFileLabel, FileTypeLabel: TspSkinStdLabel;
    ToolPanel: TspSkinPanel;
    ListToolButton, ReportToolButton,
    IconToolButton, SmallIconToolButton, BackToolButton: TspSkinSpeedButton;
    Bevel1, Bevel2, Bevel3: TspSkinBevel;
    DriveBox: TspSkinShellDriveComboBox;
    SortNameToolButton, SortSizeToolButton, SortDateToolButton: TspSkinSpeedButton;
    //
    ImagePanel: TspSkinPanel;
    Image: TImage;
    ScrollBox: TspSkinScrollBox;
    SBVScrollBar, SBHScrollBar: TspSkinScrollBar;
    Bevel4: TspSkinBevel;
    StretchButton: TspSkinSpeedButton;
    constructor CreateEx(AOwner: TComponent; ASaveMode: Boolean);
    procedure DCBChange(Sender: TObject);
    procedure FLVChange(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure DTVChange(Sender: TObject; Node: TTreeNode);
    procedure FCBChange(Sender: TObject);
    procedure OpenButtonClick(Sender: TObject);
    procedure ToolPanelOnResize(Sender: TObject);
    procedure FLVDBLClick(Sender: TObject);
    procedure EditKeyPress(Sender: TObject; var Key: Char);

    procedure StretchButtonClick(Sender: TObject);
    procedure ReportToolButtonClick(Sender: TObject);
    procedure ListToolButtonClick(Sender: TObject);
    procedure SmallIconToolButtonClick(Sender: TObject);
    procedure IconToolButtonClick(Sender: TObject);
    procedure BackToolButtonClick(Sender: TObject);

    procedure SortNameToolButtonClick(Sender: TObject);
    procedure SortSizeToolButtonClick(Sender: TObject);
    procedure SortDateButtonClick(Sender: TObject);
  end;

  TspSkinOpenPictureDialog = class(TComponent)
  private
    FLVHeaderSkinDataName: String;
    FAlphaBlend: Boolean;
    FAlphaBlendValue: Byte;
    FAlphaBlendAnimation: Boolean;
    FSD: TspSkinData;
    FCtrlFSD: TspSkinData;
    FDefaultFont: TFont;
    FTitle: String;
    FDlgFrm: TspOpenPictureDlgForm;
    FOnChange: TNotifyEvent;
    FInitialDir: String;
    FFilter: String;
    FFileName: String;
    FFilterIndex: Integer;
    function GetTitle: string;
    procedure SetTitle(const Value: string);
    procedure SetDefaultFont(Value: TFont);
  protected
    FSaveMode: Boolean;
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
    procedure Change;
  public
    ImagePanelWidth, TreePanelWidth: Integer;
    TreePanelRollState: Boolean;
    ListViewStyle: TViewStyle;
    DialogWidth, DialogHeight: Integer;
    DialogStretch: Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    property LVHeaderSkinDataName: String
     read FLVHeaderSkinDataName write FLVHeaderSkinDataName;
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinData: TspSkinData read FSD write FSD;
    property CtrlSkinData: TspSkinData read FCtrlFSD write FCtrlFSD;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property Title: string read GetTitle write SetTitle;
    property InitialDir: String read FInitialDir write FInitialDir;
    property Filter: String read FFilter write FFilter;
    property FilterIndex: Integer read FFilterIndex write FFilterIndex;
    property FileName: String read FFileName write FFileName;
  end;

  TspSkinSavePictureDialog = class(TspSkinOpenPictureDialog)
  public
    constructor Create(AOwner: TComponent); override;
  end;


implementation

{$R spSkinShellCtrls}

const
  DefaultMask = '*.*';

  FILE_SUPPORTS_ENCRYPTION = 32;
  FILE_SUPPORTS_OBJECT_IDS = 64;
  FILE_SUPPORTS_REPARSE_POINTS = 128;
  FILE_SUPPORTS_SPARSE_FILES = 256;
  FILE_VOLUME_QUOTAS = 512;

  SHGFI = SHGFI_SYSICONINDEX or SHGFI_SMALLICON;

var
  drives: set of 0..25;
  CurPath: String;

function GetMediaPresent(Value: TDiskSign) :Boolean;
var
  ErrorMode: Word;
  bufRoot :pchar;
  a,b,c,d :dword;
begin
  if (Value = 'A:') or (Value = 'B:')
  then
    begin
      Result := False;
      Exit;
    end;
  bufRoot:=stralloc(255);
  strpcopy(bufRoot,Value+'\');
  ErrorMode:=SetErrorMode(SEM_FailCriticalErrors);
  try
    try
      result:=GetDiskFreeSpace(bufRoot,a,b,c,d);
    except
      result:=False;
    end;
  finally
    strdispose(bufroot);
    SetErrorMode(ErrorMode);
  end;
end;

constructor TspSkinFileListView.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 ReadOnly := True;
 fselectedfiles:=tStringlist.create;
 Createimages;
 ShortDateFormat:='mm/dd/yyyy';
 LongTimeFormat:='hh:nn';
 FMask:=DefaultMask;
 FSortForward:=True;
 FSortColumn:=0;
 OnCompare:=CompareFiles;
 OnColumnClick:=ColumnClick;
 if csdesigning in componentstate then
   fdirectory:='c:\';
end;

destructor TspSkinFileListView.Destroy;
begin
 LImageList.Free;
 SImageList.Free;
 fSelectedFiles.Free;
 inherited Destroy;
end;

function TspSkinFileListView.IsFile;
begin
  Result := Item.SubItems[5]='file';
end;

function TspSkinFileListView.GetSelectedNum: Integer;
begin
  Result:=SelCount;
  if Result=0 then
    Result:=Items.Count;
end;

function TspSkinFileListView.GetSelectedSize: Integer;
var
  i, FSize: UInt;
  FName: String;
  FInfo: TWin32FindData;
  hFindFile: THandle;
begin
  Result:=0;
  FSize:=0;
  hFindFile:=0;
  if SelCount=0 then
    exit;
  for i:=0 to Items.Count-1 do begin
    if Items[i].selected then begin
      FName:=ExtractFileName(Items[i].SubItems[4]+#0);
      hFindFile:=FindFirstFile(pChar(FName),FInfo);
      if hFindFile<>INVALID_HANDLE_VALUE then
        FSize:=FSize+((FInfo.nFileSizeHigh*MAXDWORD)+FInfo.nFileSizeLow);
    end;
  end;
  Windows.FindClose(hFindFile);
  Result:=FSize;
end;

function TspSkinFileListView.GetDirectory: String;
begin
  Result:=FDirectory;
end;

procedure TspSkinFileListView.SetDirectory(NewDir: String);
begin
  if AnsiCompareText(NewDir,FDirectory)=0 then
    exit;
  if (UpperCase(NewDir)='DRIVES') then begin
    FDirectory:=NewDir;
    UpdateFileList;
  end else begin
    if not DirectoryExists(NewDir) then
      exit;
    NewDir:=IncludeTrailingBackslash(NewDir);
    SetCurrentDir(NewDir);
    FDirectory:=NewDir;
    UpdateFileList;
  end;
end;

procedure TspSkinFileListView.SetMask(const NewMasks: String);
begin
  if FMask<>NewMasks then begin
    FMask:=NewMasks;
    UpdateFileList;
  end;
end;

function TspSkinFileListView.GetFileName: String;
begin
  Result:=FFileName;
end;

procedure TspSkinFileListView.SetFileName(NewFile: String);
begin
  if FFileName <> NewFile then FFileName:=NewFile;
end;

procedure TspSkinFileListView.SetFileType(NewFileType: TFileType);
begin
  if NewFileType<>FFileType then begin
    FFileType:=NewFileType;
    UpdateFileList;
  end;
end;

procedure TspSkinFileListView.Createimages;
var
  SysImageList: uint;
  SFI: TSHFileInfo;
begin
  Largeimages:=TImageList.Create(self);
  SysImageList:=SHGetFileInfo('',0,SFI,SizeOf(TSHFileInfo),SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
  if SysImageList<>0 then begin
    Largeimages.Handle:=SysImageList;
    Largeimages.ShareImages:=TRUE;
  end;
  Smallimages:=TImageList.Create(Self);
  SysImageList:=SHGetFileInfo('',0,SFI,SizeOf(TSHFileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  if SysImageList<>0 then begin
    Smallimages.Handle:=SysImageList;
    Smallimages.ShareImages:=TRUE;
  end;
end;

procedure TspSkinFileListView.CreateWnd;
begin
  inherited;
  Font.Size:=8;
  Font.Name:='MS Sans Serif';
  if Columns.Count=0 then begin
    with Columns.Add do begin
      Caption:='Name';
      Width:=200;
    end;
    with Columns.Add do	begin
      Caption:='Size';
      Width:=70;
      Alignment:=taRightJustify;
    end;
    with Columns.Add do	begin
      Caption:='Type';
      Width:=90;
    end;
    with Columns.Add do	begin
      Caption:='Modified';
      Width:=100;
    end;
    with Columns.Add do	begin
      Caption:='Attributes';
      width:=60;
    end;
    UpdateFileList;
  end;
end;

procedure TspSkinFileListView.ColumnClick(Sender: TObject;
  Column: TListColumn);
var
  required_column: integer;
begin
  required_column:=Column.Index;
  if required_column=FSortColumn then
    FSortForward:=not FSortForward
  else begin
    FSortColumn:=required_column;
    FSortForward:=True;
  end;
  SortType:=stData;
  SortType:=stNone;
end;

procedure TspSkinFileListView.CompareFiles(Sender: TObject; Item1,
	Item2: TListItem; Data: Integer; var Compare: Integer);
var
  s1,s2,Caption1, Caption2: String;
  size1, size2: Double;
  result: integer;
begin
  Result := 0;
  if (UpperCase(FDirectory) = 'DRIVES') then Exit;
  if (Item1.SubItems[0] = ' ') and (Item2.SubItems[0] <> ' ')
  then
    Result := -1
  else
  if (Item1.SubItems[0] <> ' ') and (Item2.SubItems[0] = ' ')
  then
    Result := 1
  else
  case FSortColumn of
    0:
      begin
        Caption1 := AnsiUpperCase(Item1.Caption);
        Caption2 := AnsiUpperCase(Item2.Caption);
        if Caption1 > Caption2
        then
          Result := 1
        else
        if Caption1 < Caption2
        then
          Result := -1
      end;
    1:
      begin
        s1 := Item1.SubItems[0];
        s2 := Item2.SubItems[0];
        if (s1 = '') or (s1 = ' ') then s1 := '0';
        if (s2 = '') or (s2 = ' ') then s2 := '0';
        size1 := StrToFloat(s1);
        size2 := StrToFloat(s2);
        if size1 > size2
        then Result := 1
        else Result := -1;
      end;
    3:
      begin
        s1 := Item1.SubItems[2];
        s2 := Item2.SubItems[2];
        size1 := StrToDateTime(s1);
        size2 := StrToDateTime(s2);
        if size1 > size2
        then Result := 1
        else Result := -1;
      end;

  end;
  if FSortForward then
    Compare:= - result
  else
    Compare := result;
end;


procedure TspSkinFileListView.Keydown(var Key: Word; Shift: TShiftState);
begin
 if ((Shift=[ssCtrl]) and (key=vk_up)) or (key=vk_back) then
   OneLevelUp
 else
   if (key=vk_return) and assigned(selected) then
     DblClick;
 inherited;
end;

procedure TspSkinFileListView.UpdateFileList;
var
  oldCur: TCursor;
  MaskPtr: PChar;
  AttrIndex: TFileAttr;
  Ptr: PChar;
  DirAttr, FileAttr: DWORD;
  FName: String;
const
  dwFileAttr: array[TFileAttr] of DWord = (FILE_ATTRIBUTE_READONLY,
		FILE_ATTRIBUTE_HIDDEN, FILE_ATTRIBUTE_SYSTEM,