rm_dsggridreport.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,209 行 · 第 1/5 页

  begin
    j := 1;
    while j < FGrid.ColCount do
    begin
      liCell := FGrid.Cells[j, i];
      if liCell.StartRow = i then
        FList.Add(liCell.View);
      j := liCell.EndCol + 1;
    end;
  end;

  Result := FList;
end;

procedure TRMGridReportDesignerForm.SetObjectsID;
var
  i, j: Integer;
begin
  ObjID := 0;
  for i := 0 to Report.Pages.Count - 1 do
  begin
    for j := 0 to THackPage(Report.Pages[i]).Objects.Count - 1 do
    begin
      THackView(THackPage(Report.Pages[i]).Objects[j]).ObjectID := ObjID;
      Inc(ObjID);
    end;
  end;
end;

procedure TRMGridReportDesignerForm.ReleaseAction(aActionRec: PRMUndoRec);
begin
  if aActionRec.Stream <> nil then
  begin
    aActionRec.Stream.Free;
    aActionRec.Stream := nil;
  end;
  SetLength(aActionRec.Objects, 0);
  SetLength(aActionRec.Objects1, 0);
end;

procedure TRMGridReportDesignerForm.ClearUndoBuffer;
var
  i: Integer;
begin
  for i := 0 to FUndoBufferLength - 1 do
    ReleaseAction(@FUndoBuffer[i]);
  FUndoBufferLength := 0;

  MenuEditUndo.Enabled := False;
  ToolbarStandard.btnUndo.Enabled := MenuEditUndo.Enabled;
end;

procedure TRMGridReportDesignerForm.ClearRedoBuffer;
var
  i: Integer;
begin
  for i := 0 to FRedoBufferLength - 1 do
    ReleaseAction(@FRedoBuffer[i]);
  FRedoBufferLength := 0;

  MenuEditRedo.Enabled := False;
  ToolbarStandard.btnRedo.Enabled := MenuEditRedo.Enabled;
end;

procedure TRMGridReportDesignerForm.AddAction(aBuffer: PRMUndoBuffer; aAction: TRMUndoAction;
  aObject: TObject; aRec: PRMUndoRec);
var
  i: Integer;
  lBufferLength: Integer;

  function _FindObjectByID(aID: Integer): TRMView;
  var
    i: Integer;
    t: TRMView;
  begin
    Result := nil;
    for i := 0 to THackPage(Page).Objects.Count - 1 do
    begin
      t := THackPage(Page).Objects[i];
      if THackView(t).ObjectID = aID then
      begin
        Result := t;
        Break;
      end;
    end;
  end;

  procedure _SaveOneView(t: TRMView; aStream: TMemoryStream);
  begin
    THackView(t).StreamMode := rmsmDesigning;
    RMWriteByte(aStream, t.ObjectType);
    RMWriteString(aStream, t.ClassName);
    t.SaveToStream(aStream);
  end;

  procedure _SelectionToMemStream(aStream: TMemoryStream);
  var
    i, lRow, lCol, lCount: Integer;
    lCell: TRMCellInfo;
    lSavePos: Integer;
    t: TRMView;
    lStream: TMemoryStream;
  begin
    lStream := TMemoryStream.Create;
    try
      if aObject is TMemoryStream then
      begin
        RMWriteInt32(lStream, Length(aRec.Objects1));
        for i := 0 to Length(aRec.Objects1) - 1 do
        begin
          lCell := FGrid.Cells[aRec.Objects1[i].Col, aRec.Objects1[i].Row];
          RMWriteInt32(lStream, aRec.Objects1[i].Row);
          RMWriteInt32(lStream, aRec.Objects1[i].Col);
          _SaveOneView(lCell.View, lStream);
        end;

        RMWriteInt32(lStream, Length(aRec.Objects));
        for i := 0 to Length(aRec.Objects) - 1 do
        begin
          t := _FindObjectByID(aRec.Objects[i].ObjID);
          if t <> nil then
            _SaveOneView(t, lStream);
        end;
      end
      else
      begin
        lCount := 0;
        RMWriteInt32(lStream, 0);
        for lRow := 1 to FGrid.RowCount - 1 do
        begin
          lCol := 1;
          while lCol < FGrid.ColCount do
          begin
            lCell := FGrid.Cells[lCol, lRow];
            if (lCell.StartRow = lRow) and lCell.View.Selected then
            begin
              RMWriteInt32(lStream, lRow);
              RMWriteInt32(lStream, lCol);
              _SaveOneView(lCell.View, lStream);
              Inc(lCount);
              SetLength(aBuffer[lBufferLength].Objects1, lCount);
              aBuffer[lBufferLength].Objects1[lCount - 1].Row := lRow;
              aBuffer[lBufferLength].Objects1[lCount - 1].Col := lCol;
            end;
            lCol := lCell.EndCol + 1;
          end;
        end;

        lSavePos := lStream.Position;
        lStream.Position := 0;
        RMWriteInt32(lStream, lCount);
        lStream.Position := lSavePos;
        RMWriteInt32(lStream, 0);
        lCount := 0;
        for i := 0 to Page.Objects.Count - 1 do
        begin
          if TRMView(Page.Objects[i]).Selected then
          begin
            _SaveOneView(Page.Objects[i], lStream);
            Inc(lCount);
            SetLength(aBuffer[lBufferLength].Objects, lCount);
            aBuffer[lBufferLength].Objects[lCount - 1].ObjID := THackView(Page.Objects[i]).ObjectID;
          end;
        end;
        lStream.Position := lSavePos;
        RMWriteInt32(lStream, lCount);

        RMCompressStream(lStream, aStream, zcFastest);
      end;
    finally
      lStream.Free;
    end;
  end;

  procedure _SaveCellSize(aStream: TMemoryStream);
  var
    i: Integer;
  begin
    RMWriteInt32(aStream, FGrid.RowCount);
    RMWriteInt32(aStream, FGrid.ColCount);
    for i := 1 to FGrid.RowCount - 1 do
      RMWriteInt32(aStream, FGrid.RowHeights[i]);
    for i := 1 to FGrid.ColCount - 1 do
      RMWriteInt32(aStream, FGrid.ColWidths[i]);
  end;

  procedure _SaveGridProp(aStream: TMemoryStream);
  var
    lStream: TMemoryStream;
  begin
    lStream := TMemoryStream.Create;
    try
      FGrid.SaveToStream(lStream);
      RMCompressStream(lStream, aStream, zcFastest);
    finally
      lStream.Free;
    end;
  end;

  procedure _SavePageProp(aStream: TMemoryStream);
  var
    i: Integer;
    t: TRMView;
    lStream: TMemoryStream;
  begin
    lStream := TMemoryStream.Create;
    try
      RMWriteInt32(lStream, Page.Objects.Count);
      for i := 0 to Page.Objects.Count - 1 do
      begin
        t := Page.Objects[i];
        RMWriteByte(lStream, t.ObjectType);
        RMWriteString(lStream, t.ClassName);
        THackView(t).StreamMode := rmsmDesigning;
        t.SaveToStream(lStream);
      end;
      THackPage(Page).SaveToStream(lStream);
      RMCompressStream(lStream, aStream, zcFastest);
    finally
      lStream.Free;
    end;
  end;

