Jelajahi Sumber

1. 跟服务器请求附件数据(json, 数组,数组长度3100),报错内存溢出
2. 打开一个标段后,项目管理查看其他标段报错
3. 打开第二个标段报错(目前代码可以打开至7个标段)
PS:2/3可能是由于Frame使用不规范、解析json数据导致(目前修改了附件、审批人Frame,调整了打开项目后拉取审批人的解析json数据)

builder 5 tahun lalu
induk
melakukan
239017ce13

File diff ditekan karena terlalu besar
+ 2016 - 12
Forms/MainFrm.dfm


+ 2 - 0
Forms/MainFrm.pas

@@ -192,6 +192,8 @@ type
     actnImportSubTenderGatherGclExcel: TAction;
     dxbtnImportSubTenderGatherExcel: TdxBarButton;
     dxbtnExportStdJson: TdxBarButton;
+    ilstLarge: TImageList;
+    ilstSmall: TImageList;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure jtsProjectsChange(Sender: TObject; NewTab: Integer;

+ 1 - 1
Forms/UpFileFrame.pas

@@ -12,7 +12,7 @@ interface
 
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
-  Dialogs, cxHint, ExtCtrls, PNGButton, StdCtrls, Buttons, UpFileManageUnit;
+  Dialogs, ExtCtrls, PNGButton, StdCtrls, Buttons, UpFileManageUnit;
 
 type
   TUpFileView = class(TFrame)

+ 5 - 10
Forms/UpFileManageFrame.pas

@@ -81,17 +81,16 @@ type
     procedure DetailIntoEditStatus;
     procedure AddUpFileView(AUpFile: TUpFile);
     procedure SetWaitForDelete(const Value: TUpFileView);
-    procedure SetProjectData(const Value: TObject);
     procedure SetRec(const Value: TsdDataRecord);
     procedure SelectUpFile;
 
   public
-    constructor Create(AOwner: TComponent); override;
+    constructor Create(AOwner: TComponent; AProjectData: TObject);
     procedure DeleteViewAndData(AView: TUpFileView; ANeedDeleteOnLine: Boolean);
     procedure DoOnBillChange(ARec: TsdDataRecord);
     procedure RefreshViews;
 
-    property ProjectData: TObject read FProjectData write SetProjectData;
+    property ProjectData: TObject read FProjectData;
     property Selected: TUpFileView read FSelected write SetSelected;
     property DetailIsEdit: Boolean read FDetailIsEdit write SetDetailIsEdit;   // Ă÷ϸ˛żˇÖ´ŚŔíąŕź­×´ĚŹ
     property Datas: TUpFiles read FDatas write SetDatas;
@@ -346,11 +345,6 @@ begin
   FWaitForDelete := Value;
 end;
 
-procedure TUpFileManageView.SetProjectData(const Value: TObject);
-begin
-  FProjectData := Value;
-end;
-
 procedure TUpFileManageView.btnDownClick(Sender: TObject);
 var svDlg: TSaveDialog;
   sFile, sName, sPath: string;
@@ -394,9 +388,10 @@ begin
   end;
 end;
 
-constructor TUpFileManageView.Create(AOwner: TComponent);
+constructor TUpFileManageView.Create(AOwner: TComponent; AProjectData: TObject);
 begin
-  inherited;
+  inherited Create(AOwner);
+  FProjectData := AProjectData;
   FBeginRefresh := False;
   FRec := nil;
   lblBillName.Caption := '';

+ 1 - 2
Forms/mProgressFrm.pas

@@ -46,7 +46,6 @@ const
 
 {$R *.dfm}
 
-
 procedure Delay(Ams: Longint);
 var
   Time1, Time2: Longint;
@@ -80,6 +79,7 @@ procedure CloseProgress;
 begin
   if Assigned(mProgress) then
   begin
+    mProgress.Activate;
     Delay(300);
     if mProgress <> nil then
       mProgress.gaProgress.Animate := False;
@@ -95,6 +95,5 @@ begin
   (mProgress as TWinControl).PerForm(wm_SysCommand, sc_DragMove, 0);
 end;
 
-
 end.
 

+ 74 - 73
Frames/CheckerFme.pas

@@ -25,25 +25,14 @@ type
   private
     FProjectData: TObject;
     FCount: Integer;
-    FOwner: TObject;
     FOwnerFrame: TOrderCheckerFrame;
     FAddFrame: TOrderCheckerFrame;
-    FList: TObjectList;          // Add窗也进FList
+    FList: TList;          // Add窗也进FList
     FCurPos: Integer;
-    procedure SetProjectData(const Value: TObject);
-    procedure SetOwner(const Value: TObject);
-    { Private declarations }
   public
-    { Public declarations }
-    property ProjectData: TObject read FProjectData write SetProjectData;
-    property Owner: TObject read FOwner write SetOwner;
-    property OwnerFrame: TOrderCheckerFrame read FOwnerFrame write FOwnerFrame;  // 这个特指终审人的Frame
-    property AddFrame: TOrderCheckerFrame read FAddFrame write FAddFrame;        // 这个特指新增人的Frame
-    property List: TObjectList read FList;
-    property CurPos: Integer read FCurPos write FCurPos;
-
-    constructor Create(AOwner: TComponent); override;
+    constructor Create(AParent: TComponent; AProject: TObject);
     destructor Destroy; override;
+
     procedure Init;
     // 审核人的名字、职位、公司、图像
     procedure AddNewChecker(AType: TCheckerFrameType; AID: Integer; AName,
@@ -61,12 +50,18 @@ type
     function Me: TOrderCheckerFrame;
 
     function CheckNo(ACheckStatus: TCheckStatus): Integer;                // 返回指定的审核状态是列表中的第几个人
+
+    property ProjectData: TObject read FProjectData;
+    property OwnerFrame: TOrderCheckerFrame read FOwnerFrame write FOwnerFrame;  // 这个特指终审人的Frame
+    property AddFrame: TOrderCheckerFrame read FAddFrame write FAddFrame;        // 这个特指新增人的Frame
+    property List: TList read FList;
+    property CurPos: Integer read FCurPos write FCurPos;
   end;
 
 
 implementation
 
-uses FindUserFrm, PHPWebDm, ProjectData, CslJson, ConstUnit, ProjectFme;
+uses FindUserFrm, PHPWebDm, ProjectData, CslJson, ConstUnit, ProjectFme, superobject, ZhAPI;
 
 {$R *.dfm}
 
@@ -76,7 +71,6 @@ procedure TCheckerFrame.AddNewChecker(AType: TCheckerFrameType; AID: Integer;
 var vChecker: TOrderCheckerFrame;
 begin
   vChecker := TOrderCheckerFrame.Create(Self);
-  vChecker.Owner := Self;
   vChecker.Init(AType, AID, AName, ARole, ACompany, AImagePath, ACheckerMemo, ACheckStatus, ACheckeTime, ACheckeOnLine);
 
   sbChecker.Height := sbChecker.Height + vChecker.Height;
@@ -125,14 +119,57 @@ begin
 end;
 
 procedure TCheckerFrame.Init;
+
+  procedure AddChecker(AChecker: ISuperObject; AProj: TProjectData);
+  var
+    sID, sPicPath: String; 
+    vStatus: TCheckStatus; 
+    bOwner, bOwnerFinish: Boolean;
+    iIndex: Integer;
+  begin
+    sID := AChecker.S['uid'];
+    sPicPath := PHPWeb.UserPath + '1_' + sID + '.jpg';
+    PHPWeb.DownFile(AChecker.S['avatar'], sPicPath);
+    vStatus :=  TCheckStatus(AChecker.I['mastatus'] - 1);  // Json返回1、2、3、4
+    bOwner := StrToInt(sID) = TProjectData(ProjectData).WebOwnerID;
+    if bOwner then   // 添加业主
+    begin
+      if TProjectData(ProjectData).CurUserIsAuthor then
+      begin
+       {如果是编制人,添加业主前先添加Add框。
+       数据库中,编制人没有审核人这样的状态。只有跟随标段的两种状态:
+       ①有标段(顺便记录了编制人,标段是编制人创建的) ②没有标段。
+
+       为什么不通过是否有标段来判断当前是否显示“添加新的审核人”呢?
+       因为无法得知当前项目是数据库中已存在的最新一期还是仅存于本地尚末入库
+       的最新一期。改由添加的位置给出提示}
+       if (TProjectData(ProjectData).PhaseIndex > 0) and (not TProjectFrame(Owner).IsUped) then
+         AddNewChecker(cftAdd, -1, '', '', '', '', '', csNotBegin, '', -1);
+      end;
+
+      AddNewChecker(cftOwner, StrToInt(sID),
+        AChecker.S['name'], AChecker.S['jobs'], AChecker.S['company'], sPicPath,
+        AChecker.S['CheckerMemo'], vStatus, AChecker.S['audittime'], AChecker.I['onlineaudit']);
+    end
+    else
+      AddNewChecker(cftChecker, StrToInt(sID),
+        AChecker.S['name'], AChecker.S['jobs'], AChecker.S['company'], sPicPath,
+        AChecker.S['CheckerMemo'], vStatus, AChecker.S['audittime'], AChecker.I['onlineaudit']);
+
+    iIndex := AProj.Checkers.Add(StrToInt(sID), AChecker.S['name'],
+      AChecker.S['jobs'], AChecker.S['CheckerMemo'], AChecker.S['audittime']);
+    if vStatus in [csFinished, csNotPass] then
+      AProj.Checkers.LastChecker := AProj.Checkers.Item[iIndex]
+    else
+      AProj.Checkers.LastChecker := nil;
+  end;
+
 var
-  i, iIndex: Integer;
-  vA: TOVArr;
-  sURL, sPicPath, sID, sErrors: string;
+  i, iCount: Integer;
+  sURL, sPicPath, sID, sErrors, sResult: string;
   vProj: TProjectData;
   bOwner, bOwnerFinish: Boolean;
-  vStatus: TCheckStatus;
-  vCM: TChecker;
+  vJ: ISuperObject;
 begin
   FList.Clear;
   OwnerFrame := nil;
@@ -142,7 +179,7 @@ begin
 
   vProj := TProjectData(FProjectData);
   vProj.Checkers.Clear;
-  
+
   // 这里,这里搞死爹...编制人第一期上报后,关掉项目,重新打开这个项目,第一次,
   // 我说的是第一次——一定读取不了审核人列表,但第二次、以后每次都正常。你知道
   // 读取不了这个列表的后果有多严重吗?网络版的每个角落都依赖于审核人的角色,所
@@ -153,45 +190,18 @@ begin
   // 计量支付网络版研发团队定性为PHP业界的灵异事件。如果哪天你用科学解释了它,请
   // 一定要告诉我个中缘由。chenshilong, 2014-07-21
   sURL := Format('%suser/get/all/%d/%d/measure', [PHPWeb.MeasureURL, vProj.WebID, vProj.PhaseIndex]);
-  if PHPWeb.Search(sURL, [''], [''], vA) = 1 then
+  if PHPWeb.UrlGet(sURL, nil, sResult) = 1 then
   begin
-    for i := Low(vA) to High(vA) do
-    begin
-      sID := vA[i, 4];
-      sPicPath := PHPWeb.UserPath + '1_' + sID + '.jpg';
-      PHPWeb.DownFile(vA[i, 5], sPicPath);
-      vStatus :=  TCheckStatus(StrToInt(vA[i, 3])-1);  // Json返回1、2、3、4
-      bOwner := StrToInt(sID) = TProjectData(ProjectData).WebOwnerID;
-      if bOwner then   // 添加业主
-      begin
-        if TProjectData(ProjectData).CurUserIsAuthor then
-        begin
-         {如果是编制人,添加业主前先添加Add框。
-         数据库中,编制人没有审核人这样的状态。只有跟随标段的两种状态:
-         ①有标段(顺便记录了编制人,标段是编制人创建的) ②没有标段。
-
-         为什么不通过是否有标段来判断当前是否显示“添加新的审核人”呢?
-         因为无法得知当前项目是数据库中已存在的最新一期还是仅存于本地尚末入库
-         的最新一期。改由添加的位置给出提示}
-         if (TProjectData(ProjectData).PhaseIndex > 0) and (not TProjectFrame(Owner).IsUped) then
-           AddNewChecker(cftAdd, -1, '', '', '', '', '', csNotBegin, '', -1);
-        end;
-
-        AddNewChecker(cftOwner, StrToInt(sID),
-          vA[i, 0], vA[i, 2], vA[i, 1], sPicPath, vA[i, 6], vStatus, vA[i, 8], StrToInt(vA[i, 7]));
-      end
-      else
-        AddNewChecker(cftChecker, StrToInt(vA[i, 4]),
-          vA[i, 0], vA[i, 2], vA[i, 1], sPicPath, vA[i, 6], vStatus, vA[i, 8], StrToInt(vA[i, 7]));
-
-      vCM := TChecker.Create;
-      iIndex := vProj.Checkers.Add(StrToInt(vA[i, 4]), vA[i, 0], vA[i, 2], vA[i, 6], vA[i, 8]);
-      if vStatus in [csFinished, csNotPass] then
-        vProj.Checkers.LastChecker := vProj.Checkers.Item[iIndex]
-      else
-        vProj.Checkers.LastChecker := nil;
+    vJ := SO(sResult);
+    try
+      if not Assigned(vJ.AsArray) then Exit;
+      iCount := vJ.AsArray.Length;
+      for i := 0 to iCount - 1 do
+        AddChecker(vJ.AsArray.O[i], vProj);
+      RepairOrder;
+    finally
+      vJ := nil;
     end;
-    RepairOrder;
   end
   else
   begin
@@ -202,11 +212,6 @@ begin
   end;
 end;
 
-procedure TCheckerFrame.SetProjectData(const Value: TObject);
-begin
-  FProjectData := Value;
-end;
-
 function TCheckerFrame.InCheckerList(ACheckerID: Integer): Boolean;
 var i: Integer;
 begin
@@ -234,12 +239,6 @@ begin
   end;
 end;
 
-procedure TCheckerFrame.SetOwner(const Value: TObject);
-begin
-  FOwner := Value;
-end;
-
-
 procedure TCheckerFrame.RepairOrder;
 var i: Integer;
 begin
@@ -261,14 +260,16 @@ begin
   end;
 end;
 
-constructor TCheckerFrame.Create(AOwner: TComponent);
+constructor TCheckerFrame.Create(AParent: TComponent; AProject: TObject);
 begin
-  inherited;
-  FList := TObjectList.Create;
+  inherited Create(AParent);
+  FProjectData := AProject;
+  FList := TList.Create;
 end;
 
 destructor TCheckerFrame.Destroy;
 begin
+  ClearObjects(FList);
   FList.Free;
   inherited;
 end;

+ 3 - 7
Frames/OrderCheckerFme.pas

@@ -12,7 +12,7 @@ interface
 
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
-  Dialogs, ExtCtrls, StdCtrls, pngimage, CslButton, cxHint;
+  Dialogs, ExtCtrls, StdCtrls, pngimage, CslButton;
 
 type
   TCheckerFrameType = (cftChecker, cftOwner, cftAdd);
@@ -51,7 +51,6 @@ type
     FUserID: Integer;
     FOrder: Integer;
     FUserName: string;
-    FOwner: TObject;
     FCheckerFrameType: TCheckerFrameType;
     FCheckStatus: TCheckStatus;
     FUserRole: string;
@@ -73,8 +72,6 @@ type
     function IsChecking: Boolean;
     function IsFinished: Boolean;
 
-
-    property Owner: TObject read FOwner write FOwner;
     property UserID: Integer read FUserID write FUserID;
     property UserName: string read FUserName write FUserName;
     property UserRole: string read FUserRole write FUserRole;
@@ -195,8 +192,6 @@ begin
   lblLast.Font.Color := vColor;
   lblOrderCheckerMemo.Font.Color := vColor;
   lblOrderCheckerTime.Font.Color := vColor;
-//  cxHintStyleController1.HintStyle.Color := clWindow;        气泡Hint,很帅,但是有Bug,频繁操作时会出错,废弃不用,可惜!
-//  cxHintStyleController1.HintStyle.Font.Color := vColor;
 
   imgNotBegin.Visible := False;
   imgChecking.Visible := False;
@@ -231,7 +226,7 @@ var
   FindUserForm: TFindUserForm;
   vPD: TProjectData;
 begin
-  if Button = mbLeft then
+  if (Button = mbLeft) and Assigned(Owner) then
   begin
     vPD := TProjectData(TCheckerFrame(Owner).ProjectData);
     FindUserForm := TFindUserForm.Create(Self, 0, [vPD.WebID, vPD.PhaseIndex]);
@@ -250,6 +245,7 @@ var sURL: string;
 begin
   if Application.MessageBox('确定要删除该审批人吗?', '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then
     Exit;
+  if not Assigned(Owner) then Exit;
 
   vProj := TProjectData(TCheckerFrame(Owner).ProjectData);
   sURL := Format('%suser/del/%d/%d/%d/audit', [PHPWeb.MeasureURL, Self.UserID,

+ 2 - 2
Frames/ProjectFme.dfm

@@ -111,9 +111,9 @@ object ProjectFrame: TProjectFrame
       ItemFont.Height = -12
       ItemFont.Name = #23435#20307
       ItemFont.Style = []
-      LargeImages = ilstLarge
+      LargeImages = MainForm.ilstLarge
       PaintStyle = sbpsXP
-      SmallImages = ilstSmall
+      SmallImages = MainForm.ilstSmall
       Store = dxsbsViewControl
       ShowGroups = False
       OnItemClick = dxsbViewControlItemClick

+ 5 - 20
Frames/ProjectFme.pas

@@ -39,8 +39,6 @@ type
     jpsMainBillsMeasure: TJimPage;
     xbiBillsGather: TdxStoredSideItem;
     jpsMainBillsGather: TJimPage;
-    ilstLarge: TImageList;
-    ilstSmall: TImageList;
     xbiStageCompare: TdxStoredSideItem;
     xbiCompleteDegree: TdxStoredSideItem;
     xbiReport: TdxStoredSideItem;
@@ -156,7 +154,6 @@ type
 
     procedure UpToWeb(ACheckPassed: Boolean);
     function CheckersHint: string;
-    procedure SetUpFileManageView(const Value: TUpFileManageView);
     procedure CheckUpFile;
     procedure ShowPhaseHint;
   public
@@ -196,7 +193,7 @@ type
     property OtherMeasureFrame: TOtherMeasureFrame read FOtherMeasureFrame;
 
     property CheckerFrame: TCheckerFrame read FCheckerFrame;
-    property UpFileManageView: TUpFileManageView read FUpFileManageView write SetUpFileManageView;
+    property UpFileManageView: TUpFileManageView read FUpFileManageView;
 
     property DealPaymentFrame: TDealPaymentFrame read FDealPaymentFrame;
     property ZJJLFrame: TZJJLFrame read FZJJLFrame;
@@ -819,9 +816,7 @@ end;
 
 procedure TProjectFrame.CreateCheckerFrame;
 begin
-  FCheckerFrame :=  TCheckerFrame.Create(Self);
-  FCheckerFrame.Owner := Self;
-  FCheckerFrame.ProjectData := FProjectData;
+  FCheckerFrame :=  TCheckerFrame.Create(Self, FProjectData);
   AlignControl(FCheckerFrame, jpsAssistantChecker, alClient);
   FCheckerFrame.Init;
 end;
@@ -1258,7 +1253,7 @@ begin
   UpdateSysProgress(135, '正在解析数据');
   CreateBillsGatherFrame;
   UpdateSysProgress(140, '正在解析数据');
-  CreatePriceMarginFrame;                
+  CreatePriceMarginFrame;
   UpdateSysProgress(145, '正在解析数据');
 
   FOtherMeasureFrame := TOtherMeasureFrame.Create(FProjectData);
@@ -1407,19 +1402,9 @@ end;
 
 procedure TProjectFrame.CreateUpFile;
 begin
-  FUpFileManageView := TUpFileManageView.Create(Self);
-  //FUpFileManageView.Owner := Self;
-  
-  FUpFileManageView.ProjectData := FProjectData;
+  FUpFileManageView := TUpFileManageView.Create(Self, FProjectData);
+  AlignControl(FUpFileManageView, jpsAssistantUpFile, alClient);
   FUpFileManageView.Datas := FProjectData.AttachmentData;
-  FUpFileManageView.Parent := jpsAssistantUpFile;
-  FUpFileManageView.Align := alClient;
-end;
-
-procedure TProjectFrame.SetUpFileManageView(
-  const Value: TUpFileManageView);
-begin
-  FUpFileManageView := Value;
 end;
 
 procedure TProjectFrame.jpsAssistantActivePageChanged(Sender: TObject);

+ 15 - 6
Frames/ProjectManagerFme.pas

@@ -139,11 +139,13 @@ type
 
     FCurPos: Integer;                         // 用来控制审核人的添加位置
     FCheckers: TOVArr;
-    FCheckerFrames: TObjectList;
+    FCheckerFrames: TList;
 
     FSignOnlineSwitch: Integer;
     FEpureOnlineSwitch: Integer;
 
+    FProjectCurRow: Integer;
+
     function ReceiveFile(const AFileName: string; AIsReback: Boolean = False; AWorking: Boolean = False): Boolean;
     function ImportFile(const AFileName: string; AFileMD5: string = ''): Boolean;
     procedure ConnectButtonWithAction;
@@ -223,13 +225,14 @@ end;
 constructor TProjectManagerFrame.Create(AOwner: TComponent);
 begin
   inherited;
-  FCheckerFrames := TObjectList.Create;
+  FCheckerFrames := TList.Create;
   FProjectManagerData := ProjectManager;
   FProjectManagerData.Open;
   stdProjects.IDTree := FProjectManagerData.ProjectsTree;
   sdTenderProperty.DataView := FProjectManagerData.sdvTenderProperty;
   ConnectButtonWithAction;
   SetPropertyVisible(False);
+  FProjectCurRow := -1;
 
   sbChecker.Height := 0;
 
@@ -457,7 +460,11 @@ begin
     if IsProject(stdProjects.IDTree.Selected) then
       stdProjects.IDTree.Selected.Expand
     else
+    begin
+      zgProjects.BeginUpdate;
       actnOpen.Execute;
+      zgProjects.EndUpdate;
+    end;
   end;
 end;
 
@@ -807,8 +814,10 @@ procedure TProjectManagerFrame.zgProjectsCurrentChanged(Sender: TObject;
 begin
   if G_IsCloud then
   begin
-    if CurRec <> nil then
+    zgProjects.BeginUpdate;
+    if (CurRec <> nil) and (FProjectCurRow <> Row) then
     begin
+      FProjectCurRow := Row;
       // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新
 //      if FID <> CurRec.ValueByName('ID').AsInteger then
         SetPropertyVisible(CurRec.ValueByName('Type').AsInteger = 1);
@@ -818,6 +827,7 @@ begin
       if (CurRec.ValueByName('Type').AsInteger = 1) and (not pnlWeb.Visible) then
         pnlWeb.Visible := True;
     end;
+    zgProjects.EndUpdate;
   end;
 end;
 
@@ -1074,7 +1084,6 @@ var
         begin
           vChecker := TOrderCheckerFrame.Create(self);
           FCheckerFrames.Add(vChecker);
-          vChecker.Owner := Self;
           sbChecker.VertScrollBar.Range := sbChecker.VertScrollBar.Range + vChecker.Height;
           sbChecker.Height := Min(sbChecker.Height + vChecker.Height, pnlWeb.Height - pnlProject.Height);
           vChecker.Parent := sbChecker;
@@ -1120,12 +1129,11 @@ var
     end;
 
 begin
-  FCheckerFrames.Clear;
+  ClearObjects(FCheckerFrames);
   GetLocalValues(CurRec);
   if FWebID = 0 then Exit;
   SetLength(vPSArr, 8);
   sURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);
-  SetLength(FCheckers, 0);
   if PHPWeb.Search(sURL, [''], [''], 3, vPSArr, vCArr) = 1 then
   begin
     FCheckers := vCArr;
@@ -1150,6 +1158,7 @@ begin
   end
   else
   begin
+    SetLength(FCheckers, 0);
     FPhaseNo := 0;
     FWebCheckStatusProject := csNotBegin;
     FPhaseTotal := 0;