spskinshellctrls.pas

P2P即时通讯源码(DELPHI编写)

  end;

  TspSkinDirectoryEdit = class(TspSkinEdit)
  protected
    FDlgSkinData: TspSkinData;
    FDlgCtrlSkinData: TspSkinData;
    SD: TspSkinSelectDirectoryDialog;
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ButtonClick(Sender: TObject);
  published
    property DlgSkinData: TspSkinData read FDlgSkinData write FDlgSkinData;
    property DlgCtrlSkinData: TspSkinData read FDlgCtrlSkinData write FDlgCtrlSkinData;
  end;

  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;
    MyDocToolButton: 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 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 MyDocToolButtonClick(Sender: TObject);
  end;

  TspSkinOpenPictureDialog = class(TComponent)
  private
    FFiles: TStringList;
    FMultiSelection: Boolean;
    FSkinMessage: TspSkinMessage;
    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;
    property Files: TStringList read FFiles;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    property MultiSelection: Boolean read FMultiSelection write FMultiSelection;
    property SkinMessage: TspSkinMessage
       read FSkinMessage write FSkinMessage;
    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;

  function GetPersonalRoot(H: THandle): String;

implementation
  Uses spConst;
{$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 GetPersonalRoot(H: THandle): String;
const
  CSIDL_PERSONAL = $0005;
var
  Root: PItemIDList;
  Path: LPSTR;
begin
  Path := StrAlloc(MAX_PATH);
  SHGetSpecialFolderLocation(H, CSIDL_PERSONAL, Root);
  if SHGetPathFromIDList(Root, Path)
  then
    Result := Path
  else
    Result := '';
  StrDispose(Path);
end;

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;
 FMask := DefaultMask;
 FSortForward := True;
 FSortColumn := 0;
 OnCompare:=CompareFiles;
 OnColumnClick:=ColumnClick;
 if csDesigning in ComponentState then fdirectory := 'c:\';
 FSkinMessage := nil;
end;

procedure TspSkinFileListView.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSkinMessage)
  then
    FSkinMessage := nil;
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);

function IsDrive(S: String): Boolean;
var
  D: Char;
  ErrorMode: Word;
begin
  if (Length(S) = 3) and (Pos(':\', S) <> 0)
  then
    begin
      D := S[1];
      if D in ['a'..'z'] then Dec(D, $20);
      ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
      try
        if DiskSize(Ord(D) - $40) = -1
        then
          begin
            MessageBeep(MB_IconHand);
            if FSkinMessage = nil
            then
               MessageDlg(SP_NODISKINDRIVE, mtWarning, [mbOK], 0)
            else
              SkinMessage.MessageDlg(SP_NODISKINDRIVE,
                mtWarning, [mbOK], 0);
            Result := False
          end
        else
          Result := True;
      finally
        SetErrorMode(ErrorMode);
      end;
    end
  else
    Result := True;
end;

begin
  if AnsiCompareText(NewDir,FDirectory) = 0 then Exit;
  if (UpperCase(NewDir)='DRIVES')
  then
    begin
      FDirectory:=NewDir;
      UpdateFileList;
    end
  else
   begin
     if not IsDrive(NewDir) then Exit;
     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;
  if Columns.Count=0 then begin
    with Columns.Add do begin
      Caption := SP_FLV_NAME;
      Width := 200;
    end;
    with Columns.Add do	begin
      Caption := SP_FLV_SIZE;
      Width := 70;
      Alignment := taRightJustify;
    end;
    with Columns.Add do	begin
      Caption := SP_FLV_TYPE;
      Width := 90;
    end;
    with Columns.Add do	begin
      Caption := SP_FLV_MODIFIED;
      Width := 100;
    end;
    with Columns.Add do	begin
      Caption := SP_FLV_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;