ceph/src/jaegertracing/thrift/lib/delphi/test/ConsoleHelper.pas

   1 (*
   2  * Licensed to the Apache Software Foundation (ASF) under one
   3  * or more contributor license agreements. See the NOTICE file
   4  * distributed with this work for additional information
   5  * regarding copyright ownership. The ASF licenses this file
   6  * to you under the Apache License, Version 2.0 (the
   7  * "License"); you may not use this file except in compliance
   8  * with the License. You may obtain a copy of the License at
   9  *
  10  *   http://www.apache.org/licenses/LICENSE-2.0
  11  *
  12  * Unless required by applicable law or agreed to in writing,
  13  * software distributed under the License is distributed on an
  14  * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  15  * KIND, either express or implied. See the License for the
  16  * specific language governing permissions and limitations
  17  * under the License.
  18  *)
  19
  20 unit ConsoleHelper;
  21
  22 interface
  23
  24 uses Classes;
  25
  26 type
  27   TThriftConsole = class
  28   public
  29     procedure Write( const S: string); virtual;
  30     procedure WriteLine( const S: string); virtual;
  31   end;
  32
  33   TGUIConsole = class( TThriftConsole )
  34   private
  35     FLineBreak : Boolean;
  36     FMemo : TStrings;
  37
  38     procedure InternalWrite( const S: string; bWriteLine: Boolean);
  39   public
  40     procedure Write( const S: string); override;
  41     procedure WriteLine( const S: string); override;
  42     constructor Create( AMemo: TStrings);
  43   end;
  44
  45 function Console: TThriftConsole;
  46 procedure ChangeConsole( AConsole: TThriftConsole );
  47 procedure RestoreConsoleToDefault;
  48
  49 implementation
  50
  51 var
  52   FDefaultConsole : TThriftConsole;
  53   FConsole : TThriftConsole;
  54
  55 function Console: TThriftConsole;
  56 begin
  57   Result := FConsole;
  58 end;
  59
  60 { TThriftConsole }
  61
  62 procedure TThriftConsole.Write(const S: string);
  63 begin
  64   System.Write( S );
  65 end;
  66
  67 procedure TThriftConsole.WriteLine(const S: string);
  68 begin
  69   System.Writeln( S );
  70 end;
  71
  72 procedure ChangeConsole( AConsole: TThriftConsole );
  73 begin
  74   FConsole := AConsole;
  75 end;
  76
  77 procedure RestoreConsoleToDefault;
  78 begin
  79   FConsole := FDefaultConsole;
  80 end;
  81
  82 { TGUIConsole }
  83
  84 constructor TGUIConsole.Create( AMemo: TStrings);
  85 begin
  86   inherited Create;
  87   FMemo := AMemo;
  88   FLineBreak := True;
  89 end;
  90
  91 procedure TGUIConsole.InternalWrite(const S: string; bWriteLine: Boolean);
  92 var
  93   idx : Integer;
  94 begin
  95   if FLineBreak then
  96   begin
  97     FMemo.Add( S );
  98   end else
  99   begin
 100     idx := FMemo.Count - 1;
 101     if idx < 0 then
 102       FMemo.Add( S )
 103     else
 104       FMemo[idx] := FMemo[idx] + S;
 105   end;
 106   FLineBreak := bWriteLine;
 107 end;
 108
 109 procedure TGUIConsole.Write(const S: string);
 110 begin
 111   InternalWrite( S, False);
 112 end;
 113
 114 procedure TGUIConsole.WriteLine(const S: string);
 115 begin
 116   InternalWrite( S, True);
 117 end;
 118
 119 initialization
 120 begin
 121   FDefaultConsole := TThriftConsole.Create;
 122   FConsole := FDefaultConsole;
 123 end;
 124
 125 finalization
 126 begin
 127   FDefaultConsole.Free;
 128 end;
 129
 130 end.
 131
 132