asked on

Insert a character from Character Map

Dear experts,

I have made a Character Map and I have put the code
in the code-section.

It works great, the only thing i got left is the Insert-button and
the close-button.

It have to be like this:

When a user clicks on a certain character on the Character Map and then clicks on the Insert-button
the programm looks IF TreeView1.Selected.ImageIndex = Item_Image_Index is True. If so the character
will be displayed on a dynamic dbrichedit using the Insert Text procedure. If not then do nothing.
In either both ways the Character Map form stays active until the user clicks on the close-button.

procedure TMainForm.InsertText(T: string);
begin
GetDBREFromTab(PageControl1.ActivePage).SelLength := 0;
GetDBREFromTab(PageControl1.ActivePage).SelText:=T;
end;

function TMainForm.GetDBREFromTab(tab: TTabSheet): TDBRichEdit;
Var i:integer;
begin
Result:=nil;
for i:=0 to tab.ControlCount-1 do
if tab.Controls[i] is TDBRichEdit
Then Result:=tab.Controls[i] As TDBRichEdit;
end;

Who knows the solution and is willing to help me?

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 Stringgrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    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 19 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);
  end;
end;
(*---------------------------------------------------*)
end.

Open in new window

ASKER CERTIFIED SOLUTION

Emmanuel PASQUIER

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Emmanuel PASQUIER

then in the implementation of your CharacterMap unit , add your main form unit in uses, and call its InsertText function in the InsertBtn click event

implementation 

Uses MainFormUnit; 

procedure TCharacterMap.InsertBtnClick(Sender: TObject);
begin
 with StringGrid1 do
  MainForm.InsertText( Cells[Col,Row] );
end;

Open in new window

Peter Kiers

ASKER

OKe it works, what about the closebtn?

Emmanuel PASQUIER

if you have called your TCharacterMap form with ShowModal, then you have plenty of choices depending of the exact type of your button :

TButton , TBitBtn: set ModalResult property to mrOk , delphi will do everything for you
TSpeedButton : on the onClick event, set ModalResult:=mrOK; yourself

if you don't call it with ShowModal, then in the onClick of your button you call
Close;

Peter Kiers

ASKER

thanks 500 points are comming to you...

Peter Kiers

Emmanuel PASQUIER

the InsertText procedure is not changing the font of the text you insert. You should modify it this way :

procedure TMainForm.InsertText(T: string; FontName:String='');
Var
 DBRE:TDBRichEdit;
begin
 DBRE:=GetDBREFromTab(PageControl1.ActivePage);
 if Assigned(DBRE) Then With DBRE do
  begin
   SelLength := 0;
   SelText:=T;
   if FontName<>'' Then SelAttributes.Name:=FontName;
  end;
end;

and in you other unit :

procedure TCharacterMap.InsertBtnClick(Sender: TObject);
begin
 with StringGrid1 do
  MainForm.InsertText( Cells[Col,Row] , ComboBox1.Text );
end;

Open in new window

Peter Kiers

ASKER

and where to declare fontname?

Emmanuel PASQUIER

it's a new parameter of InsertText.
It has a default value if you need to call it the old fashion way (insert text without changing the font)

Peter Kiers

ASKER

Thanks again.

PK