cxgridexportlink.pas

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

PAS
1,695
字号
  try
  {$IFDEF DELPHI5}
    FProvider := TcxExport.Provider(AExportType, AFileName) as IcxExportProvider;
    FInternalProviderSupported := Supports(FProvider,
      IcxCellInternalCache, FInternalProvider);
  {$ELSE}
    TcxExport.Provider(AExportType, AFileName).GetInterface(IcxExportProvider, FProvider);
    FInternalProviderSupported := (FExport.QueryInterface(IcxCellInternalCache, FInternalProvider) = S_OK);
  {$ENDIF}
  except
    on EStreamError do
      raise EcxGridExport.Create(cxGetResourceString(@scxCantCreateExportOutputFile));
  end;
  FDefaultRowHeight := cxDefaultRowHeight;
  FGridView := AGridView;
  FGrid := AGrid;
  FRecordsList := TList.Create;
  FViewInfo := AViewInfo;
  FFileName := AFileName;
  FExportType := AExportType;
  FColumns := TcxExportScale.Create;
  FRows := TcxExportScale.Create;
end;

constructor TcxGridCustomExport.CreateFrom(AMasterExport: TcxGridCustomExport;
  AGridView: TcxCustomGridView; AViewInfo: TcxCustomGridViewInfo);
begin
  Create(AMasterExport.FileName, AMasterExport.ExportType,
    AGridView, AMasterExport.Grid, AViewInfo);
  Expand := AMasterExport.Expand;
  SaveAll := AMasterExport.SaveAll;
end;

destructor TcxGridCustomExport.Destroy;
begin
  FInternalProvider := nil;
  FProvider := nil;
  FreeAndNil(FRecordsList);
  FreeAndNil(FColumns);
  FreeAndNil(FRows);
  inherited Destroy;
end;

procedure TcxGridCustomExport.AddSeparators(const ASeparators: array of string);
var
  I: Integer;
  AExportWithSeparators: IcxExportWithSeparators;
begin
{$IFDEF DELPHI5}
  if Supports(Provider, IcxExportWithSeparators, AExportWithSeparators) then
{$ELSE}
  if (FExport.QueryInterface(IcxExportWithSeparators, AExportWithSeparators) = S_OK) then
{$ENDIF}
  begin
    for I := 0 to High(ASeparators) do
      AExportWithSeparators.AddSeparator(ASeparators[I]);
  end;
end;

procedure TcxGridCustomExport.DoExport;
begin                  
  CreateExportCache;
  BeforeCommit;             
  Provider.Commit;
end;

procedure TcxGridCustomExport.BeforeCommit;
begin
end;

function TcxGridCustomExport.CalculateViewViewInfo(AGridView: TcxCustomGridView;
  ABounds: TRect): TcxCustomGridViewInfo;
begin
  Result := nil;
  if not (AGridView is TcxCustomGridTableView) then Exit;
  Result := AGridView.CreateViewInfo;
  with Result as TcxCustomGridTableViewInfo do
  begin
    FirstRecordIndex := 0;
    MainCalculate(ABounds);
  end;
end;                                           

function TcxGridCustomExport.CheckNativeValue(AProperties: TcxCustomEditProperties;
  AItem: TcxCustomGridTableItem; const AValue: Variant): Variant;
begin
  try
    if (IsCurrencyItem(AItem) and IsCurrencyProperties(AProperties)) or
      (AProperties is TcxCurrencyEditProperties) then
      VarCast(Result, AValue, varCurrency)
    else
      if (VarType(AValue) = varCurrency) and not IsCurrencyItem(AItem) and
        not (AProperties is TcxCurrencyEditProperties) then
        VarCast(Result, AValue, varDouble)
      else
        Result := AValue;
  except
    on EVariantError do
      Result := AValue
    else
      raise;
  end;
end;

procedure TcxGridCustomExport.CreateExportCache;
begin
  Initialize;
  try
    ExtractRowsForExport;
    RegisterStyles;
    CreateExportCells;
    Columns.Arrange;
    Rows.Arrange;
    if not IsEmpty then
    begin
      Provider.SetRange(Columns.VisibleCount, Rows.VisibleCount, False);
      ExportCells;
    end;
  finally
    Finalize;
  end;
end;

procedure TcxGridCustomExport.CreateExportCells;
begin
end;

procedure TcxGridCustomExport.ExpandRecords(AFullExpand: Boolean);
var
  I: Integer;
  ARecord: TcxCustomGridRecord;
  AViewData: TcxCustomGridTableViewData;
begin
  if not GridView.InheritsFrom(TcxCustomGridTableView) then Exit;
  AViewData := (GridView as TcxCustomGridTableView).ViewData;
  if AFullExpand then
    AViewData.Expand(True)
  else
  begin
    I := 0;
    while I < AViewData.RecordCount - 1 do
    begin
      ARecord := AViewData.Records[I];
      if ARecord.Selected and ARecord.Expandable and not ARecord.Expanded then
        ARecord.Expanded := True
      else
        Inc(I);
    end;
  end;
end;

procedure TcxGridCustomExport.ExportCells;
var
  I: Integer;
begin
  for I := 0 to Columns.VisibleCount - 1 do
    Provider.SetColumnWidth(I, Columns.Delta[I]);
  for I := 0 to Rows.VisibleCount - 1 do
  begin
    if Rows.Delta[I] <> DefaultRowHeight then
      Provider.SetRowHeight(I, Rows.Delta[I]);
  end; 
  FillArea(Rect(0, 0, Columns.Count - 1, Rows.Count - 1),  DefaultStyleIndex);
end;

procedure TcxGridCustomExport.ExtractRowsForExport;
var
  I: Integer;
  ARecord: TcxCustomGridRecord; 
  AViewData: TcxCustomGridTableViewData;
begin
  if not (GridView.ViewData is TcxCustomGridTableViewData) then Exit;
  AViewData := GridView.ViewData as TcxCustomGridTableViewData;
  SaveAll := SaveAll or not HasSelectedRecords(GridView);
  Grid.BeginUpdate;
  try
    I := 0;
    while I < AViewData.RecordCount do
    begin
      ARecord := AViewData.Records[I];
      Inc(I);
      if not SaveAll and not HasSelectedChildren(ARecord) then Continue;
      if Expand then
        ARecord.Expanded := True;
      RecordsList.Add(Pointer(I - 1));
    end;
    for I := 0 to RecordCount - 1 do
      RecordsList[I] := AViewData.Records[Integer(RecordsList[I])];
  finally
    Grid.EndUpdate;
  end;
end;

procedure TcxGridCustomExport.FillArea(const ABounds: TRect; AStyleIndex: Integer;
  ABorderColor: TColor = clDefault; ABorders: TcxBorders = cxBordersAll);
var
  AStyle: TcxCacheCellStyle;
  I, J, AActualStyleIndex: Integer;

  procedure SetBorderStyle(ASide: TcxBorder);
  begin
    AStyle.Borders[Integer(ASide)].IsDefault := False;
    AStyle.Borders[Integer(ASide)].Width := 1;
    AStyle.Borders[Integer(ASide)].Color := ColorToRgb(ABorderColor);
  end;

begin
  for I := ABounds.Top to ABounds.Bottom - 1 do
    for J := ABounds.Left to ABounds.Right - 1 do
    begin
      AActualStyleIndex := AStyleIndex;
      if (ABorderColor <> clDefault) and (ABorders <> []) then
      begin
        AStyle := Provider.GetStyle(AStyleIndex)^;
        if J = ABounds.Left then
          SetBorderStyle(bLeft);
        if I = ABounds.Top then
          SetBorderStyle(bTop);
        if J = ABounds.Right - 1 then
          SetBorderStyle(bRight);
        if I = ABounds.Bottom - 1 then
          SetBorderStyle(bBottom);
        AActualStyleIndex := Provider.RegisterStyle(AStyle);
      end;
      Provider.SetCellStyle(J, I, AActualStyleIndex);
    end;
end;

procedure TcxGridCustomExport.FillRealArea(const ABounds: TRect; AStyleIndex: Integer;
  ABorderColor: TColor = clDefault; ABorders: TcxBorders = cxBordersAll);
var
  ALogicalBounds: TRect;
