program Lupe;

uses
 windows,messages,
 kol;
const
 Diametre = 300;
{$R *.res}
var
form,Loupe:PControl;
Menu : pMenu;

hRegion,hRegP: HRgn;
Width:integer;            
//переменные для ScreenRelease
DeskDC : HDC;
HDeskBmp : HBitmap;
//картинка
Img: PBitmap;
i:integer;z:real;

//область для процедур
procedure MouseDown(Sender: PControl;var mouse:TMouseEventData);
begin
releasecapture();
form.Perform(wm_syscommand,$F012,0);

end;

procedure ScreenRelease;
begin
 if HDeskBmp<> 0 then
 begin
   DeleteObject(HDeskBmp);
   HDeskBmp:= 0;
 end;
 if DeskDC<> 0 then
 begin
   ReleaseDC(GetDesktopWindow, DeskDC);
   DeskDC:= 0;
 end;
end;
procedure ScreenCapture;
var
 MemDC: HDC;
 W, H: Integer;
begin
 if (HDeskBmp<> 0)or (DeskDC<> 0) then
   Exit;
 W:= GetSystemMetrics(SM_CXSCREEN);
 H:= GetSystemMetrics(SM_CYSCREEN);
 DeskDC:= GetDC(GetDesktopWindow);

 MemDC:= CreateCompatibleDC(DeskDC);
 { создаём handle для bitmap'а  совместимый с устройством}
 HDeskBmp:= CreateCompatibleBitmap(DeskDC, W, H);
 { выбираем битмар}
 SelectObject(MemDC, HDeskBmp);
 { копируем фон }
 BitBlt(MemDC, 0, 0, W, H, DeskDC, 0, 0, SRCCOPY);
 {освобождаем контекст устройства }
 DeleteDC(MemDC);
end;
procedure DrawFilter;
var
 MemDC: HDC;
 OldBmp: HBitMap;
 OffsetX, OffsetY: Integer;
begin
 if Loupe= nil then Exit;
 // Копируем фоновое изображение
 MemDC:= CreateCompatibleDC(DeskDC);
 OldBmp:= SelectObject(MemDC, HDeskBmp);
 OffsetX:=Width div 4;
 OffsetY:=Width div 4;
 StretchBlt(Img.Canvas.Handle, 0, 0, Width, Width, MemDC, form.Left + OffsetX, form.Top + OffsetY, trunc(Width div 2/z), trunc(Width div 2/z), SRCCOPY);
 Loupe.Invalidate;//Заставляем перерисовываться чтобы избавится от мелькания
 //но тогда теряется оконтовка лупы
 SelectObject(MemDC, OldBmp);
 DeleteObject(MemDC);
end;
procedure TimerTick(Dummy: Pointer; Sender: PObj);
begin
 ScreenCapture;
 DrawFilter;
end;
procedure MMouseWheel(Dummy:pointer;Sender: PControl;
var Mouse: TMouseEventData);
begin
if Integer( Mouse.Shift ) > 0 then
  i:=i+10
else
  i:=i-10;
Mouse.StopHandling := TRUE;
    case i of
    -10:i:=0;
     0:begin z:=1;
  ScreenCapture;
  DrawFilter;
  form.Show;
  end;
    10:;
    20:begin z:=1.5;
  ScreenCapture;
  DrawFilter;
  form.Show;
    end;
    30:;
    40:begin z:=3;
      ScreenCapture;
      DrawFilter;
      form.Show;
       end;
    50:;
    60: i:=50;
   end;{case}

end;
procedure FormPaint(Dummy: Pointer; Sender: PControl; DC: HDC);
begin
Img.Draw(Sender.Canvas.Handle,0,0);
end;
function AppletMessage(Dummy : Pointer;var Msg: tagMSG; var Rslt: Integer): Boolean;
begin
Result := False;

 if (Msg.message = WM_KEYDOWN) and ( Msg.wParam = VK_ESCAPE) then form.close;
 if (Msg.message = WM_KEYDOWN) and (Msg.wParam = VK_F5) then
begin
  Result := True;
  form.Hide;
  Sleep(100);
  DeskDC := 0;
  HDeskBmp := 0;
  ScreenCapture;
  DrawFilter;
  form.Show;
end;
end;
procedure OnClickPopupMenu(Dummy : pointer; Sender : pMenu; Item : Integer);
begin
  case Item of
    0: Applet.Close();
  end;{case}
end;
procedure FormDestroy(Sender: TObject);
begin
 ScreenRelease;
 Loupe.Free;
end;

Begin
Applet := NewApplet('');
Applet.Color := clYellow;
Width := Diametre;
hRegion:= CreateEllipticRgn(0, 0, Width+3, Width+3);

form:=NewForm(Applet,'Лупа').setsize(324,324).centeronparent.Tabulate;

Menu := NewMenu(Applet, 0, ['Выход'], TOnMenuItem(MakeMethod( nil, @OnClickPopupMenu)));

if hRegion<> 0 then SetWindowRgn(form.GetWindowHandle , hRegion, TRUE);

Img := NewBitmap(form.ClientWidth,form.ClientHeight);

hRegP:=CreateEllipticRgn(4, 4, Width-4, Width-4);

  // создаём PaintBox "off line"
Loupe := NewPaintBox(form);
Loupe.Align := caClient;

  if hRegP<> 0 then SetWindowRgn(Loupe.GetWindowHandle , hRegP, TRUE);
 
HDeskBmp:= 0;
DeskDc:= 0;
ScreenCapture;
DrawFilter;

with NewTimer(100)^ do
begin
  OnTimer  := TOnEvent(MakeMethod(nil, @TimerTick));
  Enabled := True;
end;

Loupe.SetAutoPopupMenu( Menu );

//область для работы
Loupe.OnMouseDown:=TOnMouse(MakeMethod(nil,@MouseDown));
Loupe.OnPaint:=TOnPaint( MakeMethod( nil, @FormPaint ));
form.Style := WS_POPUP or WS_VISIBLE;
form.StayOnTop := True;
//ScreenCursor:=

form.CursorLoad(0, IDC_CROSS);

Applet.OnMessage:=TOnMessage(MakeMethod(nil,@AppletMessage));
SetProcessWorkingSetSize(GetCurrentProcess, Cardinal(-1), Cardinal(-1));
form.OnMouseWheel:=TOnMouse(MakeMethod(nil,@MMouseWheel));

i:=0;z:=1;
Run(Applet);
end.