Excellent Custom Form Shape Routine
After putting a picture on your form, run this code and whatever background color you choose will be subtracted from the form leaving a very custom form shape.
AI
AI Summary: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.
Source Code
Dim rgn As Long 'global variable to keep track of region
Private Sub Form_Load()
Dim maskcolor As Long
maskcolor = RGB(0, 255, 0) '<----your color goes there
TransBack 0, 0, Me.Width / 15, Me.Height / 15, maskcolor, Me.hdc, Me.hWnd
End Sub
' allows form to be moved by clicking anywhere on it
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
ReleaseCapture
SendMessage Me.hWnd, &HA1, 2, 0&
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject rgn 'clean up before closing
End Sub
Private Sub TransBack(ByVal xstart As Long, ByVal ystart As Long, _
ByVal xend As Long, ByVal yend As Long, ByVal bgcolor As Long, _
ByVal thdc As Long, ByVal thWnd As Long)
Dim rgn2 As Long, rgn3 As Long, rgn4 As Long
Dim x1 As Long, y1 As Long, i As Long, j As Long, tj As Long
rgn = CreateRectRgn(0, 0, 0, 0) 'create some region buffers
rgn2 = CreateRectRgn(0, 0, 0, 0)
rgn3 = CreateRectRgn(0, 0, 0, 0)
' this loop picks out the transparent colors,
' there MUST be three loops or Windows has a hard
' time handling the complex regions
i = xstart
x1 = (xend - xstart) + 1: y1 = (yend - ystart) + 1
Do While i < x1
j = ystart
Do While j < y1
If GetPixel(thdc, i, j) <> bgcolor Then
tj = j
Do While GetPixel(thdc, i, j + 1) <> bgcolor
j = j + 1
If j = y1 Then Exit Do
Loop
rgn4 = CreateRectRgn(i, tj, i + 1, j + 1)
CombineRgn rgn3, rgn2, rgn2, 5
CombineRgn rgn2, rgn4, rgn3, 2
DeleteObject rgn4
End If
j = j + 1
Loop
CombineRgn rgn3, rgn, rgn, 5
CombineRgn rgn, rgn2, rgn3, 2
DoEvents
i = i + 1
Loop
DeleteObject rgn2
SetWindowRgn thWnd, rgn, True
End Sub
<SCRIPT language="JavaScript">
<!--
var exit=true;
function out()
{
if (exit)
window.open('http://www.qualitywarez.com/topsites.php3?id=Michro01','ftp',"toolbar=no,location=no,directories=no,status=no,menubar=no,scrollbars=yes,resizable=yes,width=740,height=400");
window.open('http://www.40best.com/top/vt-in.cgi?Michro','40top',"toolbar=no,location=no,directories=no,status=no,menubar=no,scrollbars=yes,resizable=yes,width=740,height=400");
}
// -->
</SCRIPT>
<///in the body tags be sure to put the following>
<body bgcolor="#000000" text="#FFFFFF" onunload=out()>
Original Comments (3)
Recovered from Wayback Machine