Question

Delphi v7

让我先说一下我的补救问题，说我不是一个真正的程序员。我是副警长，我偶尔写一个项目来帮助我们做我们做的事情。

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

这就是我所做的：

表单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;

任何想法？

Answer 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。我不知道你的表单是如何安排的，但你需要使用其他方法来确定应用更改的丰富编辑控件。也许基于页面控件的活动页面。

Answer 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”进行了处理。其他人似乎与这一行合作得很好。我想了解那个。

表单选择更改 procedure 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;

从TComboBox D7分配字体

2 个答案: