Question

如果Double Click发生Form.Style:=bsSingle，如何汇总和滚动Delphi表单？

我已经定义了以下代码：

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  private
    { Private declarations }
    OldClientHeight: Integer;
    procedure WMNCLButtonDblClk(var msg: TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMNCLButtonDblClk(var msg: TWMNCLButtonDblClk);
var
  Height : integer;
begin
  if (Msg.HitTest = HTCAPTION) then
  Caption := 'Double Click';
   begin
     if (ClientHeight = 0) then
       begin
         for Height := 0 to OldClientHeight do ClientHeight := Height;
         Application.ProcessMessages;
       end
     else
       begin
         OldClientHeight := ClientHeight;
         for Height := OldClientHeight downto 0 do ClientHeight := Height;
         Application.ProcessMessages;
       end;
   end;
end;

end.

如果Form.Style:=bsSizeable代码完美无缺。

但我的Form.Style:=bsSingle和我已经实现了它。

所以我尝试了自己的技巧并以其他方式编码如下：

procedure TForm1.WMNCLButtonDblClk(var msg: TWMNCLButtonDblClk);
var
  Height : integer;
begin
  if (Msg.HitTest = HTCAPTION) then
  Caption := 'Double Click';
  Form1.BorderStyle := bsSizeable;
   begin
     if (ClientHeight = 0) then
       begin
         for Height := 0 to OldClientHeight do ClientHeight := Height;
         Application.ProcessMessages;
       end
     else
       begin
         OldClientHeight := ClientHeight;
         for Height := OldClientHeight downto 0 do ClientHeight := Height;
         Application.ProcessMessages;
       end;
   end;
  Form1.BorderStyle := bsSingle;
end;

但我面临以下问题：

在Rolling Down DoubleBuffered:=true时，Form.Background变为Blue（我的Windows XP主题默认为蓝色），然后更改为{{ 1}}（我的clBtnFace）。那里有一些闪烁。
在Form.Background:=clBtnFace 时，它没有完全卷起，如果我使用我的技巧，可以看到一些表格背景。

请任何人给我解决方案，以便使用'bsSingle'表单样式完全滚动表格。

Answer 1

您可以在设置表单高度的每次迭代中调用Repaint以消除背景问题。

 ..
 for Height := OldClientHeight downto 0 do 
 begin
   ClientHeight := Height;
   Repaint;
 end;
 ..

您无需切换动画的bordertyle即可工作。您的代码失败的原因是默认情况下固定边框窗口的ClientHeight永远不会为0。

无论如何，调用Application.ProcessMessages，您依赖于运行程序的机器的处理能力来获得动画速度。使用TTimer可以避免这种情况。一个例子可能是这样的：

  TForm1 = class(TForm)
    ..
  private
    FOldClientHeight: Integer;
    FContracted: Boolean;
  protected
    procedure WMNCLButtonDblClk(var Msg: TWMNCLButtonDblClk);
      message WM_NCLBUTTONDBLCLK;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  FOldClientHeight := ClientHeight;
  Timer1.Enabled := False;
  Timer1.Interval := 10;
end;

procedure TForm1.WMNCLButtonDblClk(var Msg: TWMNCLButtonDblClk);
begin
  if Msg.HitTest = HTCAPTION then
    Timer1.Enabled := True
  else
    inherited;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  MinClientHeight: Integer;
begin
  MinClientHeight := GetSystemMetrics(SM_CYMIN) -
      GetSystemMetrics(SM_CYCAPTION) - 2 * GetSystemMetrics(SM_CYFIXEDFRAME);

  if FContracted then begin
    if ClientHeight < FOldClientHeight then
      ClientHeight := ClientHeight + 5
    else begin
      FContracted := False;
      Timer1.Enabled := False;
    end;
  end else begin
    if ClientHeight > MinClientHeight then
      ClientHeight := ClientHeight - 5
    else begin
      FContracted := True;
      Timer1.Enabled := False;
    end;
  end;
end;

关于＆＃34;完全卷起＆＃34;，系统似乎采用了窗口的最小高度＆＃34;认真。 SetWindowPos，SetWindowPlacement等功能或响应f.i. WM_GETMINMAXINFO对此没有帮助。在窗口上设置区域（可能是替代方案）会破坏DWM的视觉样式，这会使其无法使用。但是，回复WM_WINDOWPOSCHANGING似乎有所帮助。请注意，不保证它可以在特定版本的操作系统上运行。我只用XP和W7测试过，如果你想用它，请看下面的内容：

type TForm1 = class(TForm) .. private FOldClientHeight: Integer; FContracted, FForceCompletelyContracted: Boolean; protected procedure WMNCLButtonDblClk(var Msg: TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK; procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; ... procedure TForm1.FormCreate(Sender: TObject); begin BorderStyle := bsSingle; DoubleBuffered := True; FOldClientHeight := ClientHeight; Timer1.Enabled := False; Timer1.Interval := 10; end; procedure TForm1.WMNCLButtonDblClk(var Msg: TWMNCLButtonDblClk); begin if Msg.HitTest = HTCAPTION then Timer1.Enabled := True else inherited; end; procedure TForm1.WMWindowPosChanging(var Message: TWMWindowPosChanging); begin inherited; if FContracted and ((Message.WindowPos.flags and SWP_NOSIZE) = 0) and FForceCompletelyContracted then Message.WindowPos.cy := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFIXEDFRAME); end; procedure TForm1.Timer1Timer(Sender: TObject); var MinClientHeight: Integer; begin if FContracted then begin if FForceCompletelyContracted then begin FForceCompletelyContracted := False; SetWindowPos(Handle, 0, 0, 0, Width, 0, SWP_NOMOVE or SWP_NOZORDER); Exit; end; if ClientHeight < FOldClientHeight then ClientHeight := ClientHeight + 5 else begin FContracted := False; Timer1.Enabled := False; end; end else begin MinClientHeight := GetSystemMetrics(SM_CYMIN) - GetSystemMetrics(SM_CYCAPTION) - 2 * GetSystemMetrics(SM_CYFIXEDFRAME); if ClientHeight > MinClientHeight then ClientHeight := ClientHeight - 5 else begin FContracted := True; Timer1.Enabled := False; FForceCompletelyContracted := True; SetWindowPos(Handle, 0, 0, 0, Width, 0, SWP_NOMOVE or SWP_NOZORDER); end; end; end;

如何使用“bsSingle”风格卷起和滚动Delphi表单？

1 个答案: