Index: src/fdiffer.pas =================================================================== --- src/fdiffer.pas (revision 7965) +++ src/fdiffer.pas (working copy) @@ -269,7 +269,7 @@ FWaitData := WaitData; edtFileNameLeft.Text:= FileNameLeft; edtFileNameRight.Text:= FileNameRight; - FShowIdentical:= actAutoCompare.Checked; + FShowIdentical:= False;//actAutoCompare.Checked; actBinaryCompare.Checked:= not (FileIsText(FileNameLeft) and FileIsText(FileNameRight)); if actBinaryCompare.Checked then actBinaryCompareExecute(actBinaryCompare) @@ -278,7 +278,8 @@ OpenFileRight(FileNameRight); if actAutoCompare.Checked then actStartCompare.Execute; end; - if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop; + //if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop; + ShowModal; end; end; Index: src/filesources/filesystem/ufilesystemcopyoperation.pas =================================================================== --- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965) +++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy) @@ -172,6 +172,7 @@ @AppProcessMessages, @CheckOperationState, @UpdateStatistics, + @ShowCompareFilesUI, Thread, fsohmCopy, TargetPath, Index: src/filesources/filesystem/ufilesystemmoveoperation.pas =================================================================== --- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965) +++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy) @@ -137,6 +137,7 @@ @AppProcessMessages, @CheckOperationState, @UpdateStatistics, + @ShowCompareFilesUI, Thread, fsohmMove, TargetPath, Index: src/filesources/filesystem/ufilesystemutil.pas =================================================================== --- src/filesources/filesystem/ufilesystemutil.pas (revision 7965) +++ src/filesources/filesystem/ufilesystemutil.pas (working copy) @@ -83,11 +83,15 @@ FFileExistsOption: TFileSourceOperationOptionFileExists; FDirExistsOption: TFileSourceOperationOptionDirectoryExists; + FCurrentFile: TFile; + FCurrentTargetFilePath: String; + AskQuestion: TAskQuestionFunction; AbortOperation: TAbortOperationFunction; CheckOperationState: TCheckOperationStateFunction; UpdateStatistics: TUpdateStatisticsFunction; AppProcessMessages: TAppProcessMessagesFunction; + ShowCompareFilesUI: TShowCompareFilesUIFunction; MoveOrCopy: TFileSystemOperationHelperMoveOrCopy; procedure ShowError(sMessage: String); @@ -109,6 +113,7 @@ AbsoluteTargetFileName: String; AllowCopyInto: Boolean; AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists; + procedure QuestionActionHandler(Action: TFileSourceOperationUIAction); function FileExists(aFile: TFile; var AbsoluteTargetFileName: String; AllowAppend: Boolean): TFileSourceOperationOptionFileExists; @@ -121,6 +126,8 @@ AppProcessMessagesFunction: TAppProcessMessagesFunction; CheckOperationStateFunction: TCheckOperationStateFunction; UpdateStatisticsFunction: TUpdateStatisticsFunction; + ShowCompareFilesUIFunction: TShowCompareFilesUIFunction; + OperationThread: TThread; Mode: TFileSystemOperationHelperMode; TargetPath: String; @@ -315,6 +322,7 @@ AppProcessMessagesFunction: TAppProcessMessagesFunction; CheckOperationStateFunction: TCheckOperationStateFunction; UpdateStatisticsFunction: TUpdateStatisticsFunction; + ShowCompareFilesUIFunction: TShowCompareFilesUIFunction; OperationThread: TThread; Mode: TFileSystemOperationHelperMode; TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics); begin @@ -323,6 +331,7 @@ AppProcessMessages := AppProcessMessagesFunction; CheckOperationState := CheckOperationStateFunction; UpdateStatistics := UpdateStatisticsFunction; + ShowCompareFilesUI := ShowCompareFilesUIFunction; FOperationThread := OperationThread; FMode := Mode; @@ -1355,18 +1364,26 @@ Result := FDirExistsOption; end; +procedure TFileSystemOperationHelper.QuestionActionHandler( + Action: TFileSourceOperationUIAction); +begin + if Action = fsouaCompare then + ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath); +end; + function TFileSystemOperationHelper.FileExists(aFile: TFile; var AbsoluteTargetFileName: String; AllowAppend: Boolean ): TFileSourceOperationOptionFileExists; const - Responses: array[0..11] of TFileSourceOperationUIResponse + Responses: array[0..12] of TFileSourceOperationUIResponse = (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll, - fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend, - fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource); - ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse + fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, + fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger, + fsourAutoRenameSource); + ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse = (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel, - fsourOverwriteLarger, fsourAutoRenameSource); + fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource); var Answer: Boolean; Message: String; @@ -1407,8 +1424,11 @@ end; Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime); + FCurrentFile := aFile; + FCurrentTargetFilePath := AbsoluteTargetFileName; case AskQuestion(Message, '', - PossibleResponses, fsourOverwrite, fsourSkip) of + PossibleResponses, fsourOverwrite, fsourSkip, + @QuestionActionHandler) of fsourOverwrite: Result := fsoofeOverwrite; fsourSkip: Index: src/filesources/gio/ugiocopyoperation.pas =================================================================== --- src/filesources/gio/ugiocopyoperation.pas (revision 7965) +++ src/filesources/gio/ugiocopyoperation.pas (working copy) @@ -116,6 +116,7 @@ @RaiseAbortOperation, @CheckOperationState, @UpdateStatistics, + @ShowCompareFilesUI, g_file_copy, TargetPath); Index: src/filesources/gio/ugiofilesourceutil.pas =================================================================== --- src/filesources/gio/ugiofilesourceutil.pas (revision 7965) +++ src/filesources/gio/ugiofilesourceutil.pas (working copy) @@ -7,9 +7,9 @@ uses Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation, uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions, - uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs; + uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs, + uFileSourceOperationUI; - const CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' + FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' + @@ -51,10 +51,14 @@ FFileExistsOption: TFileSourceOperationOptionFileExists; FDirExistsOption: TFileSourceOperationOptionDirectoryExists; + FCurrentFile: TFile; + FCurrentTargetFilePath: String; + AskQuestion: TAskQuestionFunction; AbortOperation: TAbortOperationFunction; CheckOperationState: TCheckOperationStateFunction; UpdateStatistics: TUpdateStatisticsFunction; + ShowCompareFilesUI: TShowCompareFilesUIFunction; procedure ShowError(const Message: String; AError: PGError); procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType); @@ -68,6 +72,7 @@ function DirExists(aFile: TFile; AbsoluteTargetFileName: String; AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists; + procedure QuestionActionHandler(Action: TFileSourceOperationUIAction); function FileExists(aFile: TFile; aTargetInfo: PGFileInfo; var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists; @@ -82,6 +87,7 @@ AbortOperationFunction: TAbortOperationFunction; CheckOperationStateFunction: TCheckOperationStateFunction; UpdateStatisticsFunction: TUpdateStatisticsFunction; + ShowCompareFilesUIFunction: TShowCompareFilesUIFunction; CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String ); @@ -105,7 +111,7 @@ implementation uses - Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI, + Forms, StrUtils, DCDateTimeUtils, uFileProperty, uShowMsg, uLng, uGObject2, DCFileAttributes; procedure ShowError(AError: PGError); @@ -677,13 +683,20 @@ end; end; +procedure TGioOperationHelper.QuestionActionHandler( + Action: TFileSourceOperationUIAction); +begin + if Action = fsouaCompare then + ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath); +end; + function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo; var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists; const - Responses: array[0..8] of TFileSourceOperationUIResponse + Responses: array[0..9] of TFileSourceOperationUIResponse = (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll, fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller, - fsourOverwriteLarger, fsourCancel); + fsourCancel, fsouaCompare, fsourOverwriteLarger); var Answer: Boolean; Message: String; @@ -718,8 +731,11 @@ repeat Answer := True; Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName); + FCurrentFile := aFile; + FCurrentTargetFilePath := AbsoluteTargetFileName; case AskQuestion(Message, '', - Responses, fsourOverwrite, fsourSkip) of + Responses, fsourOverwrite, fsourSkip, + @QuestionActionHandler) of fsourOverwrite: Result := fsoofeOverwrite; fsourSkip: @@ -830,6 +846,7 @@ AbortOperationFunction: TAbortOperationFunction; CheckOperationStateFunction: TCheckOperationStateFunction; UpdateStatisticsFunction: TUpdateStatisticsFunction; + ShowCompareFilesUIFunction: TShowCompareFilesUIFunction; CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String); begin FGioFileSource:= FileSource as IGioFileSource; @@ -839,6 +856,7 @@ AbortOperation := AbortOperationFunction; CheckOperationState := CheckOperationStateFunction; UpdateStatistics := UpdateStatisticsFunction; + ShowCompareFilesUI := ShowCompareFilesUIFunction; FCopyMoveFile := CopyMoveFileFunction; FFileExistsOption := fsoofeNone; Index: src/filesources/gio/ugiomoveoperation.pas =================================================================== --- src/filesources/gio/ugiomoveoperation.pas (revision 7965) +++ src/filesources/gio/ugiomoveoperation.pas (working copy) @@ -80,6 +80,7 @@ @RaiseAbortOperation, @CheckOperationState, @UpdateStatistics, + @ShowCompareFilesUI, g_file_move, TargetPath); Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas =================================================================== --- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965) +++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy) @@ -8,6 +8,7 @@ LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process, uFileSourceOperation, uFileSourceCopyOperation, + uFileSourceOperationUI, uFileSourceOperationOptions, uFileSourceOperationOptionsUI, uFileSource, @@ -60,6 +61,11 @@ procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt); protected + FCurrentFile: TFile; + FCurrentTargetFilePath: String; + procedure QuestionActionHandler(Action: TFileSourceOperationUIAction); + + protected FExProcess: TExProcess; FTempFile: String; FFileMask: String; @@ -91,7 +97,7 @@ implementation uses - LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI, + LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, uFileSystemUtil; @@ -445,12 +451,29 @@ end; end; +procedure TMultiArchiveCopyOutOperation.QuestionActionHandler( + Action: TFileSourceOperationUIAction); +var aFile: TFile; +begin + if Action = fsouaCompare then + begin + aFile := FCurrentFile.Clone; + try + aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath); + ShowCompareFilesUI(aFile, FCurrentTargetFilePath); + finally + aFile.Free; + end; + end; +end; + function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile; const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists; const - PossibleResponses: array[0..7] of TFileSourceOperationUIResponse + PossibleResponses: array[0..8] of TFileSourceOperationUIResponse = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll, - fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel); + fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare, + fsourCancel); var Message: String; @@ -486,8 +509,11 @@ begin Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime); + FCurrentFile := aFile; + FCurrentTargetFilePath := AbsoluteTargetFileName; case AskQuestion(Message, '', - PossibleResponses, fsourOverwrite, fsourSkip) of + PossibleResponses, fsourOverwrite, fsourSkip, + @QuestionActionHandler) of fsourOverwrite: Result := fsoofeOverwrite; fsourSkip: Index: src/filesources/ufilesourcecopyoperation.pas =================================================================== --- src/filesources/ufilesourcecopyoperation.pas (revision 7965) +++ src/filesources/ufilesourcecopyoperation.pas (working copy) @@ -58,6 +58,9 @@ procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics); procedure UpdateStatisticsAtStartTime; override; + procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String); + procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile); + property TargetPath: String read FTargetPath; public @@ -135,7 +138,7 @@ implementation uses - uDCUtils, uLng, uGlobs; + uDCUtils, uLng, uGlobs, uShowForm; // -- TFileSourceCopyOperation ------------------------------------------------ @@ -272,6 +275,24 @@ end; end; +procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile); +begin + PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList); +end; + +procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String); +var + TargetFile: TFile = nil; +begin + TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath)); + TargetFile.Name := ExtractFileName(TargetFilePath); + try + PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList); + finally + TargetFile.Free; + end; +end; + // -- TFileSourceCopyInOperation ---------------------------------------------- function TFileSourceCopyInOperation.GetID: TFileSourceOperationType; Index: src/filesources/ufilesourcemoveoperation.pas =================================================================== --- src/filesources/ufilesourcemoveoperation.pas (revision 7965) +++ src/filesources/ufilesourcemoveoperation.pas (working copy) @@ -46,6 +46,9 @@ procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics); procedure UpdateStatisticsAtStartTime; override; + procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String); + procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile); + property FileSource: IFileSource read FFileSource; property SourceFiles: TFiles read FSourceFiles; property TargetPath: String read FTargetPath; @@ -78,7 +81,7 @@ implementation uses - uDCUtils, uLng; + uDCUtils, uLng, uShowForm; // -- TFileSourceMoveOperation ------------------------------------------------ @@ -163,6 +166,23 @@ end; end; +procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile); +begin + PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList); +end; + +procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String); +var TargetFile: TFile; +begin + TargetFile := TFile.Create(''); + TargetFile.FullPath := TargetFilePath; + try + PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList); + finally + TargetFile.Free; + end; +end; + function TFileSourceMoveOperation.RetrieveStatistics: TFileSourceMoveOperationStatistics; begin // Statistics have to be synchronized because there are multiple values Index: src/filesources/ufilesourceoperation.pas =================================================================== --- src/filesources/ufilesourceoperation.pas (revision 7965) +++ src/filesources/ufilesourceoperation.pas (working copy) @@ -25,7 +25,8 @@ Classes, SysUtils, syncobjs, uLng, uFileSourceOperationOptionsUI, uFileSourceOperationTypes, - uFileSourceOperationUI; + uFileSourceOperationUI, + uFile; type @@ -75,11 +76,14 @@ function(Msg: String; Question: String; PossibleResponses: array of TFileSourceOperationUIResponse; DefaultOKResponse: TFileSourceOperationUIResponse; - DefaultCancelResponse: TFileSourceOperationUIResponse - ) : TFileSourceOperationUIResponse of object; + DefaultCancelResponse: TFileSourceOperationUIAnswer; + ActionHandler: TFileSourceOperationUIActionHandler = nil + ) : TFileSourceOperationUIAnswer of object; TAbortOperationFunction = procedure of object; TCheckOperationStateFunction = procedure of object; TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object; + TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object; + TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object; TFileSourceOperationClass = class of TFileSourceOperation; {en @@ -171,8 +175,9 @@ FUIQuestion: String; FUIPossibleResponses: array of TFileSourceOperationUIResponse; FUIDefaultOKResponse: TFileSourceOperationUIResponse; - FUIDefaultCancelResponse: TFileSourceOperationUIResponse; - FUIResponse: TFileSourceOperationUIResponse; + FUIDefaultCancelResponse: TFileSourceOperationUIAnswer; + FUIActionHandler: TFileSourceOperationUIActionHandler; + FUIResponse: TFileSourceOperationUIAnswer; FTryAskQuestionResult: Boolean; {en @@ -317,8 +322,9 @@ Msg: String; Question: String; PossibleResponses: array of TFileSourceOperationUIResponse; DefaultOKResponse: TFileSourceOperationUIResponse; - DefaultCancelResponse: TFileSourceOperationUIResponse - ) : TFileSourceOperationUIResponse; + DefaultCancelResponse: TFileSourceOperationUIAnswer; + ActionHandler: TFileSourceOperationUIActionHandler = nil + ) : TFileSourceOperationUIAnswer; {en Remember statistics at start time (used for estimating remaining time). @@ -1173,7 +1179,9 @@ Msg: String; Question: String; PossibleResponses: array of TFileSourceOperationUIResponse; DefaultOKResponse: TFileSourceOperationUIResponse; - DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse; + DefaultCancelResponse: TFileSourceOperationUIAnswer; + ActionHandler: TFileSourceOperationUIActionHandler = nil + ) : TFileSourceOperationUIAnswer; var i: Integer; bStateChanged: Boolean = False; @@ -1203,6 +1211,7 @@ FUIPossibleResponses[i] := PossibleResponses[i]; FUIDefaultOKResponse := DefaultOKResponse; FUIDefaultCancelResponse := DefaultCancelResponse; + FUIActionHandler := ActionHandler; if GetCurrentThreadID <> MainThreadID then begin @@ -1280,7 +1289,8 @@ FUIQuestion, FUIPossibleResponses, FUIDefaultOKResponse, - FUIDefaultCancelResponse); + FUIDefaultCancelResponse, + FUIActionHandler); FTryAskQuestionResult := True; // We do have an answer now. end; Index: src/filesources/ufilesourceoperationmessageboxesui.pas =================================================================== --- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965) +++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy) @@ -6,7 +6,8 @@ uses Classes, SysUtils, - uFileSourceOperationUI; + uFileSourceOperationUI, + uShowMsg; type @@ -13,7 +14,14 @@ {en We assume here the UI is used only from the GUI thread. } + + { TFileSourceOperationMessageBoxesUI } + TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI) + private + FUIActionHandler: TFileSourceOperationUIActionHandler; + protected + procedure QuestionActionHandler(Button: TMyMsgActionButton); public constructor Create; override; destructor Destroy; override; @@ -21,21 +29,21 @@ function AskQuestion(Msg: String; Question: String; PossibleResponses: array of TFileSourceOperationUIResponse; DefaultOKResponse: TFileSourceOperationUIResponse; - DefaultCancelResponse: TFileSourceOperationUIResponse - ) : TFileSourceOperationUIResponse; override; + DefaultCancelResponse: TFileSourceOperationUIAnswer; + ActionHandler: TFileSourceOperationUIActionHandler = nil + ) : TFileSourceOperationUIAnswer; override; end; implementation -uses - uShowMsg; - const ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton = (msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder, msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource, - msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin); + msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin, + // Actions: + msmbCompare); ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse = (fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume, @@ -43,6 +51,9 @@ fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource, fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin); + ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction = + (fsouaCompare); + constructor TFileSourceOperationMessageBoxesUI.Create; begin inherited; @@ -57,8 +68,9 @@ Msg: String; Question: String; PossibleResponses: array of TFileSourceOperationUIResponse; DefaultOKResponse: TFileSourceOperationUIResponse; - DefaultCancelResponse: TFileSourceOperationUIResponse - ) : TFileSourceOperationUIResponse; + DefaultCancelResponse: TFileSourceOperationUIAnswer; + ActionHandler: TFileSourceOperationUIActionHandler = nil + ) : TFileSourceOperationUIAnswer; var Buttons: array of TMyMsgButton; i: Integer; @@ -65,6 +77,8 @@ MsgResult: TMyMsgResult; TextMessage: String; begin + FUIActionHandler := ActionHandler; + SetLength(Buttons, Length(PossibleResponses)); for i := 0 to Length(PossibleResponses) - 1 do Buttons[i] := ResponseToButton[PossibleResponses[i]]; @@ -77,10 +91,18 @@ MsgResult := MsgBox(TextMessage, Buttons, ResponseToButton[DefaultOKResponse], - ResponseToButton[DefaultCancelResponse]); + ResponseToButton[DefaultCancelResponse], + @QuestionActionHandler); Result := ResultToResponse[MsgResult]; end; +procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler( + Button: TMyMsgActionButton); +begin + if Assigned(FUIActionHandler) then + FUIActionHandler(ButtonToUIAction[Button]); +end; + end. Index: src/filesources/ufilesourceoperationmisc.pas =================================================================== --- src/filesources/ufilesourceoperationmisc.pas (revision 7965) +++ src/filesources/ufilesourceoperationmisc.pas (working copy) @@ -69,7 +69,8 @@ procedure ShowOperationModal(OpManItem: TOperationsManagerItem); begin - with TfrmFileOp.Create(OpManItem.Queue.Identifier) do +// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do + with TfrmFileOp.Create(OpManItem.Handle) do try ShowModal; finally Index: src/filesources/ufilesourceoperationui.pas =================================================================== --- src/filesources/ufilesourceoperationui.pas (revision 7965) +++ src/filesources/ufilesourceoperationui.pas (working copy) @@ -34,8 +34,16 @@ fsourAll, fsourRetry, fsourAbort, - fsourRetryAdmin); + fsourRetryAdmin, + // Actions will never be returned since they do not close the window, handle them in ActionHandler. + fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line. + TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare); + + TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse); + + TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object; + {en General interface for communication: operation <-> user. } @@ -47,8 +55,9 @@ function AskQuestion(Msg: String; Question: String; PossibleResponses: array of TFileSourceOperationUIResponse; DefaultOKResponse: TFileSourceOperationUIResponse; - DefaultCancelResponse: TFileSourceOperationUIResponse - ) : TFileSourceOperationUIResponse; virtual abstract; + DefaultCancelResponse: TFileSourceOperationUIAnswer; + ActionHandler: TFileSourceOperationUIActionHandler = nil + ) : TFileSourceOperationUIAnswer; virtual abstract; // Add possibility to display files properties (for example: to compare older - newer) // Add general option "remember this choice for all files of this type" (checkbox) end; Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas =================================================================== --- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965) +++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy) @@ -13,6 +13,7 @@ uFile, uWcxModule, uWcxArchiveFileSource, + uFileSourceOperationUI, uFileSourceOperationOptions, uFileSourceOperationOptionsUI; @@ -44,6 +45,10 @@ function Tar: Boolean; procedure SetProcessDataProc(hArcData: TArcHandle); + protected + FCurrentFile: TFile; + FCurrentTargetFilePath: String; + procedure QuestionActionHandler(Action: TFileSourceOperationUIAction); function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String; function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists; @@ -71,7 +76,7 @@ uses LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions, - uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter, + uFileSystemFileSource, DCOSUtils, uTarWriter, DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil; // ---------------------------------------------------------------------------- @@ -409,6 +414,13 @@ end; end; +procedure TWcxArchiveCopyInOperation.QuestionActionHandler( + Action: TFileSourceOperationUIAction); +begin + if Action = fsouaCompare then + ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath)); +end; + function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String; begin Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding; @@ -423,10 +435,10 @@ function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists; const - PossibleResponses: array[0..7] of TFileSourceOperationUIResponse + PossibleResponses: array[0..8] of TFileSourceOperationUIResponse = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller, - fsourOverwriteOlder, fsourCancel); + fsourOverwriteOlder, fsouaCompare, fsourCancel); function OverwriteOlder: TFileSourceOperationOptionFileExists; begin @@ -456,8 +468,11 @@ case FFileExistsOption of fsoofeNone: begin + FCurrentFile := aSourceFile; + FCurrentTargetFilePath := aTargetHeader.FileName; case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '', - PossibleResponses, fsourOverwrite, fsourSkip) of + PossibleResponses, fsourOverwrite, fsourSkip, + @QuestionActionHandler) of fsourOverwrite: Result := fsoofeOverwrite; fsourSkip: Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas =================================================================== --- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965) +++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy) @@ -10,6 +10,7 @@ uFileSourceCopyOperation, uFileSource, uFileSourceOperation, + uFileSourceOperationUI, uFileSourceOperationOptions, uFileSourceOperationOptionsUI, uFile, @@ -65,6 +66,10 @@ procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType); protected + FCurrentFilePath: String; + FCurrentTargetFilePath: String; + procedure QuestionActionHandler(Action: TFileSourceOperationUIAction); + procedure SetProcessDataProc(hArcData: TArcHandle); public @@ -91,7 +96,7 @@ uses Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils, - uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil, + fWcxArchiveCopyOperationOptions, uFileSystemUtil, uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding; // ---------------------------------------------------------------------------- @@ -538,14 +543,35 @@ end; end; +procedure TWcxArchiveCopyOutOperation.QuestionActionHandler( + Action: TFileSourceOperationUIAction); +var aFile: TFile; +begin + if Action = fsouaCompare then + begin + aFile := TFile.Create(''); + try + aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath); + ShowCompareFilesUI(aFile, FCurrentTargetFilePath); + finally + aFile.Free; + end; + end; +end; + function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader; var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists; const - PossibleResponses: array[0..9] of TFileSourceOperationUIResponse + Responses: array[0..10] of TFileSourceOperationUIResponse = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel, + fsouaCompare, fsourRenameSource, fsourAutoRenameSource); + ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse + = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll, + fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel, fsourRenameSource, fsourAutoRenameSource); var + PossibleResponses: array of TFileSourceOperationUIResponse; Answer: Boolean; Message: String; @@ -580,10 +606,19 @@ fsoofeNone: repeat Answer := True; + // Can't asynchoronously extract file for comparison when multiple operations are not supported + // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered + case FNeedsConnection of + True : PossibleResponses := ResponsesNoCompare; + False: PossibleResponses := Responses; + end; Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName, Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime)); + FCurrentFilePath := Header.FileName; + FCurrentTargetFilePath := AbsoluteTargetFileName; case AskQuestion(Message, '', - PossibleResponses, fsourOverwrite, fsourSkip) of + PossibleResponses, fsourOverwrite, fsourSkip, + @QuestionActionHandler) of fsourOverwrite: Result := fsoofeOverwrite; fsourSkip: Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas =================================================================== --- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965) +++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy) @@ -142,6 +142,8 @@ @RaiseAbortOperation, @CheckOperationState, @UpdateStatistics, + @ShowCompareFilesUI, + @ShowCompareFilesUIByFileObject, Thread, wpohmCopyIn, TargetPath); Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas =================================================================== --- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965) +++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy) @@ -130,6 +130,8 @@ @RaiseAbortOperation, @CheckOperationState, @UpdateStatistics, + @ShowCompareFilesUI, + @ShowCompareFilesUIByFileObject, Thread, wpohmCopy, TargetPath); Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas =================================================================== --- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965) +++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy) @@ -142,6 +142,8 @@ @RaiseAbortOperation, @CheckOperationState, @UpdateStatistics, + @ShowCompareFilesUI, + @ShowCompareFilesUIByFileObject, Thread, wpohmCopyOut, TargetPath); Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas =================================================================== --- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965) +++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy) @@ -128,6 +128,8 @@ @RaiseAbortOperation, @CheckOperationState, @UpdateStatistics, + @ShowCompareFilesUI, + @ShowCompareFilesUIByFileObject, Thread, wpohmMove, TargetPath); Index: src/filesources/wfxplugin/uwfxpluginutil.pas =================================================================== --- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968) +++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy) @@ -39,10 +39,16 @@ FCopyAttributesOptions: TCopyAttributesOptions; FFileExistsOption: TFileSourceOperationOptionFileExists; + FCurrentFile: TFile; + FCurrentTargetFile: TFile; + FCurrentTargetFilePath: String; + AskQuestion: TAskQuestionFunction; AbortOperation: TAbortOperationFunction; CheckOperationState: TCheckOperationStateFunction; UpdateStatistics: TUpdateStatisticsFunction; + ShowCompareFilesUI: TShowCompareFilesUIFunction; + ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction; procedure ShowError(sMessage: String); procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType); @@ -50,6 +56,7 @@ function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt; function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt; + procedure QuestionActionHandler(Action: TFileSourceOperationUIAction); function FileExists(aFile: TFile; AbsoluteTargetFileName: String; AllowResume: Boolean): TFileSourceOperationOptionFileExists; @@ -62,6 +69,8 @@ AbortOperationFunction: TAbortOperationFunction; CheckOperationStateFunction: TCheckOperationStateFunction; UpdateStatisticsFunction: TUpdateStatisticsFunction; + ShowCompareFilesUIFunction: TShowCompareFilesUIFunction; + ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction; OperationThread: TThread; Mode: TWfxPluginOperationHelperMode; TargetPath: String @@ -233,6 +242,18 @@ end; end; +procedure TWfxPluginOperationHelper.QuestionActionHandler( + Action: TFileSourceOperationUIAction); +begin + if Action = fsouaCompare then + begin + if Assigned(FCurrentTargetFile) then + ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile) + else + ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath); + end; +end; + function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String; begin Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding + @@ -245,19 +266,20 @@ AbsoluteTargetFileName: String; AllowResume: Boolean ): TFileSourceOperationOptionFileExists; const - Responses: array[0..5] of TFileSourceOperationUIResponse + Responses: array[0..6] of TFileSourceOperationUIResponse = (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll, + fsouaCompare, fsourCancel); + ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse + = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare, fsourCancel); - ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse - = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel); var Message: String; PossibleResponses: array of TFileSourceOperationUIResponse; - TargetFile: TFile; begin case FFileExistsOption of fsoofeNone: - begin + try + FCurrentTargetFile := nil; case AllowResume of True : PossibleResponses := Responses; False: PossibleResponses := ResponsesNoResume; @@ -264,15 +286,15 @@ end; if FMode = wpohmCopyOut then Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime) - else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then - begin - Message := FileExistsMessage(TargetFile, aFile); - TargetFile.Free; - end + else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then + Message := FileExistsMessage(FCurrentTargetFile, aFile) else Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]); + FCurrentFile := aFile; + FCurrentTargetFilePath := AbsoluteTargetFileName; case AskQuestion(Message, '', - PossibleResponses, fsourOverwrite, fsourSkip) of + PossibleResponses, fsourOverwrite, fsourSkip, + @QuestionActionHandler) of fsourOverwrite: Result := fsoofeOverwrite; fsourSkip: @@ -296,6 +318,8 @@ fsourCancel: AbortOperation; end; + finally + FreeAndNil(FCurrentTargetFile); end; else @@ -324,6 +348,8 @@ AbortOperationFunction: TAbortOperationFunction; CheckOperationStateFunction: TCheckOperationStateFunction; UpdateStatisticsFunction: TUpdateStatisticsFunction; + ShowCompareFilesUIFunction: TShowCompareFilesUIFunction; + ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction; OperationThread: TThread; Mode: TWfxPluginOperationHelperMode; TargetPath: String @@ -334,6 +360,8 @@ AbortOperation := AbortOperationFunction; CheckOperationState := CheckOperationStateFunction; UpdateStatistics := UpdateStatisticsFunction; + ShowCompareFilesUI := ShowCompareFilesUIFunction; + ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction; FOperationThread:= OperationThread; FMode := Mode; FInternal:= (FMode in [wpohmCopy, wpohmMove]); Index: src/fMsg.pas =================================================================== --- src/fMsg.pas (revision 7965) +++ src/fMsg.pas (working copy) @@ -17,10 +17,8 @@ procedure FormCreate(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyPress(Sender: TObject; var Key: Char); - private - { Private declarations } public - { Public declarations } + ActionHandler: procedure(Tag: PtrInt) of object; Escape: Integer; iSelected: Integer; procedure ButtonClick(Sender:TObject); @@ -44,7 +42,7 @@ procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin - if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape; + if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape; end; procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); @@ -73,9 +71,20 @@ end; procedure TfrmMsg.ButtonClick(Sender: TObject); +var + aTag: PtrInt; begin - iSelected:= (Sender as TComponent).Tag; - Close; + aTag:= (Sender as TComponent).Tag; + if (aTag < -1) then + begin + if Assigned(ActionHandler) then + ActionHandler(aTag); + end + else + begin + iSelected:= aTag; + Close; + end; end; procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton; @@ -84,8 +93,7 @@ {$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)} if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then begin - iSelected:= (Sender as TButton).Tag; - Close; + ButtonClick(Sender); end; {$ENDIF} end; Index: src/platform/uosforms.pas =================================================================== --- src/platform/uosforms.pas (revision 7965) +++ src/platform/uosforms.pas (working copy) @@ -319,9 +319,9 @@ end; // If parent window is normal window then call inherited method - if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then - Result:= inherited ShowModal - else +// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then +// Result:= inherited ShowModal +// else begin Include(FFormState, fsModal); FParentWindow := ActiveWindow; Index: src/ulng.pas =================================================================== --- src/ulng.pas (revision 7965) +++ src/ulng.pas (working copy) @@ -329,6 +329,7 @@ rsDlgButtonAbort = 'Ab&ort'; rsDlgButtonOther = 'Ot&her'; rsDlgButtonRetryAdmin = 'As Ad&ministrator'; + rsDlgButtonCompare = 'Compare &by content'; rsDlgButtonContinue = '&Continue'; rsDlgButtonExitProgram = 'E&xit program'; Index: src/ushowform.pas =================================================================== --- src/ushowform.pas (revision 7966) +++ src/ushowform.pas (working copy) @@ -94,7 +94,7 @@ SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf, uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils, uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg, - DCStrUtils, uFileSourceProperty, + DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation, uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes, uMultiArchiveFileSource, fFileExecuteYourSelf; @@ -669,6 +669,8 @@ TempFileSource, TempFiles, TempFileSource.FileSystemRoot); + if Operation is TWfxPluginCopyOutOperation then + (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection finally TempFiles.Free; end; @@ -681,7 +683,7 @@ Operation.AddStateChangedListener([fsosStopped], FunctionToCall); - OperationsManager.AddOperation(Operation); + OperationsManager.AddOperationModal(Operation); Exit(pdrInCallback); end; Index: src/uShowMsg.pas =================================================================== --- src/uShowMsg.pas (revision 7965) +++ src/uShowMsg.pas (working copy) @@ -54,9 +54,14 @@ msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder, msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource, - msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin); + msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin, + // Actions, they do not close the form and therefore have no corresponding result value: + msmbCompare); + TMyMsgActionButton = msmbCompare..High(TMyMsgButton); + TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object; + { TDialogMainThread } TDialogMainThread = class @@ -103,7 +108,7 @@ procedure msgError(const sMsg: String); overload; procedure msgError(Thread: TThread; const sMsg: String); overload; -function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload; +function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload; function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload; function MsgTest:TMyMsgResult; @@ -283,7 +288,10 @@ Caption:= cLngButton[Buttons[iIndex]]; Parent:= frmMsg.pnlButtons; Constraints.MinWidth:= MinButtonWidth; - Tag:= iIndex; + if Buttons[iIndex] >= Low(TMyMsgActionButton) then + Tag:= -2-iIndex + else + Tag:= iIndex; OnClick:= frmMsg.ButtonClick; OnMouseUp:= frmMsg.MouseUpEvent; if Buttons[iIndex] = ButDefault then @@ -308,9 +316,13 @@ for iIndex:= 0 to pred(frmMsg.ComponentCount) do begin if frmMsg.Components[iIndex] is TButton then - begin - with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc. - end; + with frmMsg.Components[iIndex] as TButton do + begin + if Tag >= 0 then + TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc. + else + TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1); + end; end; end; @@ -332,7 +344,10 @@ MenuItem:= TMenuItem.Create(frmMsg.mnuOther); with MenuItem do begin - Tag:= iIndex; + if Buttons[iIndex] >= Low(TMyMsgActionButton) then + Tag:= -2-iIndex + else + Tag:= iIndex; Caption:= cLngButton[Buttons[iIndex]]; OnClick:= frmMsg.ButtonClick; frmMsg.mnuOther.Items.Add(MenuItem); @@ -341,14 +356,33 @@ end; end; -function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult; +type TMsgBoxHelper = class + Buttons: array of TMyMsgButton; + ActionHandler: TMyMsgActionHandler; + procedure MsgBoxActionHandler(Tag: PtrInt); +end; + +procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt); +begin + ActionHandler(Buttons[-Tag-2]); +end; + +function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; var frmMsg:TfrmMsg; + MsgBoxHelper: TMsgBoxHelper = nil; + I: Integer; begin frmMsg:=TfrmMsg.Create(Application); try + MsgBoxHelper := TMsgBoxHelper.Create(); + SetLength(MsgBoxHelper.Buttons, Length(Buttons)); + for I := Low(Buttons) to High(Buttons) do + MsgBoxHelper.Buttons[I] := Buttons[I]; + MsgBoxHelper.ActionHandler := ActionHandler; + frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler; - SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape); + SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape); frmMsg.ShowModal; if (frmMsg.iSelected)=-1 then @@ -359,6 +393,7 @@ Result:=TMyMsgResult(Buttons[frmMsg.iSelected]); finally frmMsg.Free; + MsgBoxHelper.Free; end; end; @@ -769,6 +804,7 @@ cLngButton[msmbRetry] := rsDlgButtonRetry; cLngButton[msmbAbort] := rsDlgButtonAbort; cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin; + cLngButton[msmbCompare] := rsDlgButtonCompare; for I:= Low(TMyMsgButton) to High(TMyMsgButton) do begin