* Merging revisions r43507 from trunk:

    ------------------------------------------------------------------------
    r43507 | michael | 2019-11-17 10:33:03 +0100 (Sun, 17 Nov 2019) | 1 line
    
    * Accidentally  made all published properties protected
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@43755 -

packages/fcl-db/src/export/fpfixedexport.pp

@@ -22,22 +22,46 @@ Type
   end;
 
   { TCustomFixedLengthExporter }
+  TCharMode = (cmANSI,cmUTF8,cmUTF16);
+
+  { TFixedExportFormatSettings }
+
+  TFixedExportFormatSettings = Class (TExportFormatSettings)
+  private
+    FCharMode: TCharMode;
+  Public
+    Procedure Assign(Source: TPersistent); override;
+  Published
+    Property CharMode : TCharMode Read FCharMode Write FCharMode;
+  end;
 
   TCustomFixedLengthExporter = Class(TCustomFileExporter)
   Private
-    FCurrentRow : String;
-    procedure OutputRow(const ARow: String);
+    FCurrentRow : RawByteString;
+    FCurrentRowUnicode : UnicodeString;
+    function GetCharMode: TCharMode;
+    function GeTFixedExportFormatSettings: TFixedExportFormatSettings;
+    procedure SeTFixedExportFormatSettings(AValue: TFixedExportFormatSettings);
   Protected
+    function ExportFieldAsUniCodeString(EF: TExportFieldItem): UnicodeString; virtual;
+    procedure ExportFieldAnsi(EF: TExportFieldItem); virtual;
+    procedure ExportFieldUTF16(EF: TExportFieldItem); virtual;
+    procedure ExportFieldUTF8(EF: TExportFieldItem); virtual;
     Procedure BuildDefaultFieldMap(AMap : TExportFields); override;
     Function  CreateExportFields : TExportFields; override;
+    Function  CreateFormatSettings: TCustomExportFormatSettings; override;
     Procedure DoBeforeExecute; override;
     Procedure DoAfterExecute; override;
     Procedure DoDataRowStart; override;
     Procedure ExportField(EF : TExportFieldItem); override;
     Procedure DoDataRowEnd; override;
+    Property CharMode : TCharMode Read GetCharMode;
+    Property FixedFormatSettings : TFixedExportFormatSettings Read GeTFixedExportFormatSettings Write SeTFixedExportFormatSettings;
   end;
 
   TFixedLengthExporter = Class(TCustomFixedLengthExporter)
+  Public
+    Property FixedFormatSettings;
   Published
     Property FileName;
     Property Dataset;
@@ -62,6 +86,15 @@ Resourcestring
 
 implementation
 
+{ TFixedExportFormatSettings }
+
+procedure TFixedExportFormatSettings.Assign(Source: TPersistent);
+begin
+  if (Source is TFixedExportFormatSettings) then
+    CharMode:=TFixedExportFormatSettings(Source).CharMode;
+  inherited Assign(Source);
+end;
+
 { TFixedLengthExportFieldItem }
 
 procedure TFixedLengthExportFieldItem.Assign(Source: TPersistent);
@@ -81,14 +114,27 @@ end;
 
 { TCustomFixedLengthExporter }
 
-procedure TCustomFixedLengthExporter.OutputRow(const ARow: String);
+
+procedure TCustomFixedLengthExporter.SeTFixedExportFormatSettings(AValue: TFixedExportFormatSettings);
 begin
-  Writeln(TextFile,ARow);
+  FormatSettings:=AValue;
+end;
+
+function TCustomFixedLengthExporter.GetCharMode: TCharMode;
+begin
+  Result:=FixedFormatSettings.CharMode;
+end;
+
+function TCustomFixedLengthExporter.GeTFixedExportFormatSettings: TFixedExportFormatSettings;
+begin
+  Result:=Formatsettings as TFixedExportFormatSettings;
 end;
 
 procedure TCustomFixedLengthExporter.BuildDefaultFieldMap(AMap: TExportFields);
 
 Const
+  RightAlignedFields = IntFieldTypes+FloatFieldTypes;
+
   // Mapping to TFieldType
   FieldWidths : Array[TFieldType] of integer =
     (
@@ -153,7 +199,7 @@ begin
       if (F.DataType in StringFieldTypes) then
         FL.Width:=F.Size;
       end;
-    If (F.DataType in IntFieldTypes) then
+    If (F.DataType in RightAlignedFields) then
       Fl.AlignField:=afRight;
     end;
 end;
@@ -163,6 +209,11 @@ begin
   Result:=TExportFields.Create(TFixedLengthExportFieldItem);
 end;
 
+function TCustomFixedLengthExporter.CreateFormatSettings: TCustomExportFormatSettings;
+begin
+  Result:=TFixedExportFormatSettings.Create(True);
+end;
+
 procedure TCustomFixedLengthExporter.DoBeforeExecute;
 begin
   inherited DoBeforeExecute;
@@ -183,6 +234,66 @@ end;
 
 procedure TCustomFixedLengthExporter.ExportField(EF: TExportFieldItem);
 
+begin
+  Case CharMode of
+    cmANSI : ExportFieldAnsi(EF);
+    cmUTF8 : ExportFieldUTF8(EF);
+    cmUTF16 : ExportFieldUTF16(EF);
+  end;
+end;
+
+
+Function TCustomFixedLengthExporter.ExportFieldAsUniCodeString(EF: TExportFieldItem) : UnicodeString;
+
+Var
+  S,SS : UnicodeString;
+  FL : TFixedLengthExportFieldItem;
+  L,W : Integer;
+
+begin
+  S:=UTF8Decode(FormatField(EF.Field));
+  If EF is TFixedLengthExportFieldItem then
+    begin
+    FL:=TFixedLengthExportFieldItem(EF);
+    W:=FL.Width;
+    end
+  else
+    W:=Length(S);
+  L:=Length(S);
+  If L>W then
+    begin
+    If (FL.AlignField=afLeft) then
+      S:=Copy(S,1,W)
+    else
+      Delete(S,1,L-W);
+    end
+  else if (L<W) then
+    begin
+    SS:=StringOfChar(' ',W-L);
+    If FL.AlignField=afRight then
+      S:=SS+S
+    else
+      S:=S+SS;
+    end;
+  Result:=S;
+end;
+
+procedure TCustomFixedLengthExporter.ExportFieldUTF16(EF: TExportFieldItem);
+
+begin
+  FCurrentRowUnicode:=FCurrentRowUnicode+ExportFieldAsUnicodeString(EF);
+end;
+
+
+procedure TCustomFixedLengthExporter.ExportFieldUTF8(EF: TExportFieldItem);
+
+
+begin
+  FCurrentRow:=FCurrentRow+UTF8Encode(ExportFieldAsUnicodeString(EF));
+end;
+
+procedure TCustomFixedLengthExporter.ExportFieldAnsi(EF: TExportFieldItem);
+
 Var
   S,SS : String;
   W,L : Integer;
@@ -218,8 +329,12 @@ end;
 
 procedure TCustomFixedLengthExporter.DoDataRowEnd;
 begin
-  OutputRow(FCurrentRow);
+  if (CharMode<>cmUTF16) then
+    Writeln(TextFile,FCurrentRow)
+  else
+    Writeln(TextFile,FCurrentRowUnicode);
   FCurrentRow:='';
+  FCurrentRowUnicode:='';
 end;
 
 Procedure RegisterFixedExportFormat;