Insert a character from Character Map

Peter Kiers
Peter Kiers used Ask the Experts™
on
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

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Freelance Project Manager
Top Expert 2010
Commented:
first change your InsertText procedure to be a little less prone to exceptions
procedure TMainForm.InsertText(T: string);
Var
 DBRE:TDBRichEdit;
begin
 DBRE:=GetDBREFromTab(PageControl1.ActivePage);
 if Assigned(DBRE) Then With DBRE do
  begin
   SelLength := 0;
   SelText:=T;
  end;
end;

Open in new window

Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
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 KiersOperator

Author

Commented:
OKe it works, what about the closebtn?
Become a Certified Penetration Testing Engineer

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
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 KiersOperator

Author

Commented:
thanks 500 points are comming to you...

Peter Kiers
Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
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 KiersOperator

Author

Commented:
and where to declare fontname?
Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
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 KiersOperator

Author

Commented:
Thanks again.

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