begin
  if FUndoBusy then Exit;

  FUndoBusy := True;
  try
    if aBuffer = @FUndoBuffer then
      lBufferLength := FUndoBufferLength
    else
      lBufferLength := FRedoBufferLength;

    if lBufferLength >= MaxUndoBuffer then
    begin
      ReleaseAction(@aBuffer[0]);
      for i := 0 to MaxUndoBuffer - 2 do
        aBuffer^[i] := aBuffer^[i + 1];

      lBufferLength := MaxUndoBuffer - 1;
      aBuffer[lBufferLength].Stream := nil;
    end;

    aBuffer[lBufferLength].Action := aAction;
    aBuffer[lBufferLength].Page := CurPage;
    if aRec <> nil then
    begin
      SetLength(aBuffer[lBufferLength].Objects, Length(aRec.Objects));
      for i := 0 to Length(aRec.Objects) - 1 do
        aBuffer[lBufferLength].Objects[i].ObjID := aRec.Objects[i].ObjId;

      SetLength(aBuffer[lBufferLength].Objects1, Length(aRec.Objects1));
      for i := 0 to Length(aRec.Objects1) - 1 do
      begin
        aBuffer[lBufferLength].Objects1[i].Row := aRec.Objects1[i].Row;
        aBuffer[lBufferLength].Objects1[i].Col := aRec.Objects1[i].Col;
      end;
    end
    else
    begin
      SetLength(aBuffer[lBufferLength].Objects, 0);
      SetLength(aBuffer[lBufferLength].Objects1, 0);
    end;

    case aAction of
      acChangeCellSize:
        begin
          aBuffer[lBufferLength].Stream := TMemoryStream.Create;
          _SaveCellSize(aBuffer[lBufferLength].Stream);
        end;
      acChangeCellCount:
        begin
          aBuffer[lBufferLength].Stream := TMemoryStream.Create;
          _SaveGridProp(aBuffer[lBufferLength].Stream);
        end;
      acEdit:
        begin
          aBuffer[lBufferLength].Stream := TMemoryStream.Create;
          _SelectionToMemStream(aBuffer[lBufferLength].Stream);
        end;
      acChangePage:
        begin
          aBuffer[lBufferLength].Stream := TMemoryStream.Create;
          _SavePageProp(aBuffer[lBufferLength].Stream);
        end;
    end;

    if aBuffer = @FUndoBuffer then
    begin
      FUndoBufferLength := lBufferLength + 1;
    end
    else
    begin
      FRedoBufferLength := lBufferLength + 1;
    end;
  finally
    Modified := True;
    FUndoBusy := False;
  end;
