Richedittext nach Excel exportieren ?

[Ferber]

Hi !

Generelle Zeichenumsetzung - sehr schnell.
Für alle die zb DatanormDateien in Warenwirtschaft importieren müssen.
nix mit if ord... then ... wie zB:

Delphi-Quellcode:

for i := 1 to length(RichEdit1.Lines.Text) do 
begin 
  if ord(s[i]) = 128 then 
    s[i] := ' '; 
end;

getestet und seit Jahren im Einsatz

Delphi-Quellcode:

unit MyConvert;

interface

uses Windows, Classes, ComCtrls, SysUtils;

type
  TTxtConverter = class(TConversion)
  public
    function ConvertReadStream (Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; override;
    function ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; override;
  end;

  TAsciiTable = Array[0..$FF] of char;

  TConvertMode  = (cmNone,
                   cmDos2Win,          { Dos     -> Windows }
                   cmWin2Dos,          { Windows -> Dos     }
                   cmEps2Win,          { Epstik  -> Windows }
                   cmWin2Eps,          { Windows -> Epstik  }
                   cmEps2Dos,          { Epstik  -> Dos     }
                   cmDos2Eps,          { Dos     -> Epstik  }
                   cmSht2Win           { Shit    -> Windows }
                  );

  TTxtStream = class(TMemoryStream)
  private
    FConvertMode:TConvertMode;
    FAsciiTable :TAsciiTable;
    procedure ConvertMemory;
  protected
    procedure SetConvertMode(aConvertMode:TConvertMode);
    function GetAsString:String;
  public
    procedure InitAsciiTable;
    procedure SetCodes(sFrom, sTo:String);
    
    constructor Create(aConvertMode:TConvertMode);
    function ConvertString(st:String):String;
    function ConvertBuffer(Buffer:PChar; BufSize:Integer):PChar;

    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream  (Stream: TStream);

    procedure LoadFromFile  (aFileName:String);
    procedure SaveToFile    (aFileName:String);

    property ConvertMode: TConvertMode read FConvertMode write SetConvertMode;
    property Text: String read GetAsString;
  end;

function InvertConvertMode(aMode:TConvertMode):TConvertMode;

implementation

{ TTxtConverter ------------------------------------------------------------}

function TTxtConverter.ConvertReadStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer;
var
  s:TTxtStream;
begin
  Result := Stream.Read(Buffer^, BufSize);       // into the buffer
  s:=TTxtStream.Create(cmDos2Win);
  s.ConvertBuffer(Buffer, Result);
  s.Free;
end;

function TTxtConverter.ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer;
var
  s:TTxtStream;
begin
  s:=TTxtStream.Create(cmWin2Dos);
  s.ConvertBuffer(Buffer, BufSize);
  s.Free;
  Result := Stream.Write(Buffer^, BufSize);      // from the buffer
end;

{ Utils ----------------------------------------------------------------------}

function InvertConvertMode(aMode:TConvertMode):TConvertMode;
begin
  Result:=cmNone;
  case aMode of
    cmDos2Win:Result:=cmWin2Dos;
    cmWin2Dos:Result:=cmDos2Win;
    cmEps2Win:Result:=cmWin2Eps;
    cmWin2Eps:Result:=cmEps2Win;
    cmEps2Dos:Result:=cmDos2Eps;
    cmDos2Eps:Result:=cmEps2Dos;
  end
end;

{ TTxtStream -------------------------------------------------------------}

constructor TTxtStream.Create(aConvertMode:TConvertMode);
begin
  inherited create;
  SetConvertMode(aConvertMode);
end;

procedure TTxtStream.InitAsciiTable;
var
  i:Integer;
begin
  for i:=0 to $FF do FAsciiTable[i]:=Char(i);
end;

procedure TTxtStream.SetCodes(sFrom, sTo:String);
var
  i:Integer;
begin
  for i:=1 to Length(sFrom) do
    FAsciiTable[Byte(sFrom[i])]:=sTo[i];
end;

procedure TTxtStream.SetConvertMode(aConvertMode:TConvertMode);
begin
  InitAsciiTable;
  FConvertMode:=aConvertMode;
  case aConvertMode of
    cmDos2Win:SetCodes('Ž™š„”�áíñ'#196, 'ÄÖÜäöüßر'#151 );
    cmWin2Dos:SetCodes('ÄÖÜäöüßر'#151, 'Ž™š„”�áíñ'#196 );
    cmEps2Win:SetCodes('[\]{|}~'    ,'ÄÖÜäöüß' );
    cmWin2Eps:SetCodes('ÄÖÜäöüß'    ,'[\]{|}~' );
    cmEps2Dos:SetCodes('[\]{|}~'    ,'Ž™š„”�á' );
    cmDos2Eps:SetCodes('Ž™š„”�á'    ,'[\]{|}~' );
    cmSht2Win:SetCodes('Ž™š„”�áøý' ,'ÄÖÜäöüß°²');
  end
end;

function TTxtStream.ConvertString(st:String):String;
var
  i:Integer;
begin
  if ConvertMode<>cmNone then
  for i:=1 to Length(st) do
    st[i]:=FAsciiTable[Byte(st[i])];
  Result:=st;
end;

procedure TTxtStream.ConvertMemory;
var
  i:Integer;
begin
  if ConvertMode<>cmNone then
  for i:=1 to Size do
    PChar(Memory)[i]:=FAsciiTable[Byte(PChar(Memory)[i])];
end;

function TTxtStream.GetAsString;
begin
  if Size=0
     then Result:=''
     else begin
            SetLength(Result, Size+1);
            StrlCopy(PChar(Result), Memory, Size);
          end;
end;

function TTxtStream.ConvertBuffer(Buffer:PChar; BufSize:Integer):PChar;
var
  i:Integer;
begin
  if ConvertMode<>cmNone then
  for i:=1 to BufSize do
    Buffer[i]:=FAsciiTable[Byte(Buffer[i])];
  Result:=Buffer;
end;

procedure TTxtStream.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  ConvertMemory;
end;

procedure TTxtStream.SaveToStream  (Stream: TStream);
begin
  ConvertMemory;
  inherited SaveToStream(Stream);
end;

procedure TTxtStream.LoadFromFile  (aFileName:String);
begin
  try
    inherited LoadFromFile(aFileName);
    ConvertMemory;
  except
    Clear;
  end;
end;

procedure TTxtStream.SaveToFile    (aFileName:String);
begin
  ConvertMemory;
  inherited SaveToFile(aFileName);
end;

end.

Kann natürlich auch dazu verwendet werden um unerwünschte Zeichen zu unterdrücken.

Historische Hintergründe:
M$'s Keyboard Treiber hatte ~13k - warum auch immer.
Meiner hatte nur 2k. Damals war Speicher noch wertvoll.