Delphi XE8/从TToolbutton单击调用windows api函数GetClipboardFormatName时对内存位置的访问无效

我在Delphi XE8中有一个strage effekt,我想知道是否有人可以复制它并对其进行解释!

我使用一个局部变量作为缓冲区调用windows api函数GetClipboardFormatName来接收剪贴板格式名称。

当从TButton Click处理程序执行此操作时,它会按预期工作;当从TToolButton Click处理程序执行此操作时,它不会工作,getlasterror返回998/ERROR\u NOACCESS/Invalid access to memory location。

这在Delphi 7下不会发生!

我不是在寻找解决方法,我只是想知道这里发生了什么。我做错什么了吗?IDE安装有问题吗(2个开发人员)?这是XE8中的错误吗?

这是一个演示单元:

DFM文件

object Form3: TForm3
  Left = 0
  Top = 0
  Caption = 'Form3'
  ClientHeight = 311
  ClientWidth = 643
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 643
    Height = 41
    Align = alTop
    Caption = 'Panel1'
    TabOrder = 0
    object Button1: TButton
      Left = 16
      Top = 10
      Width = 148
      Height = 25
      Caption = 'Standard TButton ==> OK'
      TabOrder = 0
      OnClick = Button1Click
    end
  end
  object Memo1: TMemo
    Left = 0
    Top = 70
    Width = 643
    Height = 241
    Align = alClient
    Lines.Strings = (
      'Memo1')
    TabOrder = 1
  end
  object ToolBar1: TToolBar
    Left = 0
    Top = 41
    Width = 643
    Height = 29
    ButtonHeight = 21
    ButtonWidth = 289
    Caption = 'ToolBar1'
    ShowCaptions = True
    TabOrder = 2
    object ToolButton1: TToolButton
      Left = 0
      Top = 0
      Caption = 'Standard TToolBar / TToolButton ==> ERROR_NOACCESS'
      ImageIndex = 0
      OnClick = ToolButton1Click
    end
  end
end

PAS文件

unit Unit3;

interface

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

type
    TForm3 = class(TForm)
        Panel1: TPanel;
        Memo1: TMemo;
        Button1: TButton;
        ToolBar1: TToolBar;
        ToolButton1: TToolButton;
        procedure Button1Click(Sender: TObject);
        procedure ToolButton1Click(Sender: TObject);
    private
        procedure say(s: string);
        procedure ListFormats;
        function GetRegisteredClipBoardFormatName(Format: word): string;
        function IsPredefinedFormat(format: word): boolean;
    { Private-Deklarationen }
    public
    { Public-Deklarationen }
    end;

var
    Form3: TForm3;

implementation

uses
    clipbrd;

const arPredefinedFormats: array[0..27] of word = (
        CF_TEXT,
        CF_BITMAP,
        CF_METAFILEPICT,
        CF_SYLK,
        CF_DIF,
        CF_TIFF,
        CF_OEMTEXT,
        CF_DIB,
        CF_PALETTE,
        CF_PENDATA,
        CF_RIFF,
        CF_WAVE,
        CF_UNICODETEXT,
        CF_ENHMETAFILE,
        CF_HDROP,
        CF_LOCALE,
        CF_MAX,
        CF_DIBV5,
        CF_MAX_XP,
        CF_OWNERDISPLAY,
        CF_DSPTEXT,
        CF_DSPBITMAP,
        CF_DSPMETAFILEPICT,
        CF_DSPENHMETAFILE,
        CF_PRIVATEFIRST,
        CF_PRIVATELAST,
        CF_GDIOBJFIRST,
        CF_GDIOBJLAST);

{$R *.dfm}

procedure TForm3.ToolButton1Click(Sender: TObject);
begin
    ListFormats;

end;


procedure TForm3.Button1Click(Sender: TObject);
begin
    ListFormats;
end;


procedure TForm3.ListFormats;
var
    index: integer;
begin
    for index := 0 to clipboard.formatcount - 1 do
    begin
        if not IsPredefinedFormat(clipboard.formats[index]) then
        begin
            say('Format: ' + inttostr(clipboard.formats[index]));
            say('Name: ' + GetRegisteredClipBoardFormatName(clipboard.formats[index]));
        end;
    end;
end;

procedure TForm3.say(s: string);
begin
    memo1.lines.add(s);
end;


function TForm3.IsPredefinedFormat(format: word): boolean;
var
    index: integer;
begin
    for index := low(arPredefinedFormats) to high(arPredefinedFormats) do
    begin
        if arPredefinedFormats[index] = format then
        begin
            result := true;
            exit;
        end;
    end;
    result := false;
end;

//------------------------------------------------------------------------------------------
(*
  Strange effekt in function GetClipboardFormatName
  when compiled with Delphi XE8 und Win 7.



  If this function is called from tbutton click, then everything ist ok!

  If this function is called from ttoolbutton click (and perhaps other controls...?)
  then the call to GetClipboardFormatName fails with getlasterror = 998
  which means

    ERROR_NOACCESS
    998 (0x3E6)
    Invalid access to memory location.

  which indicates that there is a problem with the local variable fmtname.



  Some Facts...

  * effekt happens under delphi xe8
  * effekt did not happen under delphi 7
  * it doesn't matter if I zero the memory of fmtname before using it.
  * it doesn't matter if I call OpenClipboard / CloseClipboard
  * if I use a local variable, then it does not work with ttoolbutton. The memorylocation of the local variable is
    slightly different from the case when it's called from tbutton.
  * if I use a global variable instead of a local variable, then it works with tbutton and ttoolbutton
    since it's the same memorylocation for both calls


  I'm NOT LOOKING FOR A WORKAROUND, I just would like to know if anybody can
  reproduce the behaviour and has an explanation as to why this is happening.

  Is there something wrong with using local variables for windows api calls in general?

*)
//------------------------------------------------------------------------------------------


function TForm3.GetRegisteredClipBoardFormatName(Format: word): string;
var
    fmtname: array[0..1024] of Char;
begin
    if OpenClipboard(self.handle) then    //<--- does not make a difference if called or not
    begin

        if GetClipboardFormatName(Format, fmtname, SizeOf(fmtname)) <> 0 then
        begin
            result := fmtname;
        end else
        begin
            result := 'Unknown Clipboard Format / GetLastError= ' + inttostr(getlasterror);
        end;

        CloseClipboard;
    end else say('OpenClipboard failed');
end;

//------------------------------------------------------------------------------------------




end.