Character Map

Peter Kiers
Peter Kiers used Ask the Experts™
on
Dear experts,

I have made a character Map.
Only there are a few things that I  like to chance but I don't know how:
1. Display the grid (like in the picture)
2. Align the characters with there cells (like in the picture)

I have tried a tutorial on Torry's site but it did not work.
Or I am doing something wrong.

I have put the code of my Character Map in the code-section.

Who knows the solution and is willing to help me.

Greetings, Peter Kiers
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;
    InsertBtn: TButton;
    CloseBtn: TButton;
    procedure ComboBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  var
  CharacterMap: TCharacterMap;

implementation

{$R *.dfm}

function IsTrueTypeFont(FontName : string):boolean; 
const 
  PITCH_MASK: byte = $0F;
var 
  TxMet: TTextMetric; 
  TempCanvas : TCanvas; 
  PitchTest : byte; 
begin
  TempCanvas:=TCanvas.Create; 
  TempCanvas.Handle:=CreateCompatibleDC(0) ; 
  TempCanvas.Font.Name:=FontName; 
  GetTextMetrics(TempCanvas.Handle, TxMet) ; 
  PitchTest:=TxMet.tmPitchAndFamily and PITCH_MASK;
  Result:=(PitchTest and TMPF_TRUETYPE) <> 0; 
  TempCanvas.free; 
end;
(*---------------------------------------------------*)
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.FormCreate(Sender: TObject);
var
 i: integer;
begin
ComboBox1.Items.Clear;
for i:=0 to Screen.Fonts.Count-1 do
if IsTrueTypeFont(Screen.Fonts[i])
Then ComboBox1.Items.Add(Screen.Fonts[i]);
 ComboBox1.ItemIndex := 0;
 ComboBox1Change(ComboBox1);
end;
(*---------------------------------------------------*)
end.

object CharacterMap: TCharacterMap
  Left = 0
  Top = 0
  BorderStyle = bsDialog
  Caption = 'Character Map'
  ClientHeight = 333
  ClientWidth = 764
  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 = 21
    ItemHeight = 13
    TabOrder = 0
    OnChange = ComboBox1Change
  end
  object StringGrid1: TStringGrid
    Left = 20
    Top = 56
    Width = 675
    Height = 178
    ColCount = 32
    DefaultColWidth = 20
    FixedCols = 0
    RowCount = 7
    FixedRows = 0
    TabOrder = 1
  end
  object InsertBtn: TButton
    Left = 253
    Top = 240
    Width = 75
    Height = 25
    Caption = 'Insert'
    TabOrder = 2
  end
  object CloseBtn: TButton
    Left = 334
    Top = 240
    Width = 75
    Height = 25
    Caption = 'Close'
    TabOrder = 3
  end
end

Open in new window

Example1.bmp
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
1) What is missing in your string grid that is different ? you have set Fixed Row/col to 0 ?

2) use the DefaultDrawing of your stringgrid to false
and onDrawCell Event
You will probably have to manage different colors corresponding to state, but here is the idea

procedure TfrmTMAdmin.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
Var
 S:String;
begin
 S:=StringGrid1.Cells[ACol,ARow];
 With StringGrid1.Canvas do 
  begin
   FillRect(Rect);
   TextOut(
    Rect.Left+(Rect.Right-Rect.Left-TextWidth(S)) Div 2,
    Rect.Top+(Rect.Bottom-Rect.Top-TextHeight(S)) Div 2,
    S);
  end;
end;

Open in new window

Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
1) And DefaultColWidth / RowHeight ?
Something like this?


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; 
    InsertBtn: TButton; 
    CloseBtn: TButton;
    DrawGrid1: TDrawGrid;
    procedure ComboBox1Change(Sender: TObject); 
    procedure FormCreate(Sender: TObject);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    FFontHeight: integer;
    { Private declarations } 
  public 
    { Public declarations } 
  end; 
 
  var 
  CharacterMap: TCharacterMap; 
 
