Highlights
All Snippets
Top 100 Snippets
Librarians
gbCodeLib

By Language
VB6
JavaScript
Perl
HTML
SQL
Java
DOS

GBIC >> Source Code >> Visual Basic >> Snippet

Overlay an image


'four kinds of overlay (smaller picture placed on top of larger picture)
- blocking
- transparency
- transparency With merging
- masked

'---Blocking---
'copy all or part of 1 image onto another
Dim DT As Long , DL As Long , DW As Long , DH As Long
Dim ST As Long , SL As Long , SW As Long , SH As Long
DT = 0         'DestTop
DL = 0         'DestLeft
DW = 5000      'DestWidth   use this for resizing the painted image
DH = 5000      'DestHeight  use this for resizing the painted image
'use these 4 for selecting a portion of the source image
ST = 100      'SourceTop
SL = 100      'SourceLeft
SW = 200      'SourceWidth
SH = 200      'SourceHeight
picBackGround.PaintPicture picOverlay.Picture, DT, DL, DW, DH, ST, SL, SW, SH

'---Transparency---
'can't use paintpicture because it doesn't support transparency color
Dim BackgroundTop As Long , BackgroundLeft As Long
Dim OverlayTop As Long , OverlayLeft As Long , OverlayWidth As Long , OverlayHeight As Long
Dim TColor As Long
Dim x As Long , y As Long

TColor = vbWhite

BackgroundTop = 20      'starting point on background
BackgroundLeft = 50      'starting point on background

'use these 4 for selecting a portion of the source image
OverlayTop = 0      'starting point on overlay
OverlayLeft = 0      'starting point on overlay
OverlayWidth = 30    'ending point on overlay
OverlayHeight = 30    'ending point on overlay
   
'perform the overlay
picBackground.ScaleMode = vbPixels
picoverlay.ScaleMode = vbPixels
For x = OverlayLeft To OverlayLeft + OverlayWidth
    For y = OverlayTop To OverlayTop + OverlayHeight
        If picoverlay.Point(x, y) <> TColor Then
           picBackground.PSet (BackgroundLeft + x - OverlayLeft, BackgroundTop + y - OverlayTop), picoverlay.Point(x, y)    '***see below***
        End If
    Next y
Next x

'---Merging---
'instead of the background taking on the overlay color, let the background show through (semi-transparency)
Dim BackgroundTop As Long , BackgroundLeft As Long
Dim OverlayTop As Long , OverlayLeft As Long , OverlayWidth As Long , OverlayHeight As Long
Dim x As Long , y As Long , A As Byte , Color As Long
Dim R1 As Long , R2 As Long , G1 As Long , G2 As Long , B1 As Long , B2 As Long
'A is the alpha (transparency 0-255)
A = 100
BackgroundTop = 20      'starting point on background
BackgroundLeft = 50      'starting point on background

'use these 4 for selecting a portion of the source image
OverlayTop = 0      'starting point on overlay
OverlayLeft = 0      'starting point on overlay
OverlayWidth = 30    'ending point on overlay
OverlayHeight = 30    'ending point on overlay
   
'perform the overlay
picBackground.ScaleMode = vbPixels
picOverlay.ScaleMode = vbPixels
For x = OverlayLeft To OverlayLeft + OverlayWidth
    For y = OverlayTop To OverlayTop + OverlayHeight
       Color = picOverlay.Point(x, y)
       R1 = Color Mod 256
       G1 = (Color \ 256) Mod 256
       B1 = (Color \ 256 \ 256) Mod 256
       Color = picBackground.Point(BackgroundLeft + x - OverlayLeft, BackgroundTop + y - OverlayTop)
       R2 = Color Mod 256
       G2 = (Color \ 256) Mod 256
       B2 = (Color \ 256 \ 256) Mod 256

       R1 = (A * R1 + (255 - A) * R2) \ 256
       G1 = (A * G1 + (255 - A) * G2) \ 256
       B1 = (A * B1 + (255 - A) * B2) \ 256

       Color = RGB(R1, G1, B1)
       picBackground.PSet (BackgroundLeft + x - OverlayLeft, BackgroundTop + y - OverlayTop), Color
    Next y
Next x

'---Masked---
< In work >