标签: delphi-xe7

SearchBuf soWholeWord意外输出

使用选项测试StrUtils.SearchBuf[soWholeWord,soDown],会发生一些意外结果.

program Project1;

Uses
  SysUtils,StrUtils;

function WordFound(aString,searchString: String): Boolean;
begin
  Result := SearchBuf(PChar(aString),Length(aString), 0, 0, searchString, 
    [soWholeWord,soDown]) <> nil;
end;

Procedure Test(aString,searchString: String);
begin
  WriteLn('"',searchString,'" in "',aString,'"',#9,' : ',
    WordFound(aString,searchString));
end;

begin
  Test('Delphi','Delphi');   // True
  Test('Delphi ','Delphi');  // True
  Test(' Delphi','Delphi');  // False
  Test(' Delphi ','Delphi'); // False
  ReadLn;
end.
Run Code Online (Sandbox Code Playgroud)

为什么' Delphi'' Delphi '不被视为一个整体词?

反向搜索怎么样?

function WordFoundRev(aString,searchString: String): Boolean;
begin
  Result := SearchBuf(PChar(aString),Length(aString),Length(aString)-1,0,searchString, 
    [soWholeWord]) <> nil;
end;

Procedure TestRev(aString,searchString: String);
begin
  WriteLn('"',searchString,'" …
Run Code Online (Sandbox Code Playgroud)

delphi delphi-xe7

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

TParallel.For性能

鉴于以下在一维数组中查找奇数的简单任务:

begin
  odds := 0;
  Ticks := TThread.GetTickCount;
  for i := 0 to MaxArr-1 do
      if ArrXY[i] mod 2 = 0 then
        Inc(odds);
  Ticks := TThread.GetTickCount - Ticks;
  writeln('Serial: ' + Ticks.ToString + 'ms, odds: ' + odds.ToString);
end;
Run Code Online (Sandbox Code Playgroud)

看起来这将是并行处理的一个很好的候选者.因此可能会想要使用以下TParallel.For版本:

begin
  odds := 0;
  Ticks := TThread.GetTickCount;
  TParallel.For(0,  MaxArr-1, procedure(I:Integer)
  begin
    if ArrXY[i] mod 2 = 0 then
      inc(odds);
  end);
  Ticks := TThread.GetTickCount - Ticks;
  writeln('Parallel - false odds: ' + Ticks.ToString + 'ms, odds: ' + odds.ToString);
end;
Run Code Online (Sandbox Code Playgroud)

这种并行计算的结果在两个方面有点令人惊讶: …

delphi parallel-processing multithreading delphi-xe7

8
推荐指数
2
解决办法
4192
查看次数

创建透明的自定义位图画笔

问题定义

我正在尝试创建一个透明的自定义位图画笔,但它似乎没有按预期工作.如果你看一下这个例子.添加代码并连接绘制,创建和销毁事件.

type
  TForm3 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    FBitmap: TBitmap;
  end;

// Implementation

function CreateBlockBitmap(const APenColor: TColor): TBitmap;
begin
  Result := TBitmap.Create;
  Result.Transparent := True; 
  Result.Canvas.Brush.Color := clWhite;
  Result.Canvas.Brush.Style := bsClear;
  Result.PixelFormat := pf32bit;
  Result.SetSize(20, 20);
  Result.Canvas.Brush.Color := APenColor;
  Result.Canvas.Brush.Style := bsSolid;
  Result.Canvas.FillRect(Rect(0,0,10,10));
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  FBitmap.Free;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  FBitmap := CreateBlockBitmap(clRed);
end;

procedure TForm3.FormPaint(Sender: TObject);
var
  colNum: Integer;
  rowNum: Integer;
begin
  // Paint the rectangle using …
Run Code Online (Sandbox Code Playgroud)

delphi delphi-xe7

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

升级到XE7 update 1后,在iOS下使用THTTPGet与OpenSSL进行访问冲突

升级到Delphi XE7更新1后,当使用带有TIdSSLIOHandlerSocketOpenSSL的TIdHTTP连接到服务器时,我看到以下错误.

---------------------------
Debugger Exception Notification
---------------------------
Project Test_iOS raised exception class EAccessViolation with message 'Access violation at address 8FE090C9, accessing address C03F1E32'.
---------------------------
Break   Continue   Help   
---------------------------
Run Code Online (Sandbox Code Playgroud)

异常在IdSSLOpenSSL的第3133行抛出.

经过测试,可在Windows和Android平台上正常运行.

升级之前一切正常.我也同时更新到XCode 6.1,所以这可能是问题的一部分.

还有其他人看到类似的错误吗?有解决方法吗?

delphi ssl indy ios delphi-xe7

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

如何修复TSparseArray <T>?

由于未修复的错误System.Generics.Collections.TArray.Copy<T>(取决于已报告的错误System.CopyArray),有时会使用线程库引发异常.

方法中引发异常System.Threading.TSparseArray<T>.Add:

function TSparseArray<T>.Add(const Item: T): Integer;
var
  I: Integer;
  LArray, NewArray: TArray<T>;
begin
  ...
          TArray.Copy<T>(LArray, NewArray, I + 1); // <- Exception here
  ...
end;
Run Code Online (Sandbox Code Playgroud)

好吧,这是预计的错误System.CopyArray.因此,在尝试修复此问题时,我的第一个想法是简单地复制数组:

// TArray.Copy<T>(LArray, NewArray, I + 1); // <- Exception here
for LIdx := Low( LArray ) to High( LArray ) do
  NewArray[LIdx] := LArray[LIdx];
Run Code Online (Sandbox Code Playgroud)

奇迹般有效.但在那之后我想知道为什么需要数组副本:

LArray := FArray; // copy array reference from field
...
SetLength(NewArray, Length(LArray) * 2);
TArray.Copy<T>(LArray, NewArray, I + 1); …
Run Code Online (Sandbox Code Playgroud)

delphi multithreading delphi-xe7

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

PixelsPerInch的价值随windows主题而变化?

在Windows 7环境中,PixelsPerInch的值在Win7和经典主题之间切换时会有所不同.奇怪的是,虽然当前的Windows操作系统以150%的比例活动,但在Win7主题中,PixelsPerInch返回的值为96.

附表将进一步阐述.在此输入图像描述

delphi winapi delphi-2010 delphi-xe7

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

如何从新的线程库中使用TTask.WaitForAny?

为了尝试使用Delphi中的线程库并行计算任务并使用TTask.WaitForAny()获取第一个计算结果,异常暂时停止了执行.

在例外情况下调用堆栈:

$ 752D2F71的首次机会异常.异常类EMonitorLockException,消息'Object lock not owned'.处理Project1.exe(11248)

:752d2f71 KERNELBASE.RaiseException + 0x48
System.TMonitor.CheckOwningThread
System.ErrorAt(25,$408C70)
System.Error(reMonitorNotLocked)
System.TMonitor.CheckOwningThread
System.TMonitor.Exit
System.TMonitor.Exit($2180E40)
System.Threading.TTask.RemoveCompleteEvent(???)
System.Threading.TTask.DoWaitForAny((...),4294967295)
System.Threading.TTask.WaitForAny((...))
Project9.Parallel2
Project9.Project1
:74ff919f KERNEL32.BaseThreadInitThunk + 0xe
:7723b54f ntdll.RtlInitializeExceptionChain + 0x8f
:7723b51a ntdll.RtlInitializeExceptionChain + 0x5a
Run Code Online (Sandbox Code Playgroud)

调用堆栈得出的结论是异常是由线程库中的错误引起的,TMonitor和/或TTask.WaitForAny().为了验证这一点,代码被减少到最低限度:

program Project1;

{$APPTYPE CONSOLE}

uses
  System.SysUtils, System.Threading, System.Classes, System.SyncObjs,
  System.StrUtils;
var
  WorkerCount : integer = 1000;

function MyTaskProc: TProc;
begin
  result := procedure
    begin
      // Do something
    end;
end;

procedure Parallel2;
var
  i : Integer;
  Ticks: Cardinal;
  tasks: array …
Run Code Online (Sandbox Code Playgroud)

delphi multithreading delphi-xe7 rtl-ppl

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

从样式Dialog/ShowMessage边框中排除VCL样式

有没有办法从样式化系统对话框的边框中排除VCL样式.

特别是通过调用MessageDlg或ShowMessage显示的对话框.

我读了一些关于"德尔福之路"的文章(这是一个很棒的网站顺便说一句)但找不到答案.

这是我想要实现的目标:

现在(带有样式边框的碳风格):

现在

目标(带标准窗口边框的碳风格):

在此输入图像描述

我仍然想要样式控件但没有样式边框.

seBorder从父表单中删除StyleElements不起作用.

在此输入图像描述

谢谢!

delphi vcl vcl-styles delphi-xe7

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

如何存储参数化方法的类型参数,然后使用它们将JSON对象转换为泛型类型的普通对象?

我正在尝试为Delphi和.NET编写通用的消息传递系统.系统允许将消息定义为普通对象,并将消息处理程序定义为对这些对象起作用的匿名方法.

对象将转换为JSON,并在同一台计算机上运行的应用程序之间传递.每个应用程序都维护一个理解特定消息类型的处理程序列表.

我的类有许多参数化注册方法.有些采用单一类型参数.有些参数采用一对参数,其中一个表示请求对象,另一个表示响应对象.以下是请求/响应处理程序注册的内容:

procedure TTelegraph.RegisterRequestHandler<TRequest, TResponse>
  (requestTypeToHandle: string; handler: TFunc<TRequest, TResponse>);
begin
  FRequestHandlers.Add(requestTypeToHandle,
    TRequestHandler<TRequest, TResponse>.Create(handler,
    TRequest,
    TResponse));
end;
Run Code Online (Sandbox Code Playgroud)

FRequestHandlers是一个TDictionary<string,TRequestHandler>.注册方法如下调用:

  FTelegraph.RegisterRequestHandler<TTestRequest, TTestResponse>('My Request', 
    function(x: TTestRequest): TTestResponse
    begin
      Result := TTestResponse.Create;
      Result.Number := x.Number;
      Result.Message := Format('Received: %s', [x.Message]);
    end);
Run Code Online (Sandbox Code Playgroud)

泛型TRequestHandler<T1,T2>是一个DTO,它包含处理程序以及类型TRequestTResponse.它继承自非泛型TRequestHandler.我不确定是否有更好的方法可以解决这个问题,但这是我能想到的在单个集合中存储多个不相关类型的唯一方法.

这一切似乎都很好.问题是收到请求消息时.处理请求消息的C#代码如下所示:

private void ProcessRequestTelegram(Telegram request)
{
    var requestType = _RequestHandlers[request.MessageType].RequestType;
    var typedRequest = JsonConvert.DeserializeObject(request.Payload, requestType);
    var result = _RequestHandlers[request.MessageType].Handler.DynamicInvoke(typedRequest);
    var jsonPayload = JsonConvert.SerializeObject(result);
    var response = new Telegram()
    {
        Payload …
Run Code Online (Sandbox Code Playgroud)

delphi generics json rtti delphi-xe7

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

使用TScaledLayout和自定义样式绘制问题

我在组合TScaledLayout和从fmx中的位图样式设计器创建的自定义样式时遇到绘画问题.

为了演示,我加载了通过在位图样式设计器中选择"VCL/FMX的新样式" - >"另存为.style"创建的默认自定义样式.我在一些彩色矩形上放了几个标准控件:TScaledLayout上的红色和绿色,蓝色直接放在表单上.当我拉伸表格时,ScaledLayout上的控件上会出现彩色线条; 背景部分可见:

绘制拉伸控件的问题

如果我将表单的大小设置为与设计时尺寸完全匹配,则线条会消失.这似乎是一个非常重要的问题,我当然不能像这样一起使用这两个.有没有人对可能的修复或解决方法有所了解?

delphi firemonkey firemonkey-style delphi-xe7

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