unitform1.pas

《Delphi百例》源码?禗elphi百例》源码

unit unitForm1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FClientInstance,
      FPrevClientProc: TFarProc;
    procedure ClientWndProc(var Message: TMessage);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.ClientWndProc(var Message: TMessage);

var
  MyDC: hDC;
  Ro, Co: Word;
begin
  with Message do
    case Msg of
      WM_ERASEBKGND:
        begin
          MyDC := TWMEraseBkGnd(Message).DC;
          for Ro := 0 to ClientHeight div Image1.Picture.Height do
            for Co := 0 to ClientWIDTH div Image1.Picture.Width do
              BitBlt(MyDC, Co * Image1.Picture.Width, Ro * Image1.Picture.Height,
                Image1.Picture.Width, Image1.Picture.Height,
                Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
          Result := 1;
        end;
      else
        Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
    end;


end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FClientInstance := MakeObjectInstance(ClientWndProc);
  FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;

end.