rzshellopenform.pas

Raize控件汉化版

      ext: string;
    begin
      if FileTypesCbx.ItemIndex <> -1 then
        ext := ExtractFileExt( PFilterItemRec( FileTypesCbx.Items.Objects[FileTypesCbx.ItemIndex] ).FExtension )
      else
        ext := '';
      if ( ext <> '' ) then
      begin
        if AnsiCompareText( ExtractFileExt( pathname ), ext )<>0 then
        begin
          pathname := EnsureTrailingCharDB( pathname, '.' ) + Copy( ext,2,MAXINT );
          if AnsiCompareText( ext, '.'+DefaultExt )<>0 then
            Options := Options + [osoExtensionDifferent]
          else
            Options := Options - [osoExtensionDifferent];
        end;
      end
      else
      begin
        pathname := EnsureTrailingCharDB( pathname, '.' ) + DefaultExt;
        Options := Options - [osoExtensionDifferent];
      end;
    end;
  var
    ext: string;
  begin
    if DefaultExt <> '' then
    begin
      ext := ExtractFileExt( pathname );
      if Length( ext ) > 0 then
      begin
        if IsExtensionRegistered( ext ) then
          Options := Options + [osoExtensionDifferent]
        else
        begin
          HandleUnregisteredExt;
        end;
      end
      else
      begin
        HandleUnregisteredExt;
      end;
    end;
  end; {HandleDefaultExt}

  { Look for invalid chars and simple invalid sequences. }
  function InitialValidityCheck( s: string ): Boolean;
    function AllCharsValid( s: string ): Boolean;
    var i: Integer;
    begin
      i := 1;
      while ( i <= Length( s ) ) do
      begin
        if IsDBCSLeadByte( Byte( s[i] ) ) then
          Inc( i,2 )
        else if s[i] in ['/', '|','<','>'] then
        begin
          Result := False;
          Exit;
        end
        else
          Inc( i );
      end;
      Result := True;
    end;

    function DoubleBackslashOk( s: string ): Boolean;
    var i: Integer;
    begin
      Result := True;
      i := 3;
      while ( i <= Length( s ) ) do
      begin
        if IsDBCSLeadByte( Byte( s[i] ) ) then
          Inc( i,2 )
        else if ( s[i] = '\' ) and ( s[i-1] = '\' ) then
        begin
          Result := False;
          Break;
        end
        else
          Inc( i );
      end;
    end;
  begin
    Result := AllCharsValid( s ) and DoubleBackslashOk( s );
  end;

var sl: TStrings;
    i, li: Integer;
    curpathname, curname, curpath, curfldpath: string;
    firstFound: TListItem;

begin {ParseInputstring}
  Result := False;
  sl := TStringList.Create;
  FSelections.Clear;
  try
    if AnyOfThisCharDB( ins, '"' ) then
      ParametizeDB_special( ins, sl )
    else
      sl.Add( ins );

    curfldpath := GetCurrentFolderPath;
    EnsureTrailingCharDB( curfldpath, '\' );

    if sl.Count > 0 then
    begin
      for i := 0 to sl.Count-1 do
      begin
        if not ( osoNoValidate in Options ) and not InitialValidityCheck( ins ) then
        begin
          ThisFilenameIsNotValid( Caption, ins );
          Exit;
        end;

        curpathname := ApplyPathname( curfldpath, sl[i] );
        if ( curpathname='' ) then Continue;

        if IfFolderOpenIt( curpathname ) then
          Exit;

        if not ( osoNoDereferenceLinks in Options ) then
          curpathname := DereferenceShortcut( curpathname );

        if ( sl.Count=1 ) then
        begin
          if ( FLastInputState = lisList ) and Assigned( ShellList.SelectedItem ) then
            curpathname := ShellList.SelectedItem.Pathname
          else // FLastInputState = lisEdit
          begin
            HandleDefaultExt( curpathname );

            curname := ExtractFileName( curpathname );
            curpath := ExtractFilePath( curpathname );
            EnsureTrailingCharDB( curpath, '\' );

            if AnsiCompareText( curpath, curfldpath )<>0 then
              ShellCombo.SelectedFolder.Pathname := ExtractFilePath( curpathname );

            firstFound := nil;
            for li := 0 to ShellList.Items.Count-1 do
            begin
              if AnsiCompareText( ShellList.Items[li].Caption, curname )=0 then
              begin
                if Assigned( firstFound ) then
                begin
                  ThereCanBeOnlyOne( Caption, curname );
                  firstFound.Selected := True;
                  firstFound.Focused := True;
                  ShellList.SetFocus;
                  Exit;
                end
                else
                  firstFound := ShellList.Items[li];
              end;
              if Assigned( firstFound ) then
                curpathname := TRzShellListData( firstFound.Data ).Pathname;
            end;
          end;
          Result := ApplyOptions( curpathname, Options );
        end {if sl.Count=1}
        else
          Result := ApplyOptions( curpathname, Options );  // v1.3h
//          Result := ApplyOptions( curpathname, Options + [osoFileMustExist] );  pre v1.3h

        if Result then
          FSelections.Add( curpathname )
        else
          Exit;
      end;
    end;
  finally
    sl.Free;
    if not Result then FSelections.Clear;
  end;
end; {TRzShellOpenSaveForm.ParseInputstring}


procedure TRzShellOpenSaveForm.FormCloseQuery( Sender: TObject; var CanClose: Boolean );
var fname: string;
begin
  if ModalResult = mrOk then
  begin
    fname := ExtractFileName( FileNameEdt.Text );
    if AnyWildcardsDB( fname ) then
    begin
      CanClose := False;
      ParseInputstring( ExtractFilePath( FileNameEdt.Text ) );
      ApplyUserFilter( fname );
      FileNameEdt.Text := fname;
      FileNameEdt.SelectAll;
    end
    else
    begin
      CanClose := ParseInputstring( FileNameEdt.Text );
    end;
  end;

  if CanClose and not ( osoNoChangeDir in Options ) and ( ShellList.Folder.PathName <> '' ) then
    try
      SetCurrentDirectory( PChar( ShellList.Folder.PathName ) );
    except
    end;
end;


procedure TRzShellOpenSaveForm.ShellTreeChange( Sender: TObject; Node: TTreeNode );
begin
  (*
  // The following prevents the FileName edit from being initialized because this
  // event is fired when the form is first displayed.
  if Executing then
    if ( node <> nil ) then
      FileNameEdt.Text := '';
  *)
end;


procedure TRzShellOpenSaveForm.FileTypesCbxSelEndOk( Sender: TObject );
begin
  if ( FUserFilter <> '' ) then
    FileNameEdt.Clear;
  FUserFilter := '';
  ShellList.FileFilter := PFilterItemRec( FileTypesCbx.Items.Objects[FileTypesCbx.ItemIndex] ).FExtension;

  if Executing then
    DoOnTypeChanged;
end;


procedure TRzShellOpenSaveForm.CreateNewFolderBtnClick( Sender: TObject );
begin
  if ShellTree.Focused or ( ShowTreeBtn.Down and ( osoHideFoldersInListWhenTreeVisible in Options ) ) then
    ShellTree.CreateNewFolder( True )
  else
    ShellList.CreateNewFolder( True );
end;


procedure TRzShellOpenSaveForm.FileNameEdtChange( Sender: TObject );
begin
  if Executing then
    FLastInputState := lisEdit;
end;


procedure TRzShellOpenSaveForm.Paste1MitmClick( Sender: TObject );
begin
  ShellList.DoCommandForFolder( RZSH_CMDS_PASTE );
end;


procedure TRzShellOpenSaveForm.Properties1MitmClick( Sender: TObject );
begin
  ShellList.DoCommandForFolder( RZSH_CMDS_PROPERTIES );
end;


function TRzShellOpenSaveForm.FormHelp( Command: Word; Data: Integer; var CallHelp: Boolean ): Boolean;
begin
  if Assigned( OnFormHelp ) then
    Result := OnFormHelp( command, data, callhelp )
  else
    Result := False;
end;


procedure TRzShellOpenSaveForm.HelpBtnClick( Sender: TObject );
begin
  //Application.HelpContext( HelpContext ); // FormHelp is still called in this case
  // There is a bug in Delphi 6 and 7 that causes Application.HelpContext fail to generate a wm_Help message.
  // This causes problems with help systems, especially CHM help.  The following is a work-around.
  Application.HelpCommand( HELP_CONTEXT, HelpContext );
end;


procedure TRzShellOpenSaveForm.DoHide;
begin
  FExecuting := False;
  inherited;
  DoOnFormClose;
end;


procedure TRzShellOpenSaveForm.DoShow;

  procedure SetPnlEditsHeight;
  var
    I, Max: Integer;
  begin
    Max := 0;
    for I := 0 to PnlEdits.ControlCount - 1 do
      with PnlEdits.Controls[ i ] do
        if Visible then
          with BoundsRect do
            if bottom > max then
              max := bottom;
    PnlEdits.Height := max + 8;
  end;

var
  ofsx: Integer;
  tmps1: string;
begin {= TRzShellOpenSaveForm.DoShow =}
  Screen.Cursor := crHourglass;
  Cursor := crHourglass;
  inherited;
  Font.Name := SDialogFontName;
  FileTypesCbx.Perform( CB_SETEXTENDEDUI, 1,0 );

 // If no tree button, then hide it and move the other buttons across a bit
  if not ( osoAllowTree in Options ) then
  begin
    ShowTreeBtn.Visible := False;
    ofsx := ListBtn.Left - ShowTreeBtn.Left;
    ListBtn.Left := ListBtn.Left - ofsx;
    DetailsBtn.Left := DetailsBtn.Left - ofsx;
  end;

  SetPnlEditsHeight;

  DoTranslation;

  ShowTree( osoShowTree in Options );  // Causes events that cause edit field to be reset.

  tmps1 := ExtractFilePath( Filename );
  if ( InitialDir = '' ) then
    if Length( tmps1 ) <> 0 then
    begin
      ShellCombo.SelectedFolder.Pathname := tmps1;
      tmps1 := ExtractFileName( Filename );
      if ( tmps1 <> '' ) then
        Filename := tmps1;
    end
    else
      ShellCombo.SelectedFolder.Pathname := GetCurrentDir
  else
    ShellCombo.SelectedFolder.Pathname := InitialDir;

  FLastInputState := lisList;

  FExecuting := True;

  DoOnFormShow;

  Cursor := crDefault;
  Screen.Cursor := crDefault;
end; {= TRzShellOpenSaveForm.DoShow =}


procedure TRzShellOpenSaveForm.ReadOnlyChkClick( Sender: TObject );
begin
  if ReadOnlyChk.Checked then
    Include( FOptions, osoReadOnly )
  else
    Exclude( FOptions, osoReadOnly );
end;


procedure TRzShellOpenSaveForm.ShellListFolderChanged( Sender: TObject );
begin
  if Executing then
    DoOnFolderChanged;
end;


procedure TRzShellOpenSaveForm.FormResize( Sender: TObject );
const
  BUTTON_RIGHT_MARGIN = 16; // was 4 pre v1.h, increased to accomodate size-grip
var
  W, X, Y: Integer;
begin
  inherited;

  Y := ShellCombo.BoundsRect.Bottom + 8;
  RzSplitter1.BoundsRect := Rect( 0, Y, PnlWork.Width - 8, PnlEdits.Top );
  
  W := OpenBtn.Width;

  X := PnlWork.Width - w - BUTTON_RIGHT_MARGIN;

  OpenBtn.Left := X;
  CancelBtn.Left := X;
  HelpBtn.Left := X;

  FileNameCbx.Width := X - FileNameCbx.Left - 8;
  FileNameEdt.Width := X - FileNameEdt.Left - 8;
  FileTypesCbx.Width := X - FileTypesCbx.Left - 8;

  SetWindowPos( FHGripWindow, HWND_TOP, ClientRect.Right-SIZEGRIP_SIZE, ClientRect.Bottom - SIZEGRIP_SIZE, 0, 0,
                SWP_NOSIZE );
end; {= TRzShellOpenSaveForm.FormResize =}


procedure TRzShellOpenSaveForm.ShowDesktopBtnClick( Sender: TObject );
begin
  ShellList.Folder.CSIDL := csidlDesktop;
end;


{$IFDEF VCL60_OR_HIGHER}

procedure TRzShellOpenSaveForm.JumpToPlace( Num: Integer );
begin
  if TRzPlaceData( FPlacesList[ Num ] ).CSIDL <> csidlNone then
  begin
    ShellList.Folder.CSIDL := TRzPlaceData( FPlacesList[ Num ] ).CSIDL;
  end
  else
  begin
    ShellList.Folder.PathName := TRzPlaceData( FPlacesList[ Num ] ).Path;
  end;
end;

{$ENDIF}

procedure TRzShellOpenSaveForm.btnPlaceClick(Sender: TObject);
begin
  {$IFDEF VCL60_OR_HIGHER}
  JumpToPlace( TRzToolButton( Sender ).Tag );
  {$ELSE}
  case TRzToolButton( Sender ).Tag of
    0: ShellList.Folder.CSIDL := csidlRecent;
    1: ShellList.Folder.CSIDL := csidlDesktop;
    2: ShellList.Folder.CSIDL := csidlPersonal;
    3: ShellList.Folder.CSIDL := csidlDrives;
    4: ShellList.Folder.CSIDL := csidlNetwork;
  end;
  {$ENDIF}
end;


end.