1

德尔福 v7

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

我当前的项目包含几个 TDBrichEdit 控件。我已经为工具栏按钮分配了各种格式化过程。我希望能够使用组合框更改 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;

有任何想法吗？

4

2 回答 2

2

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

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

于 2013-01-09T07:44:01.163 回答
0
于 2013-01-09T23:24:00.427 回答