全画面表示フォームでユーザー入力をブロックするのは得策ではないというコメント投稿者の意見には完全に賛成ですが、ここにいくつかのコードを示します。このコードは、1920 x 1200 の画面サイズを想定しています。
unit Unit152;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm152 = class( TForm )
Timer1: TTimer;
procedure Timer1Timer( Sender: TObject );
procedure FormCreate( Sender: TObject );
private
{ Private declarations }
DesktopBMP: TBitmap;
procedure WMEraseBkgnd( var Message: TWMEraseBkgnd ); message WM_ERASEBKGND;
protected
procedure Paint; override;
public
{ Public declarations }
end;
var
Form152: TForm152;
implementation
{$R *.dfm}
{ TForm152 }
procedure TForm152.FormCreate( Sender: TObject );
begin
DesktopBMP := TBitmap.Create;
DesktopBMP.SetSize( 1920, 1200 );
end;
procedure TForm152.Paint;
begin
inherited;
Canvas.Draw( 0, 0, DesktopBMP );
end;
procedure TForm152.Timer1Timer( Sender: TObject );
begin
// alternatively a simple Invalidate would do here, but then
// all other windows would not redraw
Width := 0;
Height := 0;
Width := 1920;
Height := 1200;
end;
procedure TForm152.WMEraseBkgnd( var Message: TWMEraseBkgnd );
var
DesktopDC: HDC;
DesktopHwnd: Hwnd;
DesktopCanvas: TCanvas;
begin
DesktopHwnd := GetDesktopWindow;
DesktopDC := GetDC( DesktopHwnd );
try
DesktopCanvas := TCanvas.Create;
DesktopCanvas.Handle := DesktopDC;
DesktopBMP.Canvas.CopyRect( Rect( 0, 0, 1919, 1199 ), DesktopCanvas, Rect( 0, 0, 1919, 1199 ) );
finally
DesktopCanvas.Free;
ReleaseDc( DesktopHwnd, DesktopDC );
end;
Message.Result := 1;
inherited;
end;
end.
DFM は次のようになります。
object Form152: TForm152
Left = 2296
Top = 103
BorderStyle = bsNone
Caption = 'Form152'
ClientHeight = 699
ClientWidth = 1289
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
WindowState = wsMaximized
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Timer1: TTimer
Interval = 10
OnTimer = Timer1Timer
Left = 640
Top = 360
end
end