implementation 
 
{$R *.dfm}

uses
  Math;
 
function IsTrueTypeFont(FontName : string):boolean;  
const  
  PITCH_MASK: byte = $0F; 
var  
  TxMet: TTextMetric;  
  TempCanvas : TCanvas;  
  PitchTest : byte;  
begin 
  TempCanvas:=TCanvas.Create;  
  TempCanvas.Handle:=CreateCompatibleDC(0) ;  
  TempCanvas.Font.Name:=FontName;  
  GetTextMetrics(TempCanvas.Handle, TxMet) ;  
  PitchTest:=TxMet.tmPitchAndFamily and PITCH_MASK; 
  Result:=(PitchTest and TMPF_TRUETYPE) <> 0;  
  TempCanvas.free;  
end; 
(*---------------------------------------------------*) 
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);
  DrawGrid1.Font.Name := ComboBox1.Text;
  // calculate the max height of the characters to show
  FFontHeight := 0;
  for i := 31 to 255 do
    FFontHeight := Max(FFontHeight, DrawGrid1.Canvas.TextHeight(Chr(i)));
end;

(*---------------------------------------------------*)
procedure TCharacterMap.FormCreate(Sender: TObject);
var
 i: integer;
begin
ComboBox1.Items.Clear;
for i:=0 to Screen.Fonts.Count-1 do
if IsTrueTypeFont(Screen.Fonts[i])
Then ComboBox1.Items.Add(Screen.Fonts[i]);
 ComboBox1.ItemIndex := 0;
 ComboBox1Change(ComboBox1);
end;
(*---------------------------------------------------*)

procedure TCharacterMap.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  iCharWidth: integer;
  cCharacter: Char;
begin
  if gdSelected in State then begin
    DrawGrid1.Canvas.Brush.Color := clWindowText;
    DrawGrid1.Canvas.Font.Color := clWindow;
  end else begin
    DrawGrid1.Canvas.Brush.Color := clWindow;
    DrawGrid1.Canvas.Font.Color := clWindowText;
  end;
  DrawGrid1.Canvas.FillRect(Rect);
  cCharacter := Chr(((ARow + 1) * 32) + (ACol));
  iCharWidth := DrawGrid1.Canvas.TextWidth(cCharacter);
  DrawGrid1.Canvas.TextOut( Rect.Left + ((Rect.Right - Rect.Left) - iCharWidth) div 2 ,
                            Rect.Top + ((Rect.Bottom - Rect.Top) - FFontHeight) div 2,
                            cCharacter);
end;


end.


object CharacterMap: TCharacterMap
  Left = 0
  Top = 0
  BorderStyle = bsDialog
  Caption = 'Character Map'
  ClientHeight = 592
  ClientWidth = 764
  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 = 21
    ItemHeight = 13
    TabOrder = 0
    OnChange = ComboBox1Change
  end
  object StringGrid1: TStringGrid
    Left = 20
    Top = 56
    Width = 675
    Height = 178
    ColCount = 32
    DefaultColWidth = 20
    FixedCols = 0
    RowCount = 7
    FixedRows = 0
    TabOrder = 1
  end
  object InsertBtn: TButton
    Left = 253
    Top = 240
    Width = 75
    Height = 25
    Caption = 'Insert'
    TabOrder = 2
  end
  object CloseBtn: TButton
    Left = 334
    Top = 240
    Width = 75
    Height = 25
    Caption = 'Close'
    TabOrder = 3
  end
  object DrawGrid1: TDrawGrid
    Left = 20
    Top = 304
    Width = 675
    Height = 178
    ColCount = 32
    DefaultColWidth = 20
    FixedCols = 0
    RowCount = 7
    FixedRows = 0
    TabOrder = 4
    OnDrawCell = DrawGrid1DrawCell
  end
end

Open in new window

C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
Here is the completed drawCell event, with selected cell color & focus frame
procedure TfrmTMAdmin.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
Var
 S:String;
