rzshellopenform.pas

Raize控件汉化版

function TRzShellOpenSaveForm.GetFilterIndex: Integer;
begin
  if FileTypesCbx.Items.Count>0 then
    Result := FileTypesCbx.ItemIndex + 1
  else
    Result := 0;
end;


function TRzShellOpenSaveForm.GetFormSplitterPos: Integer;
begin
  Result := RzSplitter1.Position;
end;


function TRzShellOpenSaveForm.GetOnAddListItem: TRzShAddItemEvent;
begin
  Result := ShellList.OnAddItem;
end;


function TRzShellOpenSaveForm.GetOnAddTreeItem: TRzShAddItemEvent;
begin
  Result := ShellTree.OnAddItem;
end;


function TRzShellOpenSaveForm.GetOnAddComboItem: TRzShAddItemEvent;
begin
  {Result := ShellCombo.OnAddItem;}
end;


procedure TRzShellOpenSaveForm.SetFilename( const Value: string );
begin
  FileNameEdt.Text := Value;
end;


procedure TRzShellOpenSaveForm.SetFilter( const Value: string );
begin
  FFilter := Value;
  ShellList.FileFilter := Filter;
  FilterToTStrings( FFilter, FileTypesCbx.Items );
end;


procedure TRzShellOpenSaveForm.SetFilterIndex( Value: Integer );
begin
  if ( Value>=1 ) and ( Value <= FileTypesCbx.Items.Count ) then
  begin
    FileTypesCbx.ItemIndex := Value-1;
    FileTypesCbxSelEndOk( Self );
  end
  else if FileTypesCbx.Items.Count>0 then
    FileTypesCbx.ItemIndex := 0;
end;


procedure TRzShellOpenSaveForm.SetFormSplitterPos( Value: Integer );
begin
  RzSplitter1.Position := Value;
end;


procedure TRzShellOpenSaveForm.SetInitialDir( const Value: string );
begin
  FInitialDir := Value;
  ShellList.Folder.Pathname := Value;
end;


procedure TRzShellOpenSaveForm.SetOptions( Value: TRzOpenSaveOptions );
var
  TreeOptions: TRzShellTreeOptions;
  ListOptions: TRzShellListOptions;

  procedure ApplyListOption( Apply: Boolean; ListOpt: TRzShellListOption );
  begin
    if Apply then
      Include( ListOptions, ListOpt )
    else
      Exclude( ListOptions, ListOpt );
  end;

  procedure ApplyTreeOption( Apply: Boolean; TreeOpt: TRzShellTreeOption );
  begin
    if Apply then
      Include( TreeOptions, TreeOpt )
    else
      Exclude( TreeOptions, TreeOpt );
  end;

  procedure ApplyOptions( Apply: Boolean; TreeOpt: TRzShellTreeOption; ListOpt: TRzShellListOption );
  begin
    ApplyListOption( Apply, ListOpt );
    ApplyTreeOption( Apply, TreeOpt );
  end;

begin {= TRzShellOpenSaveForm.SetOptions =}
  FOptions := Value;

  TreeOptions := ShellTree.Options;
  ListOptions := ShellList.Options;
  ApplyOptions( osoOleDrag in Value,  stoOleDrag, sloOleDrag );
  ApplyOptions( osoOleDrop in Value,  stoOleDrop, sloOleDrop );
  ApplyOptions( osoShowHidden in Value, stoShowHidden, sloShowHidden );
  ApplyListOption( osoHideFoldersInListWhenTreeVisible in Value, sloHideFoldersWhenLinkedToTree );
  ApplyListOption( osoFilesCanBeFolders in Value, sloFilesCanBeFolders );
  ShellList.MultiSelect := ( osoAllowMultiselect in Value );
  ShellTree.Options := treeOptions;
  ShellList.Options := listOptions;

  ReadOnlyChk.Visible := not ( osoHideReadOnly in Value );
  HelpBtn.Visible := ( osoShowHelp in Value );

  ShowHint := ( osoShowHints in Value );

end; {= TRzShellOpenSaveForm.SetOptions =}


procedure TRzShellOpenSaveForm.SetOnAddListItem( Value: TRzShAddItemEvent );
begin
  ShellList.OnAddItem := Value;
end;


procedure TRzShellOpenSaveForm.SetOnAddTreeItem( Value: TRzShAddItemEvent );
begin
  ShellTree.OnAddItem := Value;
end;


procedure TRzShellOpenSaveForm.SetOnAddComboItem( Value: TRzShAddItemEvent );
begin
  {ShellCombo.OnAddItem := Value;}
end;


procedure TRzShellOpenSaveForm.ShowTree( Show: Boolean );
var
  c: TCursor;
