在 windows 7 下无法工作的 2 件事（工作赢得 10）

Question

我有一个简单的表单对象，其中包含一个按钮，我用它来替换网格上的滚动条。这个想法是将其添加到网格中，并且用户可以使用一个漂亮的大触摸友好按钮来代替滚动条。一切都已完成并且在我的 win 10 开发系统上运行良好，但我发现有两件事在 win 7 下不起作用。不幸的是，此应用程序的目标系统是嵌入式 win7。

按钮不使用 OnMouseMove 处理程序接收触摸事件。我正在使用 "RegisterTouchWindow(sh.Handle, TWF_WANTPALM);" 来获取这些消息。
AlphaBlendValue 无效。我让表格在不使用时自行淡出，但我无法让它在目标系统上工作。我在软件的另一部分做了一些非常相似的事情，它在 win 7 下运行良好——唯一的区别是在这种情况下它是一个视觉创建的形式。

代码 - 省略了我认为不相关的内容。

TLFScrollThumb = class(TForm)
private
  sh: TButton;
  timer: TTimer;
  Fgrid: TAdvStringGrid;
  FInternalAlign: Boolean;
  tmpTopLeftChangeEvt: TnotifyEvent;
  DelayFadeOut: integer;
  procedure ThumbMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  procedure MoveControl(AControl: TControl; const X, Y: Integer);
  procedure TimerTimer(Sender: TObject);
  procedure Setgrid(const Value: TAdvStringGrid);
  procedure DoTopLeftChanged(Sender: TObject);
protected
  procedure DoShow; override;
public
  property grid: TAdvStringGrid read Fgrid write Setgrid;
  procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  procedure Init;
  constructor CreateThumb(g: TAdvStringGrid);
  destructor Destroy; override;
end;

constructor TLFScrollThumb.CreateThumb(g: TAdvStringGrid);
begin
  Fgrid := NIL;
  inherited CreateNew(g);
  Width := 50;
  Height := 30;
  BorderStyle := TFormBorderStyle.bsNone;
  FInternalAlign := False;
  Align := alCustom;
  DelayFadeOut := 1000;

  sh := TButton.Create(self);
  sh.Parent := self;
  sh.Align := alClient;
  sh.Visible := true;
  sh.OnMouseMove := ThumbMove;

  timer := TTimer.Create(self);
  timer.Enabled := true;
  timer.Interval := 50;
  timer.OnTimer := TimerTimer;

  grid := g;
end;

procedure TLFScrollThumb.Init; 
begin
  AlphaBlend := true;
  AlphaBlendValue := THUMB_ALPHA_DEFAULT;
  RegisterTouchWindow(sh.Handle, TWF_WANTPALM);
end;

procedure TLFScrollThumb.ThumbMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
begin
  if AlphaBlendValue <> 1 then
  begin
    if AlphaBlendValue <> THUMB_ALPHA_DEFAULT then
    begin
      DelayFadeOut := 1000;
      AlphaBlendValue := THUMB_ALPHA_DEFAULT;
    end;
    Timer.Enabled := true;
    if (ssLeft in Shift) or (ssTouch in Shift) then // only move it when Left-click is down
      MoveControl(self, X, Y);
  end;
end;

procedure TLFScrollThumb.TimerTimer(Sender: TObject);
begin
  if DelayFadeOut > 0 then
    DelayFadeOut := DelayFadeOut - Timer.Interval
  else
    AlphaBlendValue := AlphaBlendValue - 3;
  if AlphaBlendValue < THUMB_ALPHA_LOW_DEFAULT then
    Timer.Enabled := false;
end;

procedure TLFScrollThumb.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if assigned(FGrid) then
  begin
    if ((grid.VisibleRowCount / grid.RowCount) > 0.5) or (grid.RowCount < 5) then
      AlphaBlendValue := 1
    else
      AlphaBlendValue := THUMB_ALPHA_DEFAULT;
    ATop :=  grid.FixedRowHeight + Round((grid.Clientheight - grid.FixedRowHeight - Height) * ((grid.TopRow-1) / ((grid.RowCount-1) - grid.VisibleRowCount)));
    if ATop < grid.FixedRowHeight then
      ATop := grid.FixedRowHeight;
    inherited SetBounds(grid.Width - Width, ATop, AWidth, AHeight);
  end
  else
    inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

用法...

  tmp := TLFScrollThumb.CreateThumb(g);
  tmp.Parent := g;
  tmp.init; // Must happen after the parent is set
  tmp.Show;

Answer 1

Delphi 通过（除其他事项外）设置 WS_EX_LAYERED 扩展 window 样式使表单透明。

来自 MSDN :

Windows 8: The WS_EX_LAYERED style is supported for top-level windows and child windows. Previous Windows versions support WS_EX_LAYERED only for top-level windows.

所以您的表单很可能不是顶级 window。

在 windows 7 下无法工作的 2 件事（工作赢得 10）

2 things that wont work under windows 7 (works win 10)

delphi

vcl

touch