Character Map

Dear experts,

I have made a Character Map for my application. But there are a few
things that are not correct.

1. When the user clicks on the menu-item Special Character the form
    CharacterMap will be showed. But at the startup no font is selected
    in the combobox and the grid is not filled (picture1).

2. When I open the combobox to choose a font the fontlist is almost
    unreadable (picture2)

3. And the character in the cell of the grid should be aligned with the cell (see picture3).

Who knows the answer and is willing to help me?

I have put the code in the code-section.

Greetings, Peter Kiers

Calling from the main form:

procedure TMainForm.SpecialCharacter1Click(Sender: TObject);
begin
  CharacterMap.show;
end;

unit CharMap;

interface

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

type
  TCharacterMap = class(TForm)
    ComboBox1: TComboBox;
    StringGrid1: TStringGrid;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  CharacterMap: TCharacterMap;

implementation

{$R *.dfm}

procedure TCharacterMap.ComboBox1Change(Sender: TObject);
var 
 i, z: Integer;
begin 
 StringGrid1.Font.Name := ComboBox1.Text; 
 for z := 0 to 6 do
  for i := 0 to 31 do 
   StringGrid1.Cells[i, z] := Chr((i + 1) * (z + 1) + 31); 
end;
(*---------------------------------------------------*)
procedure TCharacterMap.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin 
  with Control as TComboBox do 
  begin
    Canvas.Font.Name := Items[Index]; 
    Canvas.FillRect(Rect); 
    Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
  end; 
end; 
(*---------------------------------------------------*)
procedure TCharacterMap.ComboBox1MeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
var 
  h: integer;
begin
  with Control as TComboBox do
  begin
    Canvas.Font.Name := Items[Index];
    h := Canvas.TextHeight(Items[Index]);
  end;
  Height := h;
end;
(*---------------------------------------------------*)
procedure TCharacterMap.FormCreate(Sender: TObject);
begin
 ComboBox1.Items := Screen.Fonts;
end;
(*---------------------------------------------------*)
end.

object CharacterMap: TCharacterMap
  Left = 0
  Top = 0
  BorderStyle = bsDialog
  Caption = 'Character Map'
  ClientHeight = 298
  ClientWidth = 713
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poMainFormCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 20
    Top = 23
    Width = 26
    Height = 13
    Caption = 'Font:'
  end
  object ComboBox1: TComboBox
    Left = 52
    Top = 20
    Width = 145
    Height = 22
    Style = csOwnerDrawFixed
    ItemHeight = 16
    TabOrder = 0
    OnChange = ComboBox1Change
    OnDrawItem = ComboBox1DrawItem
    OnMeasureItem = ComboBox1MeasureItem
  end
  object StringGrid1: TStringGrid
    Left = 28
    Top = 48
    Width = 677
    Height = 181
    ColCount = 32
    DefaultColWidth = 20
    FixedCols = 0
    RowCount = 7
    FixedRows = 0
    TabOrder = 1
  end
  object BitBtn1: TBitBtn
    Left = 504
    Top = 256
    Width = 75
    Height = 25
    Caption = 'OK'
    ModalResult = 1
    TabOrder = 2
  end
  object BitBtn2: TBitBtn
    Left = 600
    Top = 256
    Width = 75
    Height = 25
    Caption = 'Cancel'
    ModalResult = 1
    TabOrder = 3
  end
end

Select allOpen in new window

Example1.bmp
Example2.bmp
Example3.bmp