begin
  if Show then
  begin
    if Assigned( ShellCombo.ShellTree ) and RzSplitter1.UpperLeft.Visible  then
      Exit; // Already showing

    try
      ShowTreeBtn.Down := True;
      if not Assigned( ShellCombo.ShellTree ) then
      begin
        c := Screen.Cursor;
        Screen.Cursor := crHourglass;
        try
          ShellTree.SelectedFolder := ShellCombo.SelectedFolder;
            // Assign selected folder before linking the list and combo to prevent redundant update

          ShellCombo.ShellList := nil;
          ShellCombo.ShellTree := ShellTree;
          ShellTree.ShellList := ShellList;

          RzSplitter1.UpperLeft.Visible := True;
          if FormSplitterPos < 0 then
            RzSplitter1.Position := 200
          else
            RzSplitter1.Position := FormSplitterPos;
        finally
          Screen.Cursor := c;
        end;
      end
      else
      begin
        //  Support for ptsloHideFoldersWhenLinkedToTree option
        ShellTree.ShellList := ShellList;
        ShellCombo.ShellTree := ShellTree;
        if FormSplitterPos<0 then
          RzSplitter1.Position := 200
        else
          RzSplitter1.Position := FormSplitterPos;
      end;
    except
      ShowTreeBtn.Down := False;
      raise;
    end;
    Options := Options + [osoShowTree];
    ShellTree.TabStop := True;
  end
  else // not aShow
  begin
    ShowTreeBtn.Down := False;
    if ShellTree.Focused then
      ShellList.SetFocus;
    ShellTree.TabStop := False;
    {-- Support for ptsloHideFoldersWhenLinkedToTree option}
    ShellTree.ShellList := nil;
    ShellCombo.ShellTree := nil;
    ShellCombo.ShellList := ShellList;
    FormSplitterPos := RzSplitter1.Position;
    RzSplitter1.UpperLeft.Visible := False;
    Options := Options - [osoShowTree];
  end;
  if ( ShellList.Visible ) and ( sloHideFoldersWhenLinkedToTree in ShellList.Options ) then
    ShellList.FillItems;
end; {= TRzShellOpenSaveForm.ShowTree =}


procedure TRzShellOpenSaveForm.ApplyUserFilter( Filter: string );
begin
  FUserFilter := Filter;
  ShellList.FileFilter := Filter;
  ShellList.FillItems;
end;


procedure TRzShellOpenSaveForm.GetSelectedFiles( s: TStrings );
begin
  s.Assign( FSelections );
end;


procedure TRzShellOpenSaveForm.ShellListChange( Sender: TObject; Item: TListItem; Change: TItemChange );

  procedure AddFilename( var sofar: string;  const toadd: string );
  begin
    if Length( sofar )>0 then sofar := sofar + ' ';
    sofar := sofar + '"' + toadd + '"';
  end;

var
  ld: TRzShellListData;
  vsi: TList; // Valid selected items
  i: Integer;
  tmpitem: TListItem;
  tmps: string;
begin
  if ( Change <> ctState ) or ( not Executing ) then
    Exit; // Only interested in selection changes

  vsi := TList.Create;
  try
    if ShellList.SelCount > 1 then
    begin
      for i := ShellList.Selected.Index to ShellList.Items.Count-1 do
      begin
        tmpitem := ShellList.Items[i];
        if tmpitem.Selected and Assigned( tmpitem.Data ) then
        begin
          ld := ShellList.ShellListData[i];
          if not ld.IsFolder then
            vsi.Add( ld );
        end;
      end;
    end
    else if ( ShellList.SelCount = 1 ) then
    begin
      tmpitem := ShellList.Selected;
      if Assigned( tmpitem ) and Assigned( tmpitem.Data ) then
      begin
        begin
          ld := ShellList.GetDataFromItem( ShellList.Selected );
          if not ld.IsFolder then
            vsi.Add( ld );
        end;
      end;
    end;

    if vsi.Count>1 then
    begin
      tmps := '';
      for i := 0 to vsi.Count-1 do
        AddFilename( tmps, TRzShellListData( vsi[i] ).FileName );
      FileNameEdt.Text := tmps;
    end
    else if vsi.Count=1 then
      FileNameEdt.Text := TRzShellListData( vsi[0] ).DisplayName;

    FLastInputState := lisList;
  finally
    vsi.Free;
  end;

  DoOnSelectionChanged;
end; {= TRzShellOpenSaveForm.ShellListChange =}


procedure TRzShellOpenSaveForm.UpOneLevelBtnClick( Sender: TObject );
begin
  ShellCombo.GoUp( 1 );
end;


procedure TRzShellOpenSaveForm.ShowTreeBtnClick( Sender: TObject );
begin
  ShowTree( ShowTreeBtn.Down )
end;