end;

procedure TRMGridReportDesignerForm.OnGridKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Shift = [] then
  begin
    if Key = VK_F2 then
      OnGridDblClickEvent(nil);
    if (Key = VK_RETURN) and (not (rmgoEditing in FGrid.Options)) then
      OnGridDblClickEvent(nil);
  end
  else if (Key = VK_UP) and (Shift = [ssAlt]) then
  begin
    ToolbarBorder.btnDecHeight.Click;
  end
  else if (Key = VK_DOWN) and (Shift = [ssAlt]) then
  begin
    ToolbarBorder.btnIncHeight.Click;
  end
  else if (Key = VK_LEFT) and (Shift = [ssAlt]) then
  begin
    ToolbarBorder.btnDecWidth.Click;
  end
  else if (Key = VK_RIGHT) and (Shift = [ssAlt]) then
  begin
    ToolbarBorder.btnIncWidth.Click;
  end;
end;

procedure TRMGridReportDesignerForm.AddUndoAction(aAction: TRMUndoAction);
begin
  if (FDesignerComp <> nil) and (not FDesignerComp.UseUndoRedo) then Exit;
  if not (Page is TRMGridReportPage) then Exit;

  ClearRedoBuffer;
  if aAction in [acChangeCellSize, acChangeCellCount, acChangePage] then
  begin
    AddAction(@FUndoBuffer, aAction, nil, nil);
  end
  else
    AddAction(@FUndoBuffer, aAction, FGrid, nil);

  MenuEditUndo.Enabled := FUndoBufferLength > 0;
  ToolbarStandard.btnUndo.Enabled := MenuEditUndo.Enabled;
  MenuEditRedo.Enabled := FRedoBufferLength > 0;
  ToolbarStandard.btnRedo.Enabled := MenuEditRedo.Enabled;
end;

procedure TRMGridReportDesignerForm.Undo(aBuffer: PRMUndoBuffer);
var
  lBufferLength: Integer;

  function _FindObjectByID(aID: Integer): Integer;
  var
    i: Integer;
    t: TRMView;
  begin
    Result := -1;
    for i := 0 to THackPage(Page).Objects.Count - 1 do
    begin
      t := THackPage(Page).Objects[i];
      if THackView(t).ObjectID = aID then
      begin
        Result := i;
        Break;
      end;
    end;
  end;

  procedure _AssignObjects(aStream: TMemoryStream);
  var
    i, lCount, lRow, lCol: Integer;
    t: TRMView;
    lObjectTyp: Byte;
    lObjectClassName: string;
    lStream: TMemoryStream;

    procedure _LoadOneView;
    var
      lCreateFlag: Boolean;
    begin
      lCreateFlag := False;
      lObjectTyp := RMReadByte(aStream);
      lObjectClassName := RMReadString(aStream);
      t := Page.Objects[_FindObjectByID(aBuffer[lBufferLength - 1].Objects[i].ObjID)];
      if t = nil then
      begin
        lCreateFlag := True;
        t := RMCreateObject(lObjectTyp, lObjectClassName);
      end;
      t.NeedCreateName := False;
      THackView(t).StreamMode := rmsmDesigning;
      t.LoadFromStream(aStream);
      if lCreateFlag then
        t.Free;
    end;

  begin
    lStream := TMemoryStream.Create;
    try
      aStream.Position := 0;
      RMDeCompressStream(aStream, lStream);
      lStream.Position := 0;
      lCount := RMReadInt32(lStream);
      for i := 0 to lCount - 1 do
      begin
        lRow := RMReadInt32(lStream);
        lCol := RMReadInt32(lStream);
        lObjectTyp := RMReadByte(lStream);
        lObjectClassName := RMReadString(lStream);
        FGrid.Cells[lCol, lRow].ReCreateView(lObjectTyp, lObjectClassName);
        t := FGrid.Cells[lCol, lRow].View;
        t.NeedCreateName := False;
        THackView(t).StreamMode := rmsmDesigning;
        t.LoadFromStream(lStream);
      end;

      lCount := RMReadInt32(lStream);
      for i := 0 to lCount - 1 do
      begin
        _LoadOneView;
      end;
    finally
      lStream.Free;
    end;
  end;

  procedure _SetUndo;
  var
    lAction: TRMUndoAction;
    lObject: TObject;
  begin
    lAction := acEdit;
    lObject := nil;
    case aBuffer[lBufferLength - 1].Action of
      acChangeCellSize:
        begin
          lAction := acChangeCellSize;
          lObject := nil;
        end;
      acChan