Einzelnen Beitrag anzeigen

Benutzerbild von eddy
eddy

Registriert seit: 4. Jan 2003
Ort: Sachsen
573 Beiträge
 
Delphi 5 Professional
 
#5
  Alt 6. Jun 2003, 23:43
Hallo bastos,

getestet und funktionsfähig:

Code:
procedure TFBrowser.ANSII1Click(Sender: TObject);
var
  abbr : boolean;
  headtxt, tx, s : string;
  i, j : integer;
  v : variant;
  ftyp : TFieldType;
begin
  if not Tab1.Active then exit;
  headtxt := FBrowser.Caption;
  s := ExtractFileName(Tab1.TableName);
  s := Copy(s,1,Pos('.',s)) + 'TXT';
  AssignFile(f, BrowDataPath + s);
  FBrowser.Caption := FBrowser.Caption + '    ' + Upper(BrowDataPath) + Lower(s);
  {$I-}
  Rewrite(f);
  if (IOResult) = 0 then begin
    InitGau(BotGau, Tab1);
    Tab1.DisableControls;
    tx := '';
    for i:= 0 to Tab1.FieldCount - 1 do begin
      if i > 0 then s := Tab1.FieldDefs.Items[i].Name;
      tx := tx + Upper(s);
      if i < Tab1.FieldCount - 1 then tx := tx + ';';
    end;
    WriteLn(f,tx);
    abbr := IOResult <> 0;
    Tab1.First;
    while (not abbr) and (not Tab1.Eof) do begin
      tx := '';
      for i:= 0 to Tab1.FieldCount - 1 do begin
        s := '';
        v := Tab1.Fields[i].AsVariant;
//        if v = Null then begin
//          ftyp := Tab1.FieldDefs.Items[i].DataType;
//        end;
        ftyp := Tab1.FieldDefs.Items[i].DataType;
        try
        case ftyp of
          ftString   :   if v = Null then s := '' else s:=Tab1.Fields[i].AsString;    { Zeichen- oder Stringfeld';}
          ftAutoInc  :   if v = Null then s := '' else str(v:20:0,s);                 { Autoinkrement-32-Bit -Integer-Feld als Zählerfeld}
          ftBytes    : if v = Null then s := '' else str(v:5:0,s);                  { Feste Anzahl von Bytes (binäre Speicherung)}
          ftSmallint,                                  { 16-Bit-Integer-Feld}
          ftInteger,                                   { 32-Bit-Integer-Feld}
          ftWord     :   if v = Null then s := '' else str(v:20:0,s);                 { Vorzeichenloses 16-Bit-Integer-Feld}
          ftBoolean  :
            if v = Null
              then s := 'Falsch'                            { Logisches Feld}
            else
            if v = true then s := 'Wahr' else s := 'Falsch';
          ftFloat,                                     { Numerisches Gleitkommafeld}
          ftCurrency :                                { Währungsfeld}
            begin
              if v = Null then v := 0;
              str(v:20:4,s);
              if Pos('.',s) > 0 then s := Copy(s,1,Pos('.',s)-1) + ',' + Copy(s,Pos('.',s)+1,length(s));
            end;

          ftDate     :   if v = Null then s := '' else s := DateToStr(v);     { Datumsfeld}
          ftTime     :   if v = Null then s := '' else s := TimeToStr(v);       { Zeitfeld}
          ftDateTime :   if v = Null then s := '' else s := DateTimeToStr(v);   { Feld für Datum und Zeit}

          ftBCD      : s:='#BCD#';        { Binärcodiertes Dezimalfeld}
          ftVarBytes :   s:='#VarBytes#';   { Variable Anzahl von Bytes (binäre Speicherung)}
          ftBlob     : s:='#Blob#';       { BLOB-Field}
          ftMemo     : if v = Null then s:='#Memo#' else s := v;       { Memofeld für Text}
          ftGraphic  :   s:='#Graphic#';    { Bitmap-Feld}
          ftFmtMemo  :   s:='#FMemo#';      { Formatiertes Memofeld für Text}
          ftParadoxOle:   s:='#PdoxOle#';    { Paradox-OLE-Feld}
          ftDBaseOle:   s:='#dBaseOle#';   { dBASE-OLE-Feld}
          ftTypedBinary:s:='#Binary#';     { Typisiertes Binärfeld}
        else
          s:='#???#';                      { Unbekannt oder unbestimmt}
        end; {end of case}
        except
          on E: Exception do s := '';
        end;
{        if Copy(s,1,1) <> '#' then begin}
          s := trim(s);
          j := Pos(';',s);
          while j > 0 do begin
            if j < length(s)
              then s := copy(s,1,j-1) + ',' + copy(s,j+1,length(s))
              else s := copy(s,1,j-1);
            j := Pos(';',s);
          end;

          tx := tx + s;
          if i < Tab1.FieldCount - 1 then tx := tx + ';';
{        end;}
      end; {of for i := 0 to FieldCount - 1}
      WriteLn(f,tx);
      abbr := IOResult <> 0;
      RefreshGau(BotGau); {, _rc_gau, _zel_gau, _rcg_gau);}
      Tab1.Next;
    end; {end of while}
    CloseGau(BotGau);
    Tab1.First;
    Tab1.EnableControls;
  end
  else begin
    {Fehler beim Erstellen der Export-Datei}
  end;

  CloseFile(f);
  {$I+}
  FBrowser.Caption := headtxt;
end;
Hab' ich schon vor einiger Zeit geschrieben, steht vielleicht ein bischen mehr drin als nötig, aber als Beispiel sollte es funktionieren.

mfg
eddy
  Mit Zitat antworten Zitat