Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Delphi 2009 Handbook

Project: StringConvert.dproj

Project Structure

StringConvert.dpr
program StringConvert;

uses
  Forms,
  StringConvertForm in 'StringConvertForm.pas' {FormStringConvert};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormStringConvert, FormStringConvert);
  Application.Run;
end.
StringConvertForm.pas
unit StringConvertForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TFormStringConvert = class(TForm)
    btnLatin1: TButton;
    Memo1: TMemo;
    btnConcat: TButton;
    btnWarning: TButton;
    btnToFile: TButton;
    btnFromFile: TButton;
    Button1: TButton;
    btnEnsure: TButton;
    procedure btnLatin1Click(Sender: TObject);
    procedure btnConcatClick(Sender: TObject);
    procedure btnWarningClick(Sender: TObject);
    procedure btnToFileClick(Sender: TObject);
    procedure btnFromFileClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure btnEnsureClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormStringConvert: TFormStringConvert;

implementation

uses
  Character;

{$R *.dfm}

const MaxLoop = 10000;

procedure TFormStringConvert.btnConcatClick(Sender: TObject);
var
  str1, str2: string;
  I: Integer;
  t1: TDateTime;
  str3: Utf8String;
  str4: AnsiString;
begin
  t1 := Now;
  str1 := 'Marco ';
  str2 := 'Cantù ';
  for I := 1 to MaxLoop do
    str1 := str1 + str2;
  t1 := now - t1;
  Memo1.Lines.Add ('plain: ' + FormatDateTime('nn:ss.zzz', t1));

  t1 := Now;
  str3 := 'Marco ';
  str4 := 'Cantù ';
  for I := 1 to MaxLoop do
    str3 := str3 + str4;
  t1 := now - t1;
  Memo1.Lines.Add ('mixed: ' + FormatDateTime('nn:ss.zzz', t1));
end;

{$INLINE OFF}
{$STRINGCHECKS ON}

function DoubleLengthOn(const S: UnicodeString): Integer;
begin
  Result := Length(S);
end;

function DoubleLengthUpperOn(const S: UnicodeString): Integer;
begin
  Result := Length(AnsiUppercase(S));
end;

{$STRINGCHECKS OFF}

function DoubleLengthOff(const S: UnicodeString): Integer;
begin
  Result := Length(S);
end;

function DoubleLengthUpperOff(const S: UnicodeString): Integer;
begin
  Result := Length(AnsiUppercase(S));
end;

{$STRINGCHECKS ON}

procedure TFormStringConvert.btnEnsureClick(Sender: TObject);
var
  str1: string;
  I, tot: Integer;
  t1: TDateTime;
begin
  str1 := 'Marco Cantù';

  t1 := Now;
  tot := 0;
  for I := 1 to MaxLoop * 1000 do
    Inc (tot, DoubleLengthUpperOn (str1));
  t1 := now - t1;
  Memo1.Lines.Add ('UpperOn: ' + FormatDateTime('nn:ss.zzz', t1));

  t1 := Now;
  tot := 0;
  for I := 1 to MaxLoop * 1000 do
    Inc (tot, DoubleLengthUpperOff (str1));
  t1 := now - t1;
  Memo1.Lines.Add ('UpperOff: ' + FormatDateTime('nn:ss.zzz', t1));

  t1 := Now;
  tot := 0;
  for I := 1 to MaxLoop * MaxLoop do
    Inc (tot, DoubleLengthOn (str1));
  t1 := now - t1;
  Memo1.Lines.Add ('On: ' + FormatDateTime('nn:ss.zzz', t1));

  t1 := Now;
  tot := 0;
  for I := 1 to MaxLoop * MaxLoop do
    Inc (tot, DoubleLengthOff (str1));
  t1 := now - t1;
  Memo1.Lines.Add ('Off: ' + FormatDateTime('nn:ss.zzz', t1));
end;

procedure TFormStringConvert.btnFromFileClick(Sender: TObject);
begin
  Memo1.Lines.LoadFromFile('test.txt'{, TEncoding.UTF8});
end;

procedure TFormStringConvert.btnToFileClick(Sender: TObject);
begin
  // TEncoding.UTF8.GetPreamble;
  Memo1.Lines.SaveToFile('test.txt', TEncoding.Unicode);
end;

procedure TFormStringConvert.btnWarningClick(Sender: TObject);
var
  str1: AnsiString;
  str3: string;
begin
  str3 := 'any string with a ' + ConvertFromUtf32 (16536);
  str1 := str3;
  Memo1.Lines.Add (str1);
  Memo1.Lines.Add (str3);
end;

const
  MaxLoop2 = 1000000;

procedure TFormStringConvert.Button1Click(Sender: TObject);
var
  str1: string;
  str2: AnsiString;
  I: Integer;
  t1: TDateTime;
  str3: Utf8String;
  str4: AnsiString;
begin
  str1 := 'Marco Cantù';
  t1 := Now;
  for I := 1 to MaxLoop2 do
    str1 := AnsiUpperCase (str1);
  t1 := now - t1;
  Memo1.Lines.Add ('AnsiUpperCase (string): ' + FormatDateTime('nn:ss.zzz', t1));

  str2 := 'Marco Cantù';
  t1 := Now;
  for I := 1 to MaxLoop2 do
    str2 := AnsiUpperCase (str2);
  t1 := now - t1;
  Memo1.Lines.Add ('AnsiUpperCase (AnsiString): ' + FormatDateTime('nn:ss.zzz', t1));
end;

type
  Latin1String = type AnsiString(28591);

procedure TFormStringConvert.btnLatin1Click(Sender: TObject);
var
  str1: AnsiString;
  str2: Latin1String;
  rbs: RawByteString;
begin
  str1 := 'any string with a €';
  str2 := str1; // 'any string with a €';

  Memo1.Lines.Add (str1);
  Memo1.Lines.Add (IntToStr (Ord (str1[19])));

  Memo1.Lines.Add (str2);
  Memo1.Lines.Add (IntToStr (Ord (str2[19])));

  rbs := str1;
  SetCodePage(rbs{str1}, 28591, True);
  Memo1.Lines.Add (rbs{str1});
  Memo1.Lines.Add (IntToStr (Ord (rbs{str1}[19])));
end;

end.
StringConvertForm.pas.dfm
object FormStringConvert: TFormStringConvert
  Left = 0
  Top = 0
  Caption = 'StringConvert'
  ClientHeight = 292
  ClientWidth = 554
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btnLatin1: TButton
    Left = 8
    Top = 8
    Width = 97
    Height = 25
    Caption = 'btnLatin1'
    TabOrder = 0
    OnClick = btnLatin1Click
  end
  object Memo1: TMemo
    Left = 120
    Top = 8
    Width = 425
    Height = 276
    Lines.Strings = (
      'Memo1')
    TabOrder = 1
  end
  object btnConcat: TButton
    Left = 8
    Top = 39
    Width = 97
    Height = 25
    Caption = 'btnConcat'
    TabOrder = 2
    OnClick = btnConcatClick
  end
  object btnWarning: TButton
    Left = 8
    Top = 101
    Width = 97
    Height = 25
    Caption = 'btnWarning'
    TabOrder = 3
    OnClick = btnWarningClick
  end
  object btnToFile: TButton
    Left = 8
    Top = 208
    Width = 97
    Height = 25
    Caption = 'btnToFile'
    TabOrder = 4
    OnClick = btnToFileClick
  end
  object btnFromFile: TButton
    Left = 8
    Top = 239
    Width = 97
    Height = 25
    Caption = 'btnFromFile'
    TabOrder = 5
    OnClick = btnFromFileClick
  end
  object Button1: TButton
    Left = 8
    Top = 70
    Width = 97
    Height = 25
    Caption = 'btnAnsiUpper'
    TabOrder = 6
    OnClick = Button1Click
  end
  object btnEnsure: TButton
    Left = 8
    Top = 152
    Width = 97
    Height = 25
    Caption = 'btnEnsure'
    TabOrder = 7
    OnClick = btnEnsureClick
  end
end
HTML file generated by PasToWeb, a tool by Marco Cantù
Copyright 2008 Marco Cantù