Screen Capture Utility

[PepsiHog]

Way back when.... I posted if anyone had a screen capture script. Either they weren't sharing or no one did.

Well, with a little imagination and a whole lot of "no idea how's" later, I have managed to write my own.

It is simplistic, but it works. Not everything is working yet. And it has items related to what I am using it for, but you can always clean it up.

If anyone comes up with a better one please post it.

Also, I have to give credit to JRL. He's the one that showed how to make the background of a window transparent. Thanks JRL. The SRT>Process is responsible for doing this in this macro.

Hope it might be useful to someone. Oh! Yeah! It's a little long.

You'll need v12 for this macro.

Code: Select all

Dialog>Dialog1
object Dialog1: TForm
  Left = 251
  Top = 104
  Cursor = crCross
  HelpContext = 5000
  BorderIcons = [biSystemMenu]
  BorderStyle = bsSizeToolWin
  Caption = 'Capture'
  ClientHeight = 359
  ClientWidth = 443
  Color = 16744703
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu
  OldCreateOrder = True
  ShowHint = True
  OnTaskBar = False
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = -8
    Top = 0
    Width = 457
    Height = 361
    Caption = 'Panel1'
    Color = 14215660
    ParentBackground = False
    TabOrder = 0
    Visible = False
    object Label1: TLabel
      Left = 184
      Top = 40
      Width = 73
      Height = 29
      Caption = 'Label1'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -24
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      ParentFont = False
    end
    object MSButton1: tMSButton
      Left = 138
      Top = 101
      Width = 175
      Height = 113
      DoubleBuffered = True
      ParentDoubleBuffered = False
      TabOrder = 0
      DoBrowse = False
      BrowseStyle = fbOpen
    end
    object MSButton2: tMSButton
      Left = 194
      Top = 255
      Width = 75
      Height = 25
      Caption = 'Go To Editor'
      DoubleBuffered = True
      ParentDoubleBuffered = False
      TabOrder = 1
      DoBrowse = False
      BrowseStyle = fbOpen
    end
    object MSButton3: tMSButton
      Left = 194
      Top = 292
      Width = 75
      Height = 25
      Caption = 'Discard'
      DoubleBuffered = True
      ParentDoubleBuffered = False
      TabOrder = 2
      DoBrowse = False
      BrowseStyle = fbOpen
    end
  end
  object MainMenu: tMSMainMenu
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    object MenuItem1: tMSMenuItem
      Caption = 'File'
      object MenuItem2: tMSMenuItem
        Caption = 'New'
      end
      object MenuItem3: tMSMenuItem
        Caption = 'Capture'
      end
      object MenuItem4: tMSMenuItem
        Caption = 'Save As'
      end
      object MenuItem5: tMSMenuItem
        Caption = '-'
      end
      object MenuItem6: tMSMenuItem
        Caption = 'Exit'
      end
    end
  end
end
EndDialog>Dialog1

AddDialogHandler>Dialog1,MSButton1,OnClick,Finish
AddDialogHandler>Dialog1,MenuItem2,OnClick,DoNew
AddDialogHandler>Dialog1,MenuItem3,OnClick,DoCapture
SetDialogProperty>Dialog1,Label1,Caption,Preview
let>Dialog1.Label1=Preview

GoSub>Process
ResetDialogAction>Dialog1

Show>Dialog1,c

srt>DoCapture
SetDialogProperty>Dialog1,MenuItem3,Enabled,False
SetDialogProperty>Dialog1,Panel1,Visible,False
wait>.5
GetWindowPos>Capture*,X1,Y1
// Adjustment for width(X1)
add>X1,4
// Adjustment for hieght(Y1)42new 21old
add>Y1,42
GetWindowSize>Capture*,X,Y
let>X2=X1+X
let>Y2=Y1+Y
// Adjustment for width(X2)
sub>X2,8
// Adjustment for hieght(Y2)
sub>Y2,21
// Remove panel from pic 44old
sub>Y2,23
ScreenCapture>X1,Y1,X2,Y2,C:\WinPic.jpg
SetDialogProperty>Dialog1,Panel1,Visible,True
ResetDialogAction>Dialog1
END>DoCapture

srt>DoNew
SetDialogProperty>Dialog1,Panel1,Visible,False
SetDialogProperty>Dialog1,MenuItem3,Enabled,True
ResetDialogAction>Dialog1
END>DoNew

SRT>Process
//constants
  Let>GWL_EXSTYLE=-20
  Let>WS_EX_LAYERED=524288
  Let>LWA_COLORKEY=1
//get style attributes of Notepad
  //GetWindowHandle>Notepad*,NPhdl
  GetWindowHandle>Capture*,NPhdl
  //mdl>%NPhdl%
  LibFunc>user32,GetWindowLongA,attribs,NPhdl,GWL_EXSTYLE
  Let>attribs={%attribs% OR %WS_EX_LAYERED%}
//make selected color transparent (color number 16777215)
  LibFunc>user32,SetWindowLongA,swl,NPhdl,GWL_EXSTYLE,attribs
  LibFunc>user32,SetLayeredWindowAttributes,res,NPhdl,16744703,0,LWA_COLORKEY
END>Process

srt>Finish
  exit
END>Finish