Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Delphi 2009 Handbook

Project: UnicodeMap.dproj

Project Structure

UnicodeMap.dpr
program UnicodeMap;

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

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm30, Form30);
  Application.Run;
end.
UnicodeMap_MainForm.pas
unit UnicodeMap_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;
  end;

var
  Form30: TForm30;

implementation

{$R *.dfm}

// helper function
function GetCharDescr (nChar: Integer): string;
begin
  if nChar < 32 then
    Result := 'Char #' + IntToStr (nChar) + ' [  ]'
  else
    Result := 'Char #' + IntToStr (nChar) + ' [' + 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;
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;

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.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: Integer;
begin
  gc := StringGrid1.MouseCoord(X, Y);
  nChar := (gc.Y - 1) * 16 + (gc.X - 1);
  StatusBar1.SimpleText := GetCharDescr (nCurrentTab * 256 + nChar);
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.
UnicodeMap_MainForm.pas.dfm
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
    ExplicitTop = 0
  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
HTML file generated by PasToWeb, a tool by Marco Cantù
Copyright 2008 Marco Cantù