HisRestorePointFrm.pas 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  1. unit HisRestorePointFrm;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5. Dialogs, ImgList, ZJTrees, ZJGridTrees, ZJGrid, ComCtrls, ToolWin,
  6. ExtCtrls, ZjGridDBA, ActnList, HisRestorePointDM, ConstTypeUnit, XPMenu;
  7. type
  8. TfrmRestorePoint = class(TForm)
  9. tbDeleteOne: TToolBar;
  10. tbRestorePoint: TToolButton;
  11. tbViewProject: TToolButton;
  12. tbDeletePoint: TToolButton;
  13. zgUnFixedPoint: TZJGrid;
  14. zaUnFixedPoint: TZjGridDBA;
  15. zgFixedPoint: TZJGrid;
  16. zaFixedPoint: TZjGridDBA;
  17. Splitter1: TSplitter;
  18. ActionList: TActionList;
  19. actnRestorePoint: TAction;
  20. actnViewPoint: TAction;
  21. actnDelete: TAction;
  22. XPMenu: TXPMenu;
  23. tbCloseWind: TToolButton;
  24. actnCloseWind: TAction;
  25. procedure actnDeleteExecute(Sender: TObject);
  26. procedure actnViewPointExecute(Sender: TObject);
  27. procedure actnRestorePointExecute(Sender: TObject);
  28. procedure actnCloseWindExecute(Sender: TObject);
  29. private
  30. FProject: TObject;
  31. FFileName: string;
  32. FProjName: string;
  33. FCloseProjectProc: TNotifyEvent;
  34. FOpenProjectProc: TOpenProjectProc;
  35. FDMHisResPoint: TDMHisRestorePoint;
  36. function OutOfRecordCount(var aFixed: Boolean): Boolean;
  37. procedure RestoreProject;
  38. procedure SetHisResPoint(const Value: TDMHisRestorePoint);
  39. procedure SetProject(const Value: TObject);
  40. property DMHisResPoint: TDMHisRestorePoint read FDMHisResPoint write SetHisResPoint;
  41. public
  42. property Project: TObject read FProject write SetProject;
  43. property CloseProjectProc: TNotifyEvent read FCloseProjectProc write FCloseProjectProc;
  44. property OpenProjectProc: TOpenProjectProc read FOpenProjectProc write FOpenProjectProc;
  45. end;
  46. implementation
  47. {$R *.dfm}
  48. uses ScProjectManager;
  49. { TfrmRestorePoint }
  50. procedure TfrmRestorePoint.SetHisResPoint(const Value: TDMHisRestorePoint);
  51. begin
  52. FDMHisResPoint := Value;
  53. if Assigned(FDMHisResPoint) then
  54. begin
  55. FDMHisResPoint.RefreshPoints;
  56. zaUnFixedPoint.DataSet := FDMHisResPoint.cdsUnFixedPoint;
  57. zaFixedPoint.DataSet := FDMHisResPoint.cdsFixedPoint;
  58. end
  59. else
  60. begin
  61. zaUnFixedPoint.DataSet := nil;
  62. zaFixedPoint.DataSet := nil;
  63. end;
  64. end;
  65. procedure TfrmRestorePoint.actnDeleteExecute(Sender: TObject);
  66. var
  67. bFixed: Boolean;
  68. begin
  69. if not OutOfRecordCount(bFixed) then Exit;
  70. FDMHisResPoint.DeleteCurPoint(bFixed);
  71. end;
  72. procedure TfrmRestorePoint.actnViewPointExecute(Sender: TObject);
  73. var
  74. strPath: string;
  75. bFixed: Boolean;
  76. begin
  77. if not OutOfRecordCount(bFixed) then Exit;
  78. strPath := FDMHisResPoint.GetCurPointPath(bFixed);
  79. FOpenProjectProc(strPath, 'Ô¤ÀÀ_' + TProject(FProject).ProjectName, -1, -1);
  80. end;
  81. function TfrmRestorePoint.OutOfRecordCount(var aFixed: Boolean): Boolean;
  82. begin
  83. Result := False;
  84. if zgUnFixedPoint.Focused then
  85. begin
  86. if (zgUnFixedPoint.CurRow >= zgUnFixedPoint.FixedRowCount) and
  87. (zgUnFixedPoint.CurRow < zgUnFixedPoint.FixedRowCount + zaUnFixedPoint.RecordCount) then
  88. begin
  89. aFixed := False;
  90. Result := True;
  91. end;
  92. end
  93. else if zgFixedPoint.Focused then
  94. begin
  95. if (zgFixedPoint.CurRow >= zgFixedPoint.FixedRowCount) and
  96. (zgFixedPoint.CurRow < zgFixedPoint.FixedRowCount + zaFixedPoint.RecordCount) then
  97. begin
  98. aFixed := True;
  99. Result := True;
  100. end;
  101. end;
  102. end;
  103. procedure TfrmRestorePoint.RestoreProject;
  104. var
  105. bFixed: Boolean;
  106. strFile: string;
  107. begin
  108. if not OutOfRecordCount(bFixed) then Exit;
  109. strFile := FDMHisResPoint.GetCurPointPath(bFixed);
  110. FCloseProjectProc(FProject);
  111. CopyFile(PChar(strFile), PChar(FFileName), False);
  112. FOpenProjectProc(FFileName, FProjName, -1, TProject(FProject).ID);
  113. //FDMHisResPoint.DeleteAllPoints;
  114. end;
  115. procedure TfrmRestorePoint.actnRestorePointExecute(Sender: TObject);
  116. begin
  117. Self.Hide;
  118. Screen.Cursor := crHourGlass;
  119. try
  120. RestoreProject;
  121. finally
  122. Screen.Cursor := crDefault;
  123. end;
  124. Self.Close;
  125. end;
  126. procedure TfrmRestorePoint.SetProject(const Value: TObject);
  127. begin
  128. FProject := Value;
  129. FFileName := TProject(FProject).FilePath;
  130. FProjName := TProject(FProject).ProjectName;
  131. DMHisResPoint := TProject(FProject).DMHisPoint;
  132. end;
  133. procedure TfrmRestorePoint.actnCloseWindExecute(Sender: TObject);
  134. begin
  135. Close;
  136. end;
  137. end.