procedure TRzShellOpenSaveForm.FormDestroy( Sender: TObject );
begin
  FilterstringsFree( FileTypesCbx.Items );
end;


procedure TRzShellOpenSaveForm.FormKeyDown( Sender: TObject; var Key: Word; Shift: TShiftState );
begin
  case key of
    VK_F4:
      if Shift=[] then
      begin
        if ShellCombo.DroppedDown then
        begin
          ShellCombo.DroppedDown := False;
          ShellList.SetFocus;
          ShellCombo.Perform( CN_COMMAND, MakeLong( 0,CBN_SELENDOK ), ShellCombo.Handle );
        end
        else
        begin
          ShellCombo.SetFocus;
          ShellCombo.DroppedDown := True;
        end;
      end;

    VK_F5:
      if Shift=[] then
      begin
        if not ShellCombo.Focused then ShellCombo.FillItems;
        if not ShellList.Focused then ShellList.FillItems;
        if Assigned( ShellTree.ShellList ) and not ( ShellTree.Focused ) then
          ShellTree.RefreshNodes;
      end;

    VK_F12:
      if Shift=[] then
      begin
        if ( osoAllowTree in Options ) then
          ShowTree( not ShowTreeBtn.Down );
      end;
  end;
end;


{Do processing in WideChars for easy DBCS support. To do this sort of processing in native DBCS is a real pain - and
 possibly slower than doing the DBCS->UNICODE, UNICODE<-DBCS conversion anyway.

 Given a starting fully qualified path 'aCurrent' and a relative modifier path 'aEntered' returns the
 new fully qualified path. Supports drive-letters and UNC names.}

function ApplyPathname( aCurrent, aEntered: string ): string;
var
  wcCurrent, wcEntered, wcResult: array[0..MAX_PATH] of WideChar;

  function StrLenW( pwc: PWideChar ): Integer;
  begin
    Result := 0;
    while pwc^ <> WideChar( #0 ) do
    begin
      Inc( pwc );
      Inc( Result );
    end;
  end;


  function AllDots( wc: PWideChar ): Bool;
  begin
    while wc^ <> WideChar( #0 ) do
    begin
      if wc^ <> WideChar( '.' ) then
      begin
        Result := False;
        Exit;
      end;
      Inc( wc );  // Add 2
    end;
    Result := True;
  end;


  {Might add a wide char to the string. The caller is responsible for ensuring there is sufficient space.}
  procedure EnsureTrailingSlash( pwc: PWideChar;  len: Integer );
  begin
    if ( len<0 ) then len := StrLenW( pwc );
    Inc( pwc, len-1 );
    if ( pwc^ <> WideChar( '\' ) ) then
    begin
      ( pwc+1 )^ := WideChar( '\' );
      ( pwc+2 )^ := WideChar( #0 );
    end;
  end;


  procedure EnsureNoTrailingSlash( pwc: PWideChar;  len: Integer );
  begin
    if ( len<0 ) then len := StrLenW( pwc );
    Inc( pwc, len-1 );
    if ( pwc^ = WideChar( '\' ) ) then
      pwc^ := WideChar( #0 );
  end;


  {Returns a ptr to the position of the minimum position - the first part of the path that you cannot go back below}
  function GetMinimumSizePtr( pwc: PWideChar;  len: Integer ): PWideChar;
  begin
    if ( len<0 ) then len := StrLenW( pwc );
    if ( len>=3 ) and ( ( pwc+1 )^ = WideChar( ':' ) ) then
      Result := ( pwc+3 )
    else if ( len>2 ) and ( ( pwc+0 )^ = WideChar( '\' ) ) and ( ( pwc+1 )^ = WideChar( '\' ) ) then
    begin
      Inc( pwc, 2 );  // Skip the first two slashes
      while ( pwc^ <> WideChar( #0 ) ) and ( pwc^ <> WideChar( '\' ) ) do // Find next slash
        Inc( pwc );
      if ( pwc^ = WideChar( #0 ) ) then
      begin
        Result:=nil;
        Exit;
      end;  // If end reached here then failed

      Inc( pwc );
      while ( pwc^ <> WideChar( #0 ) ) and ( pwc^ <> WideChar( '\' ) ) do // Find next slash or end
        Inc( pwc );

      Result := ( pwc );
    end
    else
      Result := nil;
  end; {GetMinimumSizePtr - local}


  procedure RemoveRightmostElement( pwc: PWideChar );
  var len: DWORD;
      endc: PWideChar;
      minpos: PWideChar;
  begin
    len := StrLenW( pwc );
    endc := PWideChar( UINT( pwc ) + len*2 -2 );
    minpos := GetMinimumSizePtr( pwc, len );
    if UINT( minpos ) - UINT( pwc ) = len*2 then
    begin