procedure Tmain_frm.ClientWndproc(var message:tmessage);
begin
case message.msg of
wm_erasebkgnd:
begin
callwindowproc(foldclientproc,clienthandle,message.msg,message.wparam,message.lparam);
fdrawdc:=twmerasebkgnd(message).dc;
drawtitle;
end;
wm_vscroll,wm_hscroll:
begin
message.result:=callwindowproc(foldclientproc,clienthandle,message.msg,message.wparam,message.lparam);
invalidaterect(clienthandle,nil,true);
end;
else
message.result:=callwindowproc(foldclientproc,clienthandle,message.msg,message.wparam,message.lparam);
end;
end;
procedure Tmain_frm.createwnd;
begin
inherited CreateWnd;
FNewClientProc:=MakeObjectInstance(ClientWndProc);
FOldClientProc:=Pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_wndproc,longint(Fnewclientproc));
end;
procedure Tmain_frm.drawtitle;
var
row,col:integer;
CR,IR:TRect;
NumRows,NumCols:integer;
rect1,rect2:TRect;
bitmap:TBitMap;
bitmap2:tbitmap;
begin
GetWindowRect(ClientHandle,CR);
bitmap:=TBitMap.create;
bitmap2:=Tbitmap.create;
try
bitmap.LoadFromFile(SysPath+'image/SAFDA.bmp');
bitmap2.LoadFromFile(SysPath+'image/bkADFE.bmp');
StretchBlt(FDrawDC,0,0,
ClientWidth,ClientHeight,bitmap2.canvas.Handle,0,0,bitmap2.width,bitmap2.height,SRCCOPY);
IR:=bitmap.Canvas.ClipRect;
numrows:=CR.Bottom div IR.Bottom;
NumCols:=CR.Right div IR.Right;
for row:=0 to Numrows+1do
for col:=0 to Numcols+1do
begin
if (((row mod 2)=1) and ((col mod 2)=0)) or
(((row mod 2)=0) and ((col mod 2)=1))
then
continue;
bitblt(FDrawDC,col*bitmap.width*3,row*bitmap.height*4,
bitmap.width,bitmap.height,bitmap.canvas.Handle,0,0,srccopy)
end;
finally
bitmap.Free;
bitmap2.free;
end;
end;