Delphi - Содержимое TImage может быть потеряно на интерфейсе после запуска в 64 бит - PullRequest
Новая
       90

Delphi - Содержимое TImage может быть потеряно на интерфейсе после запуска в 64 бит

0 голосов
/ 16 июня 2019

Я создаю проект в Embarcadero RAD Studio XE7, в котором я создал собственный компонент TGraphic, доступный в пакете.Я также создал демонстрационный проект, в котором я использую этот пользовательский TGraphic для заполнения компонента TImage.

Все работает хорошо, пока я компилирую и запускаю свой проект в 32-битной среде.Однако я заметил странное поведение, когда я компилирую и запускаю его в 64-битной версии.При этом содержимое TImage больше не отображается, пока я не обновлю его.Единственное различие между обеими версиями состоит в том, что одна компилируется в 32-битной, а другая компилируется в 64-битной.

Я воссоздал аналогичное поведение в отдельном проекте, для которого я приведу источник ниже.

Main.pas 

unit Main;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.GDIPAPI, Winapi.GDIPObj, Vcl.ExtCtrls, Vcl.StdCtrls;

type
    TMainForm = class(TForm)
        im1: TImage;
        bt1: TButton;

        procedure bt1Click(Sender: TObject);

    private
        pBitmap:TBitmap;

    public
        constructor Create(pOwner: TComponent); override;
        destructor Destroy; override;
        procedure DrawGradient; virtual;
    end;

var
    MainForm: TMainForm;

implementation

{$R *.dfm}

constructor TMainForm.Create(pOwner: TComponent);
begin
    inherited Create(pOwner);

    pBitmap:=TBitmap.Create;
    pBitmap.PixelFormat := pf24bit;
    pBitmap.SetSize(600, 600);
    DrawGradient;
    im1.Picture.Bitmap.Assign(pBitmap);
end;

destructor TMainForm.Destroy;
begin
    FreeAndNil(pBitmap);
    inherited Destroy;
end;

procedure TMainForm.bt1Click(Sender: TObject);
begin
    DrawGradient;
    im1.Picture.Bitmap.Assign(pBitmap);
    im1.Invalidate;
end;

procedure TMainForm.DrawGradient;
var
    startPoint: TGpPointF;
    endPoint: TGpPointF;
    startColor: TGpColor;
    endColor: TGpColor;
    rect: TGPRectF;
    pBrush: TGpLinearGradientBrush;
    pGraphics: TGpGraphics;
    pGraphicPath: TGpGraphicsPath;
    colors: array of TGpColor;
    offsets: array of Single;
    pMatrix: TGpMatrix;
begin
    pGraphics := TGpGraphics.Create(pBitmap.Canvas.Handle);

    startPoint.X := 360.499053955078;
    startPoint.Y := 598.405334472656;
    endPoint.X   := 354.387237548828;
    endPoint.Y   := 456.281829833984;

    startColor := 4289977853;
    endColor   := 4281558680;

    pBrush := TGpLinearGradientBrush.Create(startPoint, endPoint, startColor, endColor);
    pBrush.SetWrapMode(WrapModeClamp);

    SetLength(colors,  4);
    SetLength(offsets, 4);

    colors[0] := startColor;
    offsets[0] := 0.0;
    colors[1] := startColor;
    offsets[1] := 0.207910388708115;
    colors[2] := endColor;
    offsets[2] := 0.981223344802856;
    colors[3] := endColor;
    offsets[3] := 1.0;

    pBrush.SetInterpolationColors(PGpColor(colors), PSingle(offsets), 4);

    rect.X      := 292.332000732422;
    rect.Y      := 458.950439453125;
    rect.Width  := 93.1629943847656;
    rect.Height := 138.380004882813;

    pGraphicPath := TGpGraphicsPath.Create;
    pGraphicPath.AddRectangle(rect);

    pMatrix := TGpMatrix.Create;
    pMatrix.SetElements( 0.0,                   0.0,
                         0.0,                   0.835756719112396,
                        -3.23515876073745e-35, -363.817687988281);
    pGraphics.SetTransform(pMatrix);

    pGraphics.FillPath(pBrush, pGraphicPath);

    FreeAndNil(pMatrix);
    FreeAndNil(pGraphicPath);
    FreeAndNil(pBrush);
    FreeAndNil(pGraphics);
end;

end.

Main.dfm 

object MainForm: TMainForm
    Left = 0
    Top = 0
    Caption = 'MainForm'
    ClientHeight = 430
    ClientWidth = 400
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    OldCreateOrder = False
    PixelsPerInch = 96
    TextHeight = 13
    object im1: TImage
        Left = 0
        Top = 0
        Width = 400
        Height = 400
        Center = True
        Proportional = True
        Stretch = True
    end
    object bt1: TButton
        Left = 0
        Top = 405
        Width = 400
        Height = 25
        Align = alBottom
        Caption = 'bt1'
        TabOrder = 0
        OnClick = bt1Click
        ExplicitLeft = 22
        ExplicitTop = 183
        ExplicitWidth = 75
    end
end

Проект был создан с параметрами компилятора по умолчанию.Когда я компилирую вышеупомянутый проект в 64-битной версии, в TImage ничего не отображается, пока я не нажму на кнопку, в то время как содержимое TImage отображается без проблем, пока я компилирую и запускаю его в 32-битной версии.Еще раз, единственное различие между обеими версиями заключается только в том, что первая компилируется в 32-битной, а другая в 64-битной.Ничто другое не модифицируется ни в настройках проекта, ни в коде.Я работаю с XE7, но я также заметил такое же поведение во всех версиях компилятора между XE8 и 10.3 Rio.

Я делаю что-то не так, или кто-то другой замечает такое же поведение?Если я не прав, в чем моя ошибка?Или это ошибка компилятора?

NOTE Я знаю, что приведенный выше код уродлив, неэффективен и, вероятно, полон ошибок проектирования.Цель здесь состояла в том, чтобы воспроизвести ошибку, с которой я столкнулся в другом проекте, для которого я не могу опубликовать исходный код.Пожалуйста, не обращайте внимания на качество кода, здесь дело не в этом.

...