从 TComboBox D7 分配字体答案

【问题标题】：Assign Font From TComboBox D7从 TComboBox D7 分配字体
【发布时间】：2013-01-08 16:13:58
【问题描述】：

德尔福 v7

让我先说我不是一个真正的程序员。我是一名副警长，我偶尔会写一个项目来帮助我们做我们所做的事情。

我当前的项目包含几个 TDBrichEdit 控件。我已经为工具栏按钮分配了各种格式化过程。我希望能够使用组合框更改 RichEdit 字体。组合框填充了字体列表，但它不影响 TDBrichEdit 控件的字体。一个多星期以来，我一直在尝试解决这个问题，但我看不到问题所在。

这就是我所做的：

Form OnCreate 过程

procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.ActivePage:= TabSheet1;
  GetFontNames;
  SelectionChange(Self);
  CurrText.Name := DefFontData.Name;
  CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);
  end;

表单选择更改

procedure TForm1.SelectionChange(Sender: TObject);
begin
  if ActiveControl is TDBRichEdit then
    with ActiveControl as
    TdbRichEdit do  begin
  try
    Ctrlupdating := True;

    Size.Text := IntToStr(SelAttributes.Size);
    cmbFont.Text := SelAttributes.Name; 
finally
    Ctrlupdating := False;
  end;
end;
end;

函数（除了“ActiveControl”部分，这些不是我的函数，我没有足够的知识来完全理解它们。）

Function TForm1.CurrText: TTextAttributes;
begin
if ActiveControl is TDBRichEdit then
    with ActiveControl as
    TdbRichEdit do  begin
  if SelLength > 0 then Result := SelAttributes
  else Result := DefAttributes;
end;
end;

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

组合框的 OnDraw 事件

procedure TForm1.cmbFontDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
 begin
 with (Control as TComboBox).Canvas do
  begin
    Font.Name := Screen.Fonts.Strings[Index];
    FillRect(Rect) ;
    TextOut(Rect.Left, Rect.Top, PChar(Screen.Fonts.Strings[Index]));

  end;
  end;

组合框的 OnChange 事件

procedure TForm1.cmbFontChange(Sender: TObject);
begin
if Ctrlupdating then Exit;
  CurrText.Name := cmbFont.Items[cmbFont.ItemIndex];
end;

有什么想法吗？

【问题讨论】：

我的意思是我在上面的评论中所说的。你的一些老问题有很好的答案，应该被接受。

标签： delphi

【解决方案1】：

在您的代码中，您尝试修改此代码中的文本属性：

procedure TForm1.cmbFontChange(Sender: TObject); 
begin 
  if Ctrlupdating then Exit;
  CurrText.Name := cmbFont.Items[cmbFont.ItemIndex];
end;

当此代码执行时，ActiveControl 将为 cmbFont。现在看看 CurrText。

if ActiveControl is TDBRichEdit then
  with ActiveControl as TdbRichEdit do 
  begin
    if SelLength > 0 then
      Result := SelAttributes
    else 
      Result := DefAttributes;
  end;

所以，第一个 if 块不会被输入。

事实上，在这种情况下，您的函数似乎没有为 Result 分配任何内容。您必须始终分配给结果。当您启用警告和提示时，编译器会告诉您这一点。

您应该直接指定富编辑实例，而不是使用 ActiveControl。我不知道您的表单是如何排列的，但是您需要使用其他方法来确定要应用更改的富编辑控件。可能基于页面控件的活动页面。

【讨论】：

【解决方案2】：

我设法让组合框工作。我的代码可能很尴尬，但它确实有效。谢谢您的帮助。如果没有它，我将无法解决这个问题。

我为每个 Richedit 控件编写了一个单独的函数。使用 FormCreate 我必须为每个函数添加行

procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.ActivePage:= TabSheet1;
  GetFontNames;
  SelectionChange(Self);
  **CurrText.Name := DefFontData.Name;
  CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);**
  end;

在 SelectionChange 中，我必须调用富编辑控件的 PARAGRAPH 属性。我无法集体做到这一点。我只处理了富编辑控件“reProc”。其他人似乎与那一行工作得很好。我想了解那个。

表单选择更改 过程 TForm1.SelectionChange(Sender: TObject); 开始如果 ActiveControl 是 TDBrichEdit 则以 reProc.Paragraph 开始尝试开始

你给了我这个想法。我无法集中处理所有的richedit 控件，所以我分别为每个richedit 控件编写了一个函数。

function TForm1.CurrText: TTextAttributes;
begin
 if reProc.SelLength > 0 then Result := reProc.SelAttributes
  else Result := **reProc.DefAttributes;**

对于组合框的 OnChange 事件，我必须为每个函数添加行

procedure TForm1.cmbFontChange(Sender: TObject);
begin
 if Ctrlupdating then Exit;
  **CurrText.Name := cmbFont.Items[cmbFont.ItemIndex];**
end;

【讨论】：