begin
  RealBoundsToLogicalBounds(ABounds, ALogicalBounds);
  FillArea(ALogicalBounds, AStyleIndex, ABorderColor, ABorders);
end;

procedure TcxGridCustomExport.Finalize;
begin
  if FSaveGridModeFlag and (DataController is TcxDBDataController) then
  begin
    TcxDBDataController(DataController).DataModeController.GridMode := FSaveGridModeFlag;
    DataController.RestoreDataSetPos;
  end;
end;

function TcxGridCustomExport.GetContentParams(ARecord: TcxCustomGridRecord;
  AItem: TcxCustomGridTableItem; out AParams: TcxViewParams;
  ABorders: TcxBorders = []; ABorderColor: TColor = clDefault): TcxCacheCellStyle;
begin
  AItem.Styles.GetContentParams(ARecord, AParams);
  ViewParamsToExportStyle(AParams, Result, AItem.GetProperties.Alignment.Horz,
    ABorders, ABorderColor);
end;

function TcxGridCustomExport.GetViewItemValue(
  ARecord: TcxCustomGridRecord; AItem: TcxCustomGridTableItem): Variant;
var
  AProperties: TcxCustomEditProperties;
begin
  Result := GetViewItemValueEx(ARecord, AItem, AProperties);
end;

function TcxGridCustomExport.GetViewItemValueEx(ARecord: TcxCustomGridRecord;
   AItem: TcxCustomGridTableItem; out AProperties: TcxCustomEditProperties): Variant;
var
  S: string;
begin
  AProperties := AItem.GetProperties(ARecord);
  if IsNativeFormatProperties(AProperties, AItem) then
    Result := CheckNativeValue(AProperties, AItem, ARecord.Values[AItem.Index])
  else
  begin
    if AProperties.GetEditValueSource(False) = evsValue then
      S := AProperties.GetDisplayText(ARecord.Values[AItem.Index], True)
    else
      S := ARecord.DisplayTexts[AItem.Index];
    TcxCustomGridTableItemAccess.DoGetDisplayText(AItem, ARecord, S);
    Result := S;
  end;
end;

function TcxGridCustomExport.HasSelectedChildren(ARecord: TcxCustomGridRecord): Boolean;
begin
  Result := ARecord.Selected or ARecord.Expanded and (ARecord is TcxGridMasterDataRow) and
    (TcxGridMasterDataRow(ARecord).ActiveDetailGridView <> nil) and
    HasSelectedRecords(TcxGridMasterDataRow(ARecord).ActiveDetailGridView)
end;

function TcxGridCustomExport.HasSelectedRecords(AView: TcxCustomGridView): Boolean;
var
  I: Integer;
begin
  Result := False;
  if AView is TcxCustomGridTableView then
  begin
    Result := TcxCustomGridTableView(AView).Controller.SelectedRecordCount > 0;
    if Result then Exit;
    for I := 0 to TcxCustomGridTableView(AView).ViewData.RecordCount - 1 do
      if HasSelectedChildren(TcxCustomGridTableView(AView).ViewData.Records[I]) then
      begin
        Result := True;
        Break;
      end;
  end;
end;

procedure TcxGridCustomExport.Initialize;
begin
  FSaveGridModeFlag := DataController.IsGridMode;
  if FSaveGridModeFlag and (DataController is TcxDBDataController) then
  begin
    DataController.SaveDataSetPos;
    TcxDBDataController(DataController).DataModeController.GridMode := False;
  end;
  Columns.Add(0);
  Rows.Add(0);
end;

function TcxGridCustomExport.IsCurrencyItem(AItem: TcxCustomGridTableItem): Boolean;
var
  AField: TField;
begin
  Result := AItem.DataBinding.ValueTypeClass = TcxCurrencyValueType;
  if GridView.DataController is TcxGridDBDataController then
  begin
    AField := TcxGridDBDataController(GridView.DataController).GetItemField(AItem.Index);
    if AField is TFloatField then
      Result := TFloatField(AField).Currency
    else
      if AField is TBCDField then
        Result := TBCDField(AField).Currency
  {$IFDEF DELPHI5}
      else
        if AField is TAggregateField then
          Result := TAggregateField(AField).Currency
  {$ENDIF}
  {$IFDEF DELPHI6}
      else

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?