begin
 With StringGrid1, StringGrid1.Canvas do 
  begin
   S:=Cells[ACol,ARow];
   if (ARow=Row) And (ACol=Col) 
    Then Brush.Color:=clHighlight
    Else Brush.Color:=Color;
   FillRect(Rect);
   TextOut(
    Rect.Left+(Rect.Right-Rect.Left-TextWidth(S)) Div 2,
    Rect.Top+(Rect.Bottom-Rect.Top-TextHeight(S)) Div 2,
    S);
   if (gdFocused in State) then DrawFocusRect(Rect);
  end;
end;

Open in new window

Peter KiersOperator

Author

Commented:
1. In my Character Map you see the lines but not in black like the picture above.
 

Example1.jpg
Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
the color of the lines is one of the missing parameters. It is probably using the system color clWindowsFrame. I suppose you can re-draw them in the onDrawCell event


procedure TfrmTMAdmin.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
Var
 S:String;
begin
 With StringGrid1, StringGrid1.Canvas do 
  begin
   S:=Cells[ACol,ARow];
   if (ARow=Row) And (ACol=Col) Then 
    begin
     Brush.Color:=clHighlight
     Font.Color:=clHighlightText;
    end Else 
    begin
     Brush.Color:=Color;
     Font.Color:=clWindowText;
    end;
   FillRect(Rect);
   TextOut(
    Rect.Left+(Rect.Right-Rect.Left-TextWidth(S)) Div 2,
    Rect.Top+(Rect.Bottom-Rect.Top-TextHeight(S)) Div 2,
    S);
   if (gdFocused in State) then DrawFocusRect(Rect);
// draw the up/right frame of the cell (outside it's rect area)
   Pen.Color:=clBlack;
   MoveTo(Rect.Right+1,Rect.Top);
   LineTo(Rect.Right+1,Rect.Bottom+1);
   LineTo(Rect.Left+1,Rect.Bottom+1);
  end;
end;

Open in new window

Peter KiersOperator

Author

Commented:
I go for the StringGrid1DrawCell from Epasquier.

Only point1 remains: the lines of the grid in black.

Peter Kiers
Did you notice that

for z := 0 to 6 do
  for i := 0 to 31 do
   StringGrid1.Cells[i, z] := Chr((i + 1) * (z + 1) + 31);

is not working correctly?
Chr(((z+ 1) * 32) + (i))
works better
Freelance Project Manager
Top Expert 2010
Commented:
I changed the code for the black line, it works now.

And MvanderKooij is right it would work better with his calculation of the chars
By the way, you don't have to recalc the chars each time you change the font, just once at the start of your program is enough (FormCreate)
procedure TfrmTMAdmin.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
Var
 S:String;
begin
 With StringGrid1, StringGrid1.Canvas do 
  begin
   S:=Cells[ACol,ARow];
   if (ARow=Row) And (ACol=Col) Then 
    begin
     Brush.Color:=clHighlight;
     Font.Color:=clHighlightText;
    end Else 
    begin
     Brush.Color:=Color;
     Font.Color:=clWindowText;
    end;
   FillRect(Rect);
   TextOut(
    Rect.Left+(Rect.Right-Rect.Left-TextWidth(S)) Div 2,
    Rect.Top+(Rect.Bottom-Rect.Top-TextHeight(S)) Div 2,
    S);
   if (gdFocused in State) then DrawFocusRect(Rect);
// draw the up/right frame of the cell (outside it's rect area)
   Pen.Color:=clBlack;
   MoveTo(Rect.Right,Rect.Top);
   LineTo(Rect.Right,Rect.Bottom);
   LineTo(Rect.Left-1,Rect.Bottom);
  end;
end;

Open in new window

Peter KiersOperator

Author

Commented:
Yes, that's a good code from Espasquier
only one problem, maybe my fault:

I have 20 colums and 12 rows.
The grid isn't draw entirely as you can see in the picture.
I have put the code in the code section.

PK
function IsTrueTypeFont(FontName : string):boolean;
const
  PITCH_MASK: byte = $0F;
var
  TxMet: TTextMetric;
  TempCanvas : TCanvas;
  PitchTest : byte;
begin
  TempCanvas:=TCanvas.Create;
  TempCanvas.Handle:=CreateCompatibleDC(0) ;
  TempCanvas.Font.Name:=FontName;
  GetTextMetrics(TempCanvas.Handle, TxMet) ;
  PitchTest:=TxMet.tmPitchAndFamily and PITCH_MASK;
  Result:=(PitchTest and TMPF_TRUETYPE) <> 0;
  TempCanvas.free;
end;
(*---------------------------------------------------*)
procedure TCharacterMap.ComboBox1Change(Sender: TObject);
var
 i, z: Integer;
begin
 StringGrid1.Font.Name := ComboBox1.Text;
 for z := 0 to 11 do
  for i := 0 to 19 do
   StringGrid1.Cells[i, z] := Chr((i + 1) * (z + 1) + 31);
end;
(*---------------------------------------------------*)
procedure TCharacterMap.FormCreate(Sender: TObject);
var
 i: integer;
begin
ComboBox1.Items.Clear;
for i:=0 to Screen.Fonts.Count-1 do
if IsTrueTypeFont(Screen.Fonts[i])
Then ComboBox1.Items.Add(Screen.Fonts[i]);
 ComboBox1.ItemIndex := 0;
 ComboBox1Change(ComboBox1);
end;
(*---------------------------------------------------*)
procedure TCharacterMap.Stringgrid1DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
Var
 S:String;
begin
 With StringGrid1, StringGrid1.Canvas do 
  begin
   S:=Cells[ACol,ARow];
   if (ARow=Row) And (ACol=Col) Then 
    begin
     Brush.Color:=clHighlight;
     Font.Color:=clHighlightText;
    end Else
    begin
     Brush.Color:=Color;
     Font.Color:=clWindowText;
    end;
   FillRect(Rect);
   TextOut(
    Rect.Left+(Rect.Right-Rect.Left-TextWidth(S)) Div 2,
    Rect.Top+(Rect.Bottom-Rect.Top-TextHeight(S)) Div 2,
    S);
   if (gdFocused in State) then DrawFocusRect(Rect);
   Pen.Color:=clBlack;
   MoveTo(Rect.Right,Rect.Top);
   LineTo(Rect.Right,Rect.Bottom);
   LineTo(Rect.Left-1,Rect.Bottom);
  end;
end;
(*---------------------------------------------------*)
end.

Open in new window

Peter KiersOperator

Author

Commented:
forgot the picture...
Example2.jpg
Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
yes, that's the problem with drawing outside the cell rect. sometimes when using scrollbars the lines are drawn by the default grid paint, not the Cell paint, and without invalidating (redraw) all the cells.

I've looked in the source code of TStringGrid , the Silver color is hardcoded. So you have 3 solutions :
1) forget the black lines and keep the grey ones
2) forget the scrollbars, and use the code above to draw black lines with the cells.
3) get the source of VCL, change the hardcoded value in :
procedure TCustomGrid.Paint; in Grid.pas
(ancestor of all grid components)
and recompile all this unit.
and 4) there are better TStringGrid replacements, some have a grid color property. They probably are not free.

If I where you , I would go for 2) if possible then 1)
Peter KiersOperator

Author

Commented:
OKE, 500 points are comming to you...

I like the left and and top of the frame draw to, is that possible?

// draw the up/right frame of the cell (outside it's rect area)
   Pen.Color:=clBlack;
   MoveTo(Rect.Right,Rect.Top);
   LineTo(Rect.Right,Rect.Bottom);
   LineTo(Rect.Left-1,Rect.Bottom);
  end;
end;

Thanks.

PK

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial