Project Structure

• UnicodeData.dpr
• UnicodeData_MainForm.pas
• UnicodeData_MainForm.dfm {Form30}

program UnicodeData;

uses
  Forms,
  UnicodeData_MainForm in 'UnicodeData_MainForm.pas' {Form30};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm30, Form30);
  Application.Run;
end.

unit UnicodeData_MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ComCtrls, ExtCtrls, StrUtils;

type
  TForm30 = class(TForm)
    StringGrid1: TStringGrid;
    StatusBar1: TStatusBar;
    Panel2: TPanel;
    TreeView1: TTreeView;
    Splitter1: TSplitter;
    FontDialog1: TFontDialog;
    procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
    procedure StringGrid1DblClick(Sender: TObject);
  private
    nCurrentTab: Integer;
    sUnicodeDescr: TStringList;
  public
    procedure ParseUnicodeData (var Msg: TMessage); message wm_user + 1;
   end;

var
  Form30: TForm30;

implementation

{$R *.dfm}

// helper function
function GetCharDescr (nChar: Integer): string;
begin
  if nChar < 32 then
    Result := 'Char #' + IntToHex (nChar, 4) + ' [  ]'
  else
    Result := 'Char #' + IntToHex (nChar, 4) + ' [' + Char (nChar) + ']';
end;

procedure TForm30.FormCreate(Sender: TObject);
var
  nTag: Integer;
  I: Integer;
  J: Integer;
  topNode: TTreeNode;
begin
  for I := 0 to 15 do // (16 blocks of 16 pages = 256 pages) * 256 characters each
  begin
    nTag := I * 16;
    topNode := TreeView1.Items.Add (nil,
      GetCharDescr (nTag * 256) + '/' + GetCharDescr ((nTag + 15)* 256));
    for J := nTag to nTag + 15 do
    begin
      if (J < 216) or (J > 223) then
      begin
        TreeView1.Items.AddChildObject (
          topNode,
          GetCharDescr(J*256) + '/' + GetCharDescr(J*256+255),
          Pointer (J));
      end
      else
      begin
        TreeView1.Items.AddChildObject (
          topNode,
          'Surrogate Code Points',
          Pointer (J));
      end;
    end;
  end;

  // refresh border
  for I := 0 to 16 do
  begin
    StringGrid1.Cells[I + 1, 0] := IntToStr (I);
    StringGrid1.Cells[0, I + 1] := IntToStr (I*16);
  end;

  PostMessage (Handle, wm_user + 1, 0, 0);
end;

function ReadToSemicolon (strData: string; var nPos: Integer): string;
var
  nSemiPos: Integer;
begin
  nSemiPos := PosEx (';', strData, nPos);
  Result := Copy (strData, nPos, nSemiPos - nPos);
  nPos := nSemiPos + 1;
end;

function ReadToSpace (strData: string): string;
var
  nSemiPos: Integer;
begin
  nSemiPos := PosEx (' ', strData);
  if nSemiPos > 0 then
    Result := Copy (strData, 1, nSemiPos)
  else
    Result := strData; // all of it
end;


function ReadToNewLine (strData: string; var nPos: Integer): string;
var
  nNewLine: Integer;
begin
  nNewLine := PosEx (#0$A,strData, nPos);
  Result := Copy (strData, nPos, nNewLine - nPos);
  nPos := nNewLine + 1;
end;


procedure Skip8Semi (strData: string; var nPos: Integer);
var
  I: Integer;
begin
  for I := 1 to 8 do
  begin
    nPos := PosEx (';', strData, nPos) + 1;
  end;
end;

procedure TForm30.ParseUnicodeData (var Msg: TMessage);
var
  fStream: TFileStream;
  strNumber, strDescr1, strDescr2, strSingleLine: string;
  strData: AnsiString;
  nPos, nLinePos: Integer;
  sListFileData: TStringList;
  I: Integer;
begin
  StatusBar1.SimpleText := 'Parsing UnicodeData.txt';

  if not Assigned (sUnicodeDescr) then
    sUnicodeDescr := TStringList.Create
  else
    sUnicodeDescr.Clear;

  fStream := TFileStream.Create('UnicodeData.txt', fmOpenRead);
  try
    SetLength(strData, fStream.Size);
    fStream.ReadBuffer(strData[1], fStream.Size);
  finally
    fStream.Free;
  end;

  nPos := 1;
  // now parse the unicode data
  while nPos < Length (strData) - 2 do
  begin
    strSingleLine := ReadToNewLine (strData, nPos);
    nLinePos := 1;
    strNumber := ReadToSemicolon (strSingleLine, nLinePos);
    strDescr1 := ReadToSemicolon (strSingleLine, nLinePos);
    Skip8Semi (strSingleLine, nLinePos);
    strDescr2 := ReadToSemicolon (strSingleLine, nLinePos);
    // Inc (nPos, 4);

    if Length (strNumber) > 4 then
    begin
      StatusBar1.SimpleText := 'Exit at ' + strNumber + '=' + strDescr1 + ' ' + strDescr2;
      Break;
    end;
    sUnicodeDescr.Add(strNumber + '=' + strDescr1 + ' ' + strDescr2);

    if (nPos mod 10) = 0 then
    begin
      StatusBar1.SimpleText := 'Parsing UnicodeData.txt: ' + strNumber;
      Application.ProcessMessages;
    end;
  end;
end;

procedure TForm30.StringGrid1DblClick(Sender: TObject);
begin
  if FontDialog1.Execute then
    Font := FontDialog1.Font;
end;

procedure TForm30.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  gc: TGridCoord;
  nChar, nIndex: Integer;
  strChar: string;
begin
  gc := StringGrid1.MouseCoord(X, Y);
  nChar := nCurrentTab * 256 + (gc.Y - 1) * 16 + (gc.X - 1);
  StatusBar1.SimpleText := GetCharDescr (nChar);

  if Assigned (sUnicodeDescr) then
  begin
    strChar := IntToHex (nChar, 4);
    nIndex := sUnicodeDescr.IndexOfName(strChar);
    if nIndex >= 0 then
      StatusBar1.SimpleText := StatusBar1.SimpleText + ' -- ' +
        sUnicodeDescr.ValueFromIndex [nIndex];
  end;
end;

procedure TForm30.TreeView1Click(Sender: TObject);
var
  I, nStart: Integer;
begin
  if (TreeView1.Selected.Parent <> nil) then
  begin
    // a second level node
    nCurrentTab := Integer(TreeView1.Selected.Data); // the actual block
    nStart := nCurrentTab * 256;
    for I := 0 to 255 do
    begin
      StringGrid1.Cells [I mod 16 + 1, I div 16 + 1] :=
        IfThen (I + nStart >= 32, Char (I + nStart), '');
    end;
  end;
end;

end.

object Form30: TForm30
  Left = 0
  Top = 0
  Caption = 'UnicodeMap'
  ClientHeight = 600
  ClientWidth = 859
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 15
  object Splitter1: TSplitter
    AlignWithMargins = True
    Left = 311
    Top = 3
    Height = 575
    ExplicitLeft = 440
    ExplicitTop = 272
    ExplicitHeight = 100
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 581
    Width = 859
    Height = 19
    Panels = <>
    SimplePanel = True
  end
  object Panel2: TPanel
    Left = 317
    Top = 0
    Width = 542
    Height = 581
    Align = alClient
    TabOrder = 1
    object StringGrid1: TStringGrid
      AlignWithMargins = True
      Left = 4
      Top = 4
      Width = 534
      Height = 573
      Align = alClient
      ColCount = 17
      DefaultColWidth = 24
      RowCount = 17
      TabOrder = 0
      OnDblClick = StringGrid1DblClick
      OnMouseMove = StringGrid1MouseMove
    end
  end
  object TreeView1: TTreeView
    AlignWithMargins = True
    Left = 3
    Top = 3
    Width = 302
    Height = 575
    Align = alLeft
    Indent = 19
    TabOrder = 2
    OnClick = TreeView1Click
  end
  object FontDialog1: TFontDialog
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    Left = 432
    Top = 472
  end
end