Change fontname & size to multiple dynamicly RichEdit's.

Hi there,

In my previous question I have asked how to set the fontname/size
from a form called SettingsDlg to a richedit on the main form called MainForm.
I have received an excellent answer, and I have put the code of my example
in the code-section.

But now I want to change something:
Now I don't have a static RichEdit anymore. Now I have a procedure that
creates dynamicly PageControl Pages with a richedit on it. This procedure is
called at creation (so the application start always with 1 pagecontrol page)
and as menu-item (so the user can created more pages).

So now I want that when the user chooses another fontname/size
in the settingsdlg, the fontname/size will be changed on all richedits.

I have already a function and a procedure that counts all the pagecontrol's pages
with the richedit on it, and selects the ActivePage. Maybe the function can be reused again.

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;

procedure TMainForm.InsertText(T, 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;

Who can help me with my problem?

Greetings, Peter Kiers

unit Settings;

type
  TSettingsDlg = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    OKBtn: TButton;
    CancelBtn: TButton;
    HelpBtn: TButton;
    GroupBox1: TGroupBox;
    lblFontName: TLabel;
    lblFontSize: TLabel;
    edtFontSize: TSpinEdit;
    cbFontName: TComboBox;
    procedure OKBtnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    SettingsFile: string; 
    procedure GetFontNames;
    function CurrText: TTextAttributes;
    procedure LoadSettings;
    procedure SaveSettings;
  public
    { Public declarations }
    procedure ApplyDefaultSettings; 
  end;

var
  SettingsDlg: TSettingsDlg;

implementation

uses Main;

{$R *.dfm}

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;

procedure TSettingsDlg.ApplyDefaultSettings;
begin
// With MainForm.RichEdit1.DefAttributes do
// begin
//  Name := cbFontName.Items[cbFontName.ItemIndex];
//  Size := StrToInt(edtFontSize.Text);
// end;
end;

function TSettingsDlg.CurrText: TTextAttributes;
begin
//  if MainForm.RichEdit1.SelLength > 0 then Result := MainForm.RichEdit1.SelAttributes
//  else Result := MainForm.RichEdit1.DefAttributes;
end;

procedure TSettingsDlg.FormCreate(Sender: TObject);
begin
 GetFontNames;
 SettingsFile := ChangeFileExt(Application.ExeName, '.ini');
 LoadSettings;
end;

procedure TSettingsDlg.FormDestroy(Sender: TObject);
begin
 SaveSettings;
end;

procedure TSettingsDlg.GetFontNames;
var
  DC: HDC;
begin
  DC := GetDC(0);
  EnumFonts(DC, nil, @EnumFontsProc, Pointer(cbFontName.Items));
  ReleaseDC(0, DC);
  cbFontName.Sorted := True;
end;

procedure TSettingsDlg.LoadSettings;
var ini: TIniFile;
begin
  ini := TIniFile.Create(SettingsFile);
  try
   cbFontName.ItemIndex  := cbFontName.Items.IndexOf(ini.ReadString('Font', 'FaceName', Font.Name));
   edtFontSize.Value := ini.ReadInteger('Font', 'PointSize', Font.Size);
  finally
    FreeAndNil(ini)
  end;
end;

procedure TSettingsDlg.OKBtnClick(Sender: TObject);
begin
 With CurrText do
 begin
  Name := cbFontName.Items[cbFontName.ItemIndex];
  Size := StrToInt(edtFontSize.Text);
 end;
end;

procedure TSettingsDlg.SaveSettings;
var ini: TIniFile;
begin
  ini := TIniFile.Create(SettingsFile);
  try
    ini.WriteString('Font', 'FaceName', cbFontName.Items[cbFontName.ItemIndex]);
    ini.WriteInteger('Font', 'PointSize', edtFontSize.Value);
  finally
    FreeAndNil(ini)
  end;
end;

end.

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, DB, ADODB, ComCtrls, StdCtrls, ExtCtrls, DBCtrls;

type
  TMainForm = class(TForm)
    PageControl1: TPageControl;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Settings1: TMenuItem;
    Edit1: TMenuItem;
    Insert1: TMenuItem;
    NewPage1: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure NewPage1Click(Sender: TObject);
    procedure Settings1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure NewTab;
  end;

var
  MainForm: TMainForm;

implementation

uses Settings;

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  NewTab;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  SettingsDlg.ApplyDefaultSettings;
end;

procedure TMainForm.NewPage1Click(Sender: TObject);
begin
  NewTab;
end;

procedure TMainForm.NewTab;
var
  aRE: TRichEdit;
  tabSheet: TTabSheet;
begin
  tabSheet := TTabSheet.Create(PageControl1);
  tabSheet.PageControl := PageControl1;
  tabSheet.caption := 'Page ' + '(' + IntToStr(tabSheet.tabindex+1) + ')';
  aRE := TRichEdit.Create(tabSheet);
  aRE.Parent := tabSheet;
  aRE.Align := alClient;
  aRE.ParentFont := False;
  aRE.HideSelection := False;
  aRE.ScrollBars := ssVertical;
  aRE.Visible := True;
  PageControl1.ActivePage := tabSheet;
end;

procedure TMainForm.Settings1Click(Sender: TObject);
begin
  SettingsDlg.ShowModal;
end;

end.

Open in new window

LVL 1
peterkiersAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

twinsoftCommented:
Hi, you could do it like this:

procedure TSettingsDlg.OKBtnClick(Sender: TObject);
var
 i: Integer;
begin
 with MainForm do
  for i:=0 to tab.ControlCount-1 do
   if tab.Controls[i] is TDBRichEdit Then
    with tab.Controls[i] As TDBRichEdit do
     begin
      Name := cbFontName.Items[cbFontName.ItemIndex];
      Size := StrToInt(edtFontSize.Text);
     end;
end;


0
peterkiersAuthor Commented:
Isn't the ApplyDefaultSettings procedure better?
0
peterkiersAuthor Commented:
Or the currtext function?
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

peterkiersAuthor Commented:
I have commented these procedure and function because they don't work anymore.
Because the richedit is now dynamicly created:

procedure TSettingsDlg.ApplyDefaultSettings;
begin
// With MainForm.RichEdit1.DefAttributes do
// begin
//  Name := cbFontName.Items[cbFontName.ItemIndex];
//  Size := StrToInt(edtFontSize.Text);
// end;
end;

function TSettingsDlg.CurrText: TTextAttributes;
begin
//  if MainForm.RichEdit1.SelLength > 0 then Result := MainForm.RichEdit1.SelAttributes
//  else Result := MainForm.RichEdit1.DefAttributes;
end;

P.
0
twinsoftCommented:
ok, you can do the same thing by using ApplyDefaultSettings. You don't need Curr_Text function as it is good for one richedit only.

procedure TSettingsDlg.ApplyDefaultSettings;
begin
var
 i: Integer;
begin
 with MainForm do
  for i:=0 to tab.ControlCount-1 do
   if tab.Controls[i] is TDBRichEdit Then
    with (tab.Controls[i] As TDBRichEdit).DefAttributes do
     begin
      Name := cbFontName.Items[cbFontName.ItemIndex];
      Size := StrToInt(edtFontSize.Text);
     end;
end;

procedure TSettingsDlg.OKBtnClick(Sender: TObject);
begin
 ApplyDefaultSettings;
end;
0
peterkiersAuthor Commented:
OKE, i only get:

undeclared identifier tab

Peter
0
twinsoftCommented:
Sorry, try this:

procedure TSettingsDlg.ApplyDefaultSettings;
var
 z, i: Integer;
begin
 with MainForm.PageControl1 do
  for z := 0 to PageCount -1 do
   for i := 0 to Pages[z].ControlCount - 1 do
    if Pages[z].Controls[i] is TDBRichEdit Then
     with (Pages[z].Controls[i] As TDBRichEdit).DefAttributes do
      begin
       Name := cbFontName.Items[cbFontName.ItemIndex];
       Size := StrToInt(edtFontSize.Text);
      end;
end;
0
peterkiersAuthor Commented:
Allright, I get no errors anymore only its not working.

P>
0
twinsoftCommented:
I noticed you are using TRichEdit and not TDBRichEdit, so try this:

procedure TSettingsDlg.ApplyDefaultSettings;
var
 z, i: Integer;
begin
 with MainForm.PageControl1 do
  for z := 0 to PageCount -1 do
   for i := 0 to Pages[z].ControlCount - 1 do
    if Pages[z].Controls[i] is TRichEdit Then
     with (Pages[z].Controls[i] As TRichEdit).DefAttributes do
      begin
       Name := cbFontName.Items[cbFontName.ItemIndex];
       Size := StrToInt(edtFontSize.Text);
      end;
end;
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
peterkiersAuthor Commented:
Oke that works. Thanx.
500 points are comming to you...

Greetings, Peter Kiers
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.