• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 450
  • Last Modified:

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

0
peterkiers
Asked:
peterkiers
  • 6
  • 4
1 Solution
 
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
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
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
 
peterkiersAuthor Commented:
Oke that works. Thanx.
500 points are comming to you...

Greetings, Peter Kiers
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 6
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now