Floating Magnifier

General Macro Scheduler discussion

Moderators: Dorian (MJT support), JRL

Post Reply
User avatar
JRL
Automation Wizard
Posts: 3501
Joined: Mon Jan 10, 2005 6:22 pm
Location: Iowa

Floating Magnifier

Post by JRL » Fri Apr 26, 2013 4:21 pm

A little fun on a Friday.

Press the window key + esc to close the script


Code: Select all

OnEvent>key_down,VK27,8,Quit

LibFunc>User32,GetSystemMetrics,VScrWidth,78
LibFunc>User32,GetSystemMetrics,VScrHeight,79
LibFunc>User32,GetSystemMetrics,VScrLeft,76
LibFunc>User32,GetSystemMetrics,VScrTop,77

Let>VScrRight=%VScrWidth%-%VScrLeft%
Let>VScrBottom=%VScrHeight%-%VScrTop%

ScreenCapture>VScrLeft,VScrTop,VScrRight,VScrBottom,%temp_dir%Screen.bmp

Dialog>Dialog10
object Dialog10: TForm
  AutoSize = True
  BorderIcons = [biSystemMenu]
  BorderStyle = bsNone
  object MSImage1: tMSImage
    AutoSize = True
  end
end
EndDialog>Dialog10
SetDialogProperty>Dialog10,msImage1,LoadImage,%temp_dir%Screen.bmp
Let>WIN_USEHANDLE=1
  MoveWindow>Dialog10.handle,VScrLeft,VScrTop
  ResizeWindow>Dialog10.handle,0,0
Let>WIN_USEHANDLE=0
Show>Dialog10

Dialog>Dialog1
object Dialog1: TForm
  BorderStyle = bsNone
  Color = 16110829
  Caption = 'FlyingMagOval'
  ClientHeight = 200
  ClientWidth = 200
  TransparentColor = True
  TransparentColorValue = 16110829
  Position = poScreenCenter
  OnTaskBar = False
end
EndDialog>Dialog1

show>Dialog1

Dialog>Dialog2
object Dialog2: TForm
  AlphaBlend = True
  AlphaBlendValue = 0
  BorderStyle = bsNone
  Caption = 'SittingMagOval'
  ClientHeight = 200
  ClientWidth = 200
  TransparentColor = True
  TransparentColorValue = clRed
end
EndDialog>Dialog2

Show>Dialog2

Let>XSpeed=3
Let>YSpeed=3
Random>2,moveright
Random>2,movedown

LibFunc>user32,GetDC,HDC1,Dialog1.handle
LibFunc>user32,GetDC,HDC2,Dialog2.handle
LibFunc>user32,GetDC,HDC3,Dialog10.handle


GoSub>Setup

Let>kk=0
add>timeout,1
Label>start
Wait>0.01
GoSub>Magnify
IfWindowOpen>FlyingMagOval
  GetWindowPos>FlyingMagOval,Xpos,Ypos
EndIf
If>{(%Xpos%<%VScrRight%-160)and(%moveright%=1)}
  Add>Xpos,%Xm%
Else>
  Let>moveright=0
  If>{(%Xpos%>0)and(%moveright%=0)}
    Sub>Xpos,%Xm%
  Else>
    Let>moveright=1
	Add>Xpos,%Xm%
  EndIf
EndIf
If>{(%Ypos%<%VScrBottom%-210)and(%movedown%=1)}
  Add>Ypos,%Ym%
Else>
  Let>movedown=0
  If>{(%Ypos%>0)and(%movedown%=0)}
    Sub>Ypos,%Ym%
  Else>
    Let>movedown=1
	Add>Ypos,%Ym%
  EndIf
EndIf
IFW>FlyingMagOval
MoveWindow>FlyingMagOval,%Xpos%,%Ypos%
Wait>0.001
EndIf
If>{(%kk%>%timeout%)}
GoSub>Setup
Let>kk=0
Else
  add>kk,1
EndIf
IfW>FlyingMagOval,start,end
Label>end

SRT>Magnify
  GetWindowPos>FlyingMagOval,CurX,CurY
  Add>CurX,55
  Add>CurY,55
  LibFunc>Gdi32,StretchBlt,SBres,HDC2,0,0,320,200,HDC3,CURX,CURY,160,100,13369376

  GoSub>DrawArc,Dialog2.Handle,80,16110829,-20,-20,220,220,-20,-20,-20,-20
  GoSub>DrawArc,Dialog2.Handle,1,0,20,20,180,180,20,20,20,20

  LibFunc>Gdi32,StretchBlt,SBres,HDC1,0,0,200,200,HDC2,0,0,200,200,13369376
END>Magnify

SRT>Setup
  Random>2,Xc
  If>%Xc%=0
    Let>Xc=-1
  Else
    Let>Xc=1
  EndIf
  Random>2,Yc
  If>%Yc%=0
    Let>Yc=-1
  Else
    Let>Yc=1
  EndIf
  Random>%Xspeed%,Xm
  Random>%Yspeed%,Ym
  Random>500,timeout
  add>Ym,1
  add>Xm,1
  Random>2,moveright
  Random>2,movedown
END>Setup

//DrawArc Usage:
//GoSub>DrawArc,WindowHandle,PenSize,PenColor,ULXLoc,ULYLoc,LRXLoc,LRYLoc,SXLoc,SYLoc,EXLoc,EYLoc

SRT>DrawArc
  LibFunc>user32,GetDC,HDC,%DrawArc_var_1%
  LibFunc>gdi32,CreatePen,Penres,0,%DrawArc_var_2%,%DrawArc_var_3%
  LibFunc>gdi32,SelectObject,SOPres,hdc,Penres
  Libfunc>gdi32,Arc,ARCres,HDC,%DrawArc_var_4%,%DrawArc_var_5%,%DrawArc_var_6%,%DrawArc_var_7%,%DrawArc_var_8%,%DrawArc_var_9%,%DrawArc_var_10%,%DrawArc_var_11%
  LibFunc>gdi32,DeleteObject,DOres,Penres
  LibFunc>user32,ReleaseDC,RDCres,HDC_1,HDC
END>DrawArc


SRT>Quit
  LibFunc>user32,ReleaseDC,RDCres1,HDC1_1,HDC1
  LibFunc>user32,ReleaseDC,RDCres1,HDC2_1,HDC2
  LibFunc>user32,ReleaseDC,RDCres2,HDC3_1,HDC3
  Exit>0
END>Quit
Oops. Forgot to add a ReleaseDC for HDC2 in the Quit subroutine. Its there now.
Last edited by JRL on Fri Apr 26, 2013 5:39 pm, edited 1 time in total.

User avatar
Rain
Automation Wizard
Posts: 550
Joined: Tue Aug 09, 2005 5:02 pm
Contact:

Post by Rain » Fri Apr 26, 2013 4:25 pm

That's pretty cool.

User avatar
Dorian (MJT support)
Automation Wizard
Posts: 1354
Joined: Sun Nov 03, 2002 3:19 am
Contact:

Post by Dorian (MJT support) » Mon Apr 29, 2013 11:54 pm

I always look forward to seeing what creative ideas you come up with next, JRL. That's pretty awesome! :)
Yes, we have a Custom Scripting Service. Message me or go here

Post Reply
Sign up to our newsletter for free automation tips, tricks & discounts