小编Gra*_*ter的帖子

Delphi接口参考计数

我今天在测试时遇到了一个奇怪的情况.

我有很多接口和对象.代码如下所示:

IInterfaceZ = interface(IInterface)
['{DA003999-ADA2-47ED-A1E0-2572A00B6D75}']
  procedure DoSomething;
end;

IInterfaceY = interface(IInterface)
  ['{55BF8A92-FCE4-447D-B58B-26CD9B344EA7}']
  procedure DoNothing;
end;

TObjectB = class(TInterfacedObject, IInterfaceZ)
  procedure DoSomething;
end;

TObjectC = class(TInterfacedObject, IInterfaceY)
public
  FTest: string;
  procedure DoNothing;
end;

TObjectA = class(TInterfacedObject, IInterfaceZ, IInterfaceY)
private
  FInterfaceB: IInterfaceZ;
  FObjectC: TObjectC;
  function GetBB: IInterfaceZ;
public
  procedure AfterConstruction; override;
  procedure BeforeDestruction; override;
  property BB: IInterfaceZ read GetBB implements IInterfaceZ;
  property CC: TObjectC read FObjectC implements IInterfaceY;
end;

procedure TObjectB.DoSomething;
begin
  Sleep(1000);
end;

procedure TObjectA.AfterConstruction;
begin
  inherited;
  FInterfaceB := TObjectB.Create; …
Run Code Online (Sandbox Code Playgroud)

delphi interface reference-counting delphi-xe4

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

TRect.Intersect和TRect.IntersectsWith Inconsistencies

我希望我在某种程度上感到困惑.我TRect.Intersect和and 有一些不一致的行为TRect.IntersectsWith.这是一些演示此问题的代码.

program RectCheck;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Types,
  Vcl.Dialogs;

var
  rect1: TRect;
  rect2: TRect;
  combinedRect: TRect;
begin
  Rect1 := Rect(0,0,200,101);
  Rect2 := Rect(0,100,200,200);
  if Rect1.IntersectsWith(Rect2) then
  begin
    // We have interesected, get the combined rect
    combinedRect := TRect.Intersect(Rect1, Rect2);
    if not combinedRect.IsEmpty then
      ShowMessage(Format('Our new rect (%d, %d), (%d, %d)',
          [combinedRect.Left, combinedRect.Top, combinedRect.Right, combinedRect.Bottom]))
    else
      raise Exception.Create('They were supposed to intersect!');
  end;

  Rect1 := Rect(0,0,200,100);
  Rect2 := Rect(0,100,200,200);
  if Rect1.IntersectsWith(Rect2) then
  begin
    // …
Run Code Online (Sandbox Code Playgroud)

delphi delphi-xe4

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

64位和32位之间的浮点差与Round

我知道关于浮点数的近似问题,所以我理解4.5如果它近似为4.4999999999999991,可以向下舍入到4.我的问题是为什么使用相同类型的32位和64位存在差异.

在下面的代码中,我有两个计算.在32位中,MyRoundValue1的值为4,MyRoundValue2的值为5.在64位中,它们都是4.不应该结果与32位和64位一致吗?

{$APPTYPE CONSOLE}
const
  MYVALUE1: Double = 4.5;
  MYVALUE2: Double = 5;
  MyCalc: Double = 0.9;
var
  MyRoundValue1: Integer;
  MyRoundValue2: Integer;
begin
  MyRoundValue1 := Round(MYVALUE1);
  MyRoundValue2 := Round(MYVALUE2 * MyCalc);
  WriteLn(IntToStr(MyRoundValue1));
  WriteLn(IntToStr(MyRoundValue2));
end.
Run Code Online (Sandbox Code Playgroud)

delphi delphi-xe7

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

将图形复制到屏幕尺寸之外的TMetaFileCanvas

将图像绘制到屏幕分辨率之外的坐标时,我们遇到TMetaFileCanvas输出问题.向量操作似乎没有问题,但图像操作只是"被忽略".如果我们将相同的图像绘制到屏幕边界内的坐标,则没有问题.

例如.此SSCCE将生成4个输出文件.位图变体没有问题,将按预期输出左上角inscreen.bmp的红色方块和右下角的红色方块outsidescreen.bmp.在inscreen.emf元文件作为工作在左上角绘制的红色正方形的预期.outsidescreen.emf不起作用,只画线.

program Project6;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Types,
  Windows,
  Vcl.Graphics;

const
  SIZECONST = 3000; // should be larger than your screen resolution
  OFFSET = 1500;

  function GetMyMetafile(const aHDC: HDC): TMetafile;
  var
    metcnv: TMetafileCanvas;
  begin
    Result := TMetafile.Create;
    Result.SetSize(500, 500);

    metcnv := TMetafileCanvas.Create(Result, aHDC);
    metcnv.Brush.Color := clRed;
    metcnv.FillRect(Rect(0, 0, 500, 500));
    metcnv.Free;
  end;

  procedure OutputToMetaFile(const aFilename: string; const aStartOffset,
      aEndOffset, aMaxSize: Integer; aGraphic: TGraphic; aHDC: HDC);
  var
    metafile: TMetafile;
    metcnv: …
Run Code Online (Sandbox Code Playgroud)

delphi metafile

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

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

问题定义

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

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
查看次数

Win32和Win64中的exAllArithmeticExceptions结果不一致

我的一位同事发现了Delphi编译的Win32和Win64代码在处理NaN方面的差异.以下面的代码为例.当以32位编译时,我们得不到消息,但是当用64位编译时,我们得到两个比较返回true.

program TestNaNs;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Math;

var
  nanDouble: Double;
  zereDouble: Double;
  nanSingle: Single;
  zeroSingle: Single;
begin
  SetExceptionMask(exAllArithmeticExceptions);
  nanSingle := NaN;
  zeroSingle := 0.0;
  if nanSingle <> zeroSingle then
    WriteLn('nanSingle <> zeroSingle');

  nanDouble := NaN;
  zereDouble := 0.0;
  if nanDouble <> zereDouble then
    WriteLn('nanDouble <> zeroDouble');

  ReadLn;
end.
Run Code Online (Sandbox Code Playgroud)

我对IEEE标准的理解是<>应该返回true,但所有其他操作都应该返回false.所以在这种情况下,看起来64位版本是正确的,32位版本是不正确的.两者生成的代码与生成SSE代码的64位版本非常不同.

对于32位:

TestNaNs.dpr.21: if nanSingle <> zeroSingle then
0041A552 D905E01E4200     fld dword ptr [$00421ee0]
0041A558 D81DE41E4200     fcomp dword ptr [$00421ee4]
0041A55E 9B               wait 
0041A55F DFE0             fstsw ax
0041A561 9E …
Run Code Online (Sandbox Code Playgroud)

delphi delphi-10-seattle

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

是否为集合记录了乘法运算符?

我今天注意到了这段代码,并想知道这些类型的操作是否记录在某处以及为什么这样做(性能等).

var
  Shift: TShiftState
begin
  if [ssShift, ssCtrl] * Shift <> [] then
  begin
    ...
  end;
end;
Run Code Online (Sandbox Code Playgroud)

从我的测试看起来它只是看着像这样的代码检查Shift是否包含ssShiftssCtrl.这是记录在案的行为,还是只是利用集合内部实际存储为整数的事实?

delphi set

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

设置标题(content-type:image/<ANY IMG FORMAT>)

处理我显示的图像的php文件只允许一种图像格式,.jpg,.png,.bmp等,但不是全部.imageName存储数据库中存储的图像的文件名,包括其格式.这是我的代码,到目前为止它还没有工作,我不确定是否允许这样做.你能帮我解决一下吗?

$con = mysqli_connect("localhost","root","","tickets");
$ticket = 109;
$result = mysqli_query($con,"SELECT image, imageName FROM tix WHERE tktNum=$ticket");


while($row = mysqli_fetch_array($result))
{
    $image = $row['image'];
    $imageName = $row['imageName'];
    $format = substr( $imageName, -3 ); //gets the last 3 chars of the file name, ex: "photo1.png" gets the ".png" part
    header('content-type: image/' . $format);
}
Run Code Online (Sandbox Code Playgroud)

php substr http-headers

5
推荐指数
2
解决办法
4万
查看次数

为什么我不能将TArray <string>用作类常量?

当我尝试在类中使用数组常量时,我​​得到以下错误:

[dcc32 Error] TestConstants.dpr(14): E2086 Type 'TArray<T>' is not yet completely defined

当我将它用作全局常量或使用array of string而不是TArray 时,相同的代码编译得很好.有这个工作的诀窍吗?

program Project98;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
  TMyTestClass = class
  strict private
    const
      TEST_CLASS_CONSTANT: TArray<String> = ['1','2']; // <-- Error here
      TEST_CLASS_CONSTANT2: array of string = ['1','2']; // <-- No error
  end;

const
  TEST_GLOABL_CONSTANT: TArray<String> = ['3','4']; // <-- No error
  TEST_GLOBAL_CONSTANT2: array of string = ['3','4']; // <-- No error
begin
end.
Run Code Online (Sandbox Code Playgroud)

delphi delphi-10-seattle

5
推荐指数
0
解决办法
162
查看次数

除了“编译”选项以外,还有什么可以更改64位的代码生成?

介绍

我在我们的一个应用程序中遇到了货币问题。我在Win32和Win64中得到了不同的结果。我在这里找到了显示类似问题的文章,但该文章已在XE6中修复。我尝试做的第一件事是创建一个MCVE来复制该问题。那是车轮掉下来的地方。与应用程序相比,看起来像MCVE中的相同代码会产生不同的结果。生成的代码64位不同。因此,我的问题变成了为什么它们不同,一旦我弄清楚了,便可以创建合适的MCVE。

我有一种计算总数的方法。此方法调用另一个方法来获取需要添加到总计中的值。该方法返回单个。我将单个值分配给变量,然后将其添加到总计(货币)中。在我的主应用程序中,稍后将使用合计值,但将其添加到MCVE不会改变行为。我确保编译器选项相同。

在我的主应用程序中,计算的结果在Win32中为$ 2469.6001,在Win64中为2469.6,但是我无法在MCVE中重复。“编译选项”页面上的所有内容都相同,并且优化被禁用。

尝试MCVE

这是我尝试的MCVE的代码。这模仿了原始应用程序中的动作。

program Project4;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
  TTestClass = class
  strict private
    FMyCurrency: Currency;
    function GetTheValue: Single;
  public
    procedure Calculate;
    property MyCurrency: Currency read FMyCurrency write FMyCurrency;
  end;

procedure TTestClass.Calculate;
var
  myValue: Single;
begin
  FMyCurrency := 0.0;
  myValue := GetTheValue;
  FMyCurrency := FMyCurrency + myValue;
end;

function TTestClass.GetTheValue: Single;
var
  myValueExact: Int32;
begin
  myValueExact := 1159354778; // 2469.60009765625;
  Result := PSingle(@myValueExact)^;
end;

var
  testClass: TTestClass;
begin
  testClass := TTestClass.Create;
  try
    testClass.Calculate; …
Run Code Online (Sandbox Code Playgroud)

delphi delphi-10-seattle

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