Question

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

按钮不会使用OnMouseMove处理程序接收触摸事件。我正在使用＆＃34; RegisterTouchWindow（sh.Handle，TWF_WANTPALM）;＆＃34;获取这些消息。
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扩展窗口样式。

来自MSDN：

Windows 8：顶级窗口支持WS_EX_LAYERED样式和儿童窗户。以前的Windows版本支持WS_EX_LAYERED 仅适用于顶级窗口。

因此，您的表单很可能不是顶级窗口。

在Windows 7下无法工作的2件事（作品获胜10）

1 个答案: