Quick Search for:  in language:    
Takes,picturebox,contents,runs,animated,mosai
   Code/Articles » |  Newest/Best » |  Community » |  Jobs » |  Other » |  Goto » | 
CategoriesSearch Newest CodeCoding ContestCode of the DayAsk A ProJobsUpload
Visual Basic Stats

 Code: 3,014,970. lines
 Jobs: 119. postings

 How to support the site

 
Sponsored by:

 

You are in:

 
Login



Latest Code Ticker for Visual Basic.
Click here to see a screenshot of this code!Excel Into a webpage
By Bill Donahue on 7/2

(Screen Shot)

Unroll2 - Update
By Cyber Chris on 7/2


MultilinePWD
By Cyber Chris on 7/2


Click here to see a screenshot of this code!Song/Poem Assistant
By Peter Rowan on 7/2

(Screen Shot)

Click here to see a screenshot of this code!GPA Cal
By KBM-00 on 7/2

(Screen Shot)

Click here to see a screenshot of this code!Connection Via the Telephone line.No internet or cable.Just the telephone line
By Nass ClickMan on 7/2

(Screen Shot)

DBTool
By Make Strömberg on 7/2


Click here to see a screenshot of this code!MSChart Simple Example
By Sebastian Pereira on 7/2

(Screen Shot)

CString v1.5
By Ultimatum on 7/2


Click here to put this ticker on your site!


Add this ticker to your desktop!


Daily Code Email
To join the 'Code of the Day' Mailing List click here!





Affiliate Sites



 
 
   

Mosaic

Print
Email
 

Submitted on: 5/19/1998
By: Dave Hng  
Level: Not Given
User Rating: By 100 Users
Compatibility:VB 5.0, VB 6.0

Users have accessed this code 13794 times.
 
 
     Takes a picturebox, and it's contents, and runs an animated mosaic transition through it
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
 
Terms of Agreement:   
By using this code, you agree to the following terms...   
1) You may use this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.   
2) You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
3) You may link to this code from another website, but ONLY if it is not wrapped in a frame. 
4) You will abide by any additional copyright restrictions which the author may have placed in the code or code's description.

'**************************************
' Name: Mosaic
' Description:Takes a picturebox, and it
'     's contents, and runs an animated mosaic
'     transition through it
' By: Dave Hng
'
' Inputs:pctMosaic, the picturebox objec
'     t that you're wanting to manipulate
MosaicMode, Set it To 1 For mosaic, 2 for demosaic, 3 for mosaic, Then demosaic
'
' Assumes:Nothing. If you want to edit i
'     t, that's another story :)
'
' Side Effects:Can crash some computers.
'     Seems to be a display driver to windows 
'     problem! I don't know what causes this!
'
'This code is copyrighted and has' limited warranties.Please see http://w
'     ww.Planet-Source-Code.com/vb/scripts/Sho
'     wCode.asp?txtCodeId=883&lngWId;=1'for details.'**************************************

Sub GenMosaic(pctMosaic As Variant, MosaicMode As Integer)

'Mosaic Mode is 1 for Mosaic, 2 for DeMo ' saic 'Declare all objects '======================================= ' =============================== 'This code is (C) StarFox / Dave Hng '98 ' ' 'Posted on http://www.planet-source-code ' .com during May '98. ' 'If you distribute this code, make sure ' that the complete listing is intact, wit ' h these 'comments! If you use it in a program, d ' on't worry about this introduction. ' 'Email: StarFox@earthcorp.com or psychob ' @inf.net.au 'UIN: 866854 ' 'Please credit me if you use this code! ' As far as i know, this is the only nice( ' ish) VB 'image manip sub that i've seen! This is ' one major code hack! :) ' 'Takes a picturebox, and runs a animated ' mosaic transition though it! ' 'Uses Safearrays, CopyMemory, Bitmap bas ' ics. Not for the faint hearted. ' 'pctMosaic is a picturebox object that y ' ou want to run the transition through 'MosaicMode is an integer, indicating wh ' at steps of the mosaic you want to run t ' hough. '1 is mosaic up, 2 is mosaic down, 3 is ' mosaic up, then down again. Experiment! ' ' 'Not very efficient, but the code runs a ' t about 2x to 10x emulated speed when co ' mpiled to 'native code! It runs really really fast ' compiled under the native code compiler! ' 'It's capable of animating a small bitma ' p on a 486dx2/80, with the interval set ' to 1, and 'no re-redraws. ' 'Only works on 256 colour, single plane ' bitmaps. I'll write one for truecolour i ' mages when 'i figure out how the RGBQuad type works ' , (Can anyone help?) and i've finished h ' igh school. ' 'You can change the for.. next statement ' s with the K and L variables to change t ' he speed of 'the function. K is the mosaic depth, L ' is the number of times to call the funct ' ion (limits 'speed, so you can see it better) ' 'Thanks to the guys that wrote the VBPJ ' article on direct access to memory. With ' out that info 'or ideas, i wouldnt've been able to wri ' te the sub. ' 'This code is used in StarLaunch, my mul ' ti emulator launcher: 'http://starlaunch.home.ml.org 'As a transition for screen size preview ' s for snes emulators. ' 'Note: It does crash some computers, for ' no known reason. 'I think it's as video card -> video ' driver problem. 'Don't break while this sub is running, ' unless you really have to. If you want t ' o stop 'execution, you must call the cleanup co ' de associated with what the sub's doing. ' '(Copymemory the pointer to 0& again) ' 'Have fun! ' '"If you think it's not possible, make i ' t!" ' '-StarFox Static mosaicgoing As Boolean 'Keep a static variable to check if the ' sub's running. If it is, EXIT! Otherwise
' , GPF! If mosaicgoing = True Then Exit Sub mosaicgoing = True 'Init variables Dim pict() As Byte Dim SA As SafeArray2D, bmp As BITMAP Dim r As Integer, c As Integer, Value As Byte, i As Integer, colour As Integer, j As Integer, k As Integer, L As Integer Dim pCenter As Integer, pC As Integer, pR As Integer Dim rRangei As Integer, rRangej As Integer, ti As Integer, ti2 As Integer Dim uC As Integer, uR As Integer Dim PictureArray() As Byte Dim mRange As Integer Dim cLimit As Integer, rLimit As Integer 'Copy to the array '======================================= ' =============================== GetObjectAPI pctMosaic.Picture, Len(bmp), bmp If bmp.bmPlanes <> 1 Or bmp.bmBitsPixel <> 8 Then MsgBox "Non-256 colour bitmap detected. No mosaic effects" Exit Sub End If
'Init the SafeArray With SA .cbElements = 1 .cDims = 2 .bounds(0).lLbound = 0 .bounds(0).cElements = bmp.bmHeight .bounds(1).lLbound = 0 .bounds(1).cElements = bmp.bmWidthBytes .pvData = bmp.bmBits End With
'Map the pointer over CopyMemory ByVal VarPtrArray(pict), VarPtr(SA), 4 'Make a temporary array to hold the bitm ' ap data. ReDim PictureArray(UBound(pict, 1), UBound(pict, 2)) 'Copy the bitmap into this array. I coul ' d use copymemory again, but this is fast ' enough, 'and a lot safer :) For c = 0 To UBound(pict, 1) For r = 0 To UBound(pict, 2) PictureArray(c, r) = pict(c, r) Next r
Next c
'Clean up CopyMemory ByVal VarPtrArray(pict), 0&, 4 '======================================= ' =============================== Select Case MosaicMode Case 1 'Mosaic For k = 1 To 16 Step 1 For L = 1 To 1 'Cube roots used, because the squaring effect looks nicer. Also, due To the 'Nature of my code, it hides irregular the pixel expansion mRange = k ^ 1.5 GoSub Mosaic Next L
Next k
Case 2 'DeMosaic For k = 16 To 0 Step -(1) For L = 1 To 1 mRange = k ^ 1.5 GoSub Mosaic Next L
Next k
Case 3 'Mosaic, then DeMosaic For k = 1 To 8 Step 1 mRange = k ^ 1.5 GoSub Mosaic Next k
For k = (8) To 0 Step -(1) mRange = k ^ 1.5 GoSub Mosaic Next k
End Select
mosaicgoing = False Exit Sub 'Actual Mosaic Code '======================================= ' =============================== Mosaic: 'Get the bitmap info again, in case some ' thing's changed GetObjectAPI pctMosaic.Picture, Len(bmp), bmp 'Reinit the SA With SA .cbElements = 1 .cDims = 2 .bounds(0).lLbound = 0 .bounds(0).cElements = bmp.bmHeight .bounds(1).lLbound = 0 .bounds(1).cElements = bmp.bmWidthBytes .pvData = bmp.bmBits End With
''Fake' the pointer CopyMemory ByVal VarPtrArray(pict), VarPtr(SA), 4 'Work out the distance between the squar ' e division grid, and the pixel to get da ' ta from. pCenter = (mRange) \ 2 'Find the limits of the image uC = UBound(pict, 1) uR = UBound(pict, 2) For c = 0 To UBound(pict, 1) Step (mRange + 1) For r = 0 To UBound(pict, 2) Step (mRange + 1) 'Work out the distance between the square division grid, and the pixel To Get data from. pCenter = (mRange) \ 2 'Pixel size To copy over rRangei = (mRange) rRangej = (mRange) 'Check if it's running out of bound, in ' case you turned the compiler option off. ' If c + mRange > UBound(pict, 1) Then rRangei = UBound(pict, 1) - c If r + mRange > UBound(pict, 2) Then rRangej = UBound(pict, 2) - r 'Work out where to get the data from pC = c + pCenter pR = r + pCenter If pC > UBound(pict, 1) Then pC = c If pR > UBound(pict, 2) Then pR = r 'Get the palette entry Value = PictureArray(pC, pR) If c = 0 Then cLimit = -pCenter If r = 0 Then rLimit = -pCenter 'Copy the palette entry number over the ' region's pixels For i = cLimit To (rRangei) For j = rLimit To (rRangej) If c + i < 0 Or r + j < 0 Then Goto SkipPixel pict(c + i, r + j) = Value SkipPixel: Next j
Next i
SkipThis: Next r
Next c
EndThis: 'Clean up CopyMemory ByVal VarPtrArray(pict), 0&, 4 'Refresh, so the user sees the change. D ' on't replace with a DoEvents! 'Refreshing is slower, but it's less dan ' gerous! pctMosaic.Refresh '======================================= ' =============================== Return End Sub


Other 6 submission(s) by this author

 

 
Report Bad Submission
Use this form to notify us if this entry should be deleted (i.e contains no code, is a virus, etc.).
Reason:
 
Your Vote!

What do you think of this code(in the Not Given category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor See Voting Log
 
Other User Comments
8/26/1999 10:43:00 PM:benjamin tan
can you send me a source code
for 
attaching animated gifs in my form
or 
if you have an anigif.ocx 
file,please
send it to me
thanks 
bench
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
1/20/2003 5:22:42 PM:Brian Battles WS1O
I think I'm mising something; you call 
GenMosiac with a Picturebox as an 
argument, but then you check the bmp 
variable for its values before the rest 
of the routine runs. But how do values 
get into the bmp?
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
Add Your Feedback!
Note:Not only will your feedback be posted, but an email will be sent to the code's author in your name.

NOTICE: The author of this code has been kind enough to share it with you.  If you have a criticism, please state it politely or it will be deleted.

For feedback not related to this particular code, please click here.
 
Name:
Comment:

 

Categories | Articles and Tutorials | Advanced Search | Recommended Reading | Upload | Newest Code | Code of the Month | Code of the Day | All Time Hall of Fame | Coding Contest | Search for a job | Post a Job | Ask a Pro Discussion Forum | Live Chat | Feedback | Customize | Visual Basic Home | Site Home | Other Sites | About the Site | Feedback | Link to the Site | Awards | Advertising | Privacy

Copyright© 1997 by Exhedra Solutions, Inc. All Rights Reserved.  By using this site you agree to its Terms and Conditions.  Planet Source Code (tm) and the phrase "Dream It. Code It" (tm) are trademarks of Exhedra Solutions, Inc.