小编Arn*_*old的帖子

减少在VCL中花费的CPU时间

MIDI播放器尽可能精确地播放音符非常重要.我从来没有成功,总是指责计时器(参见前一个主题:如何防止提示中断计时器).最近我收购了ProDelphi并开始测量那段时间到底消耗了多少.结果非常令人惊讶,请参阅下面的示例代码.

procedure TClip_View.doMove (Sender: TObject; note, time, dure, max_time: Int32);
var x: Int32;
begin
{$IFDEF PROFILE}Profint.ProfStop; Try; Profint.ProfEnter(@self,1572 or $58B20000); {$ENDIF}
   Image.Picture.Bitmap.Canvas.Pen.Mode := pmNot;
   Image.Picture.Bitmap.Canvas.MoveTo (FPPos, 0);
   Image.Picture.Bitmap.Canvas.LineTo (FPPos, Image.Height);
   x := time * GPF.PpM div MIDI_Resolution;
   Image.Picture.Bitmap.Canvas.Pen.Mode := pmNot;
   Image.Picture.Bitmap.Canvas.MoveTo (x, 0);
   Image.Picture.Bitmap.Canvas.LineTo (x, Image.Height);
   FPPos := x;
//   Bevel.Left := time * GPF.PpM div MIDI_Resolution;
{$IFDEF PROFILE}finally; Profint.ProfExit(1572); end;{$ENDIF}
end; // doMove //
Run Code Online (Sandbox Code Playgroud)

测量结果是(在Intel i7-920上没有调试代码,2,7Ghz):

  1. 如图所示,代码为95微秒
  2. 所有被注释掉的时间为5.609毫秒,但现在注释掉的语句除外(Bevel.Left :=)
  3. 所有代码替换为0.056微秒 x := time * GPF.PpM …

delphi vcl bitmap

3
推荐指数
1
解决办法
762
查看次数

防止透明表单上的Click-thru

我想在表单中绘制函数而不显示表单背景.创建了一个TForm,其TransparentColor设置为True,TransParentColorValue设置为clWhite.只需在其上放置一个TImage,在位图上绘制一个函数,将其分配给图像,效果很好.有一个问题.我不能再单击该表单了.任何单击表单标题和clientarea导致单击底层应用程序.这是通过将TransparentColor设置为True引起的.如何防止这种"点击通过"?

更新 我尝试了Sertac的建议,我得到了一些非凡的结果.我按如下方式准备位图:

   Bitmap.Canvas.Brush.Color := clFuchsia;
   Bitmap.Canvas.FillRect (Rect (0, 0, Bitmap.Width, Bitmap.Height));
Run Code Online (Sandbox Code Playgroud)

当Color设置为clWhite和Forms TransparentColorValue时,表单完全启用了click-thru.

两者都设置为clBlack,表单可以移动,但边框不能调整大小,系统按钮不起作用

两者都设置为clFuchsia它表现为普通形式.嗯,它现在有用,但也许有人得到了解释?

delphi transparent tform delphi-xe

3
推荐指数
1
解决办法
961
查看次数

标准对话框不会弹出

我有一个带有TSaveDialog的表单.调用Execute函数时,从IDE运行时不会弹出.它确实运行单机时弹出.稍微测试一下,我发现所有TSave/TOpen对话框都不起作用.不工作意味着Execute在False没有弹出窗口的情况下返回(请参阅更新的代码示例:始终弹出消息'False'而不是在Dialog之前).在其它对话框(字体/颜色/等)的工作.

procedure TForm1.Button1Click(Sender: TObject);
begin
   if OpenPictureDialog1.Execute
      then ShowMessage ('True')
      else ShowMessage ('False');
end;
Run Code Online (Sandbox Code Playgroud)

在没有调试的情况下运行时,对话框也不会出现.选择Release或Debug配置也无关紧要.

显然IDE做了一些奇怪的事情.表单上有两个TSaveDialog组件,两者都显示相同的行为.

知道什么是错的吗?

在Windows 7上使用Delphi XE 更新1.使用TSaveDialogs的其他项目工作正常.

更新2发现有关TSaveDialog的原始问题适用于所有TSave/TOpen对话框.已编辑问题以包含此知识.

更新3我发现此链接出现类似错误.但是,我检查了注册表,但找不到提到的可执行文件.并且改变与XP的兼容性的提示不适用于imho,因为TSaveDialog在IDE之外正常工作.

delphi tsavedialog

2
推荐指数
1
解决办法
1111
查看次数

将位图保存在TScrollBox中的固定位置

我把各种各样的帧放在TScrollBox上.滚动时,它们正在正确滚动.现在我想添加一个保留在固定位置的位图.我尝试了一个与TScrollBox具有相同父级(TPanel)的TImage.即使我使用BringToFront,我也看不到分配给TImage的位图.

有人可以帮帮我吗?

提前致谢,

阿诺德

delphi fixed bitmap tscrollbox

1
推荐指数
1
解决办法
626
查看次数

TSpeedButton陷入了外观

我使用带有属性Flat集的TSpeedButton .当我按下它并产生异常时,它仍处于按下状态.下面图像的第一张图像是在按下按钮和第二张图像之前,当除外时,保留在该位置.

在此输入图像描述

使用了两个事件,OnMouseDown和OnMouseUp.事件处理程序的代码是:

procedure TVector_Choice.Button_Down (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   FStart_X  := X;
   FStart_Y  := Y;
   FSelected := True;
end; // MouseDown //

procedure TVector_Choice.Button_Up (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   Application.ProcessMessages;
   if Assigned (FOnSelect) and FSelected then
   begin
      FOnSelect (Sender);
      FSelected := False;
   end; // if
end; // MouseUp //
Run Code Online (Sandbox Code Playgroud)

例程Button_Up中发生异常FOnSelect (Sender);.异常是通过try..finally处理,以便重置鼠标指针.我不知道如何重置"按下"状态,这不是我在上面试过的'Down'状态.我无法在小型测试程序中重现此行为.我使用Delphi XE.

如何将此按钮自动重置为未按下状态?

delphi button

1
推荐指数
1
解决办法
1698
查看次数

为什么线程有时会挂在等待中?

在我的应用中,我使用基于线程的任务.他们工作正常,但有时他们挂起应用程序.在下面的代码中,procedure Stop有时会挂起WaitFor程序.那是因为FStopEvent.SetEvent并不总是起作用.

在正常执行期间,线程进入Execute程序,执行OnWork程序直到Stop被调用(设置Terminated),然后执行一些后处理然后退出.这是WaitFor戒烟的信号,每个人都很开心.在我的使用中,这是因为任务被销毁.在这种情况下,调用基类的析构函数Stop.

在某些情况下,这不起作用.Execute输入正确,OnWork程序调用执行正常,但没有反应FStopEvent.SetEvent.没有崩溃(except没有执行的声明)什么都没有.程序挂起,因为WaitFor没有返回.使用调试DCU,我可以将其追溯到程序挂起的WaitFor单位.该回调是一样的.ClassesWaitForSingleObject(H[0], INFINITE);OnWork

OnBeforeWork和OnAfterWork程序为零.MaxLoops = -1FreeOnTerminate = False.我非常绝望,希望有人有出路.

编辑1:WaitFor我说的是发生在类TEvent_Driven_Task下面列出.因为这个类是从类中派生的,TSimple_Task所以为了完整性我添加了这个类.

编辑2: Application.ProcessMessages已被删除,TSimple_Task.Stop因为Marjan Venema评论说这可能会导致问题.结果是相同的(程序挂起WaitFor).

unit Parallel_Event_Task;

interface

uses Forms, Windows, Classes, SysUtils, SyncObjs,
     Parallel_Simple_Task;

type
   TEvent_Driven_Task = class (TSimple_Task)
   private
      FWorkEvent: TEvent; // …
Run Code Online (Sandbox Code Playgroud)

delphi multithreading

1
推荐指数
1
解决办法
2579
查看次数

我的包装单位究竟在哪里?

我使用包装,我甚至创造它们,但我担心我永远不会理解它们.我最近安装了JCL和JVCL(顺便提一下很棒的包!).在表单上放置一些控件.一切都好.我的测试应用程序中也使用了相同的表单.编译器会询问jedi单位的位置:例如JvExControls.现在我通过将单元添加到我的项目来解决这个问题,但这对于Jedi文件来说是不可行的.

这似乎是一个路径问题,但到目前为止,我可以看到绝地设置路径好.我究竟做错了什么?

在此先感谢您的帮助.

delphi packages delphi-xe

1
推荐指数
1
解决办法
545
查看次数

如何删除 TTreeViewItem 中的所有子项?

有没有办法从 TTreeViewItem 中删除所有子项?我尝试过DeleteChildren,但这会导致崩溃。

我以为这是一个简单的问题,结果却产生了更多的问题。这就是为什么我解释我正在尝试做的事情。

我的应用程序尝试在 Delphi XE5 FMX 中生成目录树。我使用 TTreeView 来实现这一点。它首先生成一个驱动器列表,所有驱动器都属于 TTreeViewItem。当用户单击某个项目时,下面的目录将添加到该目录中,并且单击的 TTreeViewItem 将展开。当用户再次单击时,TTreeViewItem 就会崩溃。这有一个警告:下次用户单击同一个 TTreeViewItem 时,目录列表将添加到现有目录中,请参见下图。为了防止这种情况,我想首先清除当前列表。

重复目录的列表

当我尝试使用 TreeViewItem.DeleteChildren 从 TTreeViewItem 删除子项时,我在另一个位置遇到异常,请参见下图。

错误信息

至于一些问题:是的,我确信我只添加了 TTreeViewItems,这是我分配 OnClick 事件(import_directory_click)的唯一控件。为了确定起见,我已经添加了完整的代码并注释掉了非必需的内容。

我希望有人告诉我这个功能已经存在(找不到它),但即便如此我仍然想知道如何管理 TTreeView。

  procedure TMain.import_initialize;
  var
     Item: TTreeViewItem;
     drive: Char;
     start: string;
  begin
     Directory_Tree.Clear;

  {$IFDEF MSWINDOWS}
  // When Windows, just present a list of all existing drives
     for drive := 'C' to 'Z' do
     begin

  // A drive exists when its root directory exists
        start := drive + ':\';
        if TDirectory.Exists (start) then …
Run Code Online (Sandbox Code Playgroud)

delphi treeview firemonkey

1
推荐指数
1
解决办法
4621
查看次数

如何让Matplotlib的imshow生成图像而不被绘制

Matplotlib imshow很好地绘制了一个numpy数组。最好用以下代码说明:

from PIL import Image
import matplotlib.pyplot as plt
import numpy as np
rows, cols = 200, 200
mat = np.zeros ((rows, cols))
for r in range(rows):
    for c in range(cols):
        mat[r, c] = r * c
# Handle with matplotlib
plt.imshow(mat)
Run Code Online (Sandbox Code Playgroud)

它创建的图: 数字,这是我想要的。我想要的是没有轴的图像,因此通过谷歌搜索,我能够组装此功能:

def create_img (image, w, h):
    fig = plt.figure(figsize=(w, h), frameon=False)
    canvas = FigureCanvas(fig)
    #To make the content fill the whole figure
    ax = plt.Axes(fig, [0., 0., 1., 1.])
    ax.set_axis_off()
    fig.add_axes(ax)
    plt.grid(False)
    ax.imshow(image, aspect='auto', cmap='viridis') …
Run Code Online (Sandbox Code Playgroud)

python numpy matplotlib pillow

1
推荐指数
1
解决办法
1712
查看次数

有没有办法将项目(部分)复制到另一个项目?

我有一个大项目树,我决定以不同的方式设置我的测试.设置一个新的测试项目很简单,但从数十个目录复制数百个文件是一个很大的问题.有没有一种简单的方法从另一个项目树复制所有这些文件?

ide delphi

0
推荐指数
1
解决办法
770
查看次数

如何在FMX中显示TMemo中的任意一行?

我在Firemonkey中为TMemo添加了一行,我希望当有更多行可以在TMemo中显示时,添加的行被滚动到视图中.我找不到怎么做.我试过了

Display.Lines.Add (arg);
Caret.Line := Display.Lines.Count - 1;
Caret.Pos  := 0;
Display.CaretPosition := Caret;
Run Code Online (Sandbox Code Playgroud)

但这没有帮助.帮助非常有限,所以我不确定我在这里做什么.

更新

在尝试受访者的代码时,我注意到我测试了代码示例错误.我为此道歉,我唯一的理由是,当我编写并测试代码时,它已接近午夜了.上面的代码确实有效.我删除了Display.CaretVisible := True;原始代码中的语句,因为这不会影响我想要的行为.

delphi tmemo firemonkey-fm2

0
推荐指数
1
解决办法
2347
查看次数

使用Ln或Exp函数时除以零

在我的代码中,我有时会得到零除.调试器始终指向包含Ln或Exp函数的行.

使用Ln功能.正如您所看到的,本节中根本没有任何区分.vsn代表非常小的数字,等于1.0e-100.

 if a3 [row] <= 0 then a := vsn else
 if a3 [row] >= 1 then a := 1 - vsn
                  else a := a3 [row];
 costTerm := costTerm -1 * y [row] * Ln (a) -
                  (1 - 1 * y [row]) * Ln (1 - a);
Run Code Online (Sandbox Code Playgroud)

使用Exp函数:这里存在一个除法,但是没有看到它如何产生零除错误.

function TBack_Prop.g (value: double): double;
begin
   Result := 1 / (1 + exp (-value));
end; // g //
Run Code Online (Sandbox Code Playgroud)

知道我做错了什么吗?

delphi math delphi-xe5

0
推荐指数
1
解决办法
555
查看次数