Quick Search for:  in language:    
following,code,will,great,text,effect,your,ap
   Code/Articles » |  Newest/Best » |  Community » |  Jobs » |  Other » |  Goto » | 
CategoriesSearch Newest CodeCoding ContestCode of the DayAsk A ProJobsUpload
Visual Basic Stats

 Code: 3,011,557. lines
 Jobs: 115. postings

 How to support the site

 
Sponsored by:

 

You are in:

 
Login



Latest Code Ticker for Visual Basic
Files Comperator (the right way)
By Jarry Claessen on 6/30


Simple UDP example
By Mick Walton on 6/30


CAPS Trigger
By Trevor Burley on 6/30


Auto clip picture
By Kenneth. Jakobsen on 6/30


Click here to see a screenshot of this code!Game of life clone (cool math)
By Johannes B on 6/30

(Screen Shot)

String to CHR()
By Nikhil Raj on 6/30


Encryption Decryption Demo
By Nikhil Raj on 6/30


Click here to see a screenshot of this code!Serial Registration
By Christian (eXonite Team) on 6/30

(Screen Shot)

AniViewer
By Jerrame Hertz on 6/30


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



 
 
   

TextEffect

Print
Email
 

Submitted on: 9/25/1998
By: Waty Thierry  
Level: Not Given
User Rating: By 1 Users
Compatibility:VB 4.0 (32-bit), VB 5.0, VB 6.0

Users have accessed this code 21871 times.
 
 
     The following code will add great text effect to your applications. It changes the spacing between the characters. By changing spaces, the characters move on the screen.
 
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: TextEffect
' Description:The following code will ad
'     d great text effect to your applications
'     . It changes the spacing between the cha
'     racters. By changing spaces, the charact
'     ers move on the screen.
' By: Waty Thierry
'
' Inputs:obj As Object
ByVal sText As String
ByVal lX As Long
ByVal lY As Long
Optional ByVal bLoop As Boolean = False
Optional ByVal lStartSpacing As Long = 128
Optional ByVal lEndSpacing As Long = -1
Optional ByVal oColor As OLE_COLOR = vbWindowText
'
' Assumes:Nothing.
Ex :
TextEffect Picture1, "", 12, 12, , 128, 0, RGB(&H80;, 0, 0)
TextEffect Me, "", 12, 12, , 128, 0, RGB(&H80;, 0, 0)
'
'This code is copyrighted and has' limited warranties.Please see http://w
'     ww.Planet-Source-Code.com/vb/scripts/Sho
'     wCode.asp?txtCodeId=1069&lngWId;=1'for details.'**************************************

' #VBIDEUtils#**************************
'     **********************************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/Researc
'     hTriangle/6311/
' * E-Mail: waty.thierry@usa.net
' * Date : 24/09/98
' * Time : 15:38
' * Module Name : TextEffect_Module
' * Module Filename : TextEffect.bas
' **************************************
'     ********************************
' * Comments : Try this text effect, gre
'     at effects
' *Ex :
' * TextEffect Picture1, "", 12, 12, , 1
'     28, 0, RGB(&H80;, 0, 0)
' * TextEffect Me, "", 12, 12, , 128, 0,
'     RGB(&H80;, 0, 0)
' *
' *
' **************************************
'     ********************************

Public Sub TextEffect(obj As Object, ByVal sText As String, ByVal lX As Long, ByVal lY As Long, Optional ByVal bLoop As Boolean = False, Optional ByVal lStartSpacing As Long = 128, Optional ByVal lEndSpacing As Long = -1, Optional ByVal oColor As OLE_COLOR = vbWindowText)

' #VBIDEUtils#************************** ' ********************************** ' * Programmer Name : Waty Thierry ' * Web Site : www.geocities.com/Researc ' hTriangle/6311/ ' * E-Mail: waty.thierry@usa.net ' * Date : 24/09/98 ' * Time : 15:39 ' * Module Name : TextEffect_Module ' * Module Filename : TextEffect.bas ' * Procedure Name: TextEffect ' * Parameters: ' *obj As Object ' *ByVal sText As String ' *ByVal lX As Long ' *ByVal lY As Long ' *Optional ByVal bLoop As Boolean = Fal ' se ' *Optional ByVal lStartSpacing As Long ' = 128 ' *Optional ByVal lEndSpacing As Long = ' -1 ' *Optional ByVal oColor As OLE_COLOR = ' vbWindowText ' ************************************** ' ******************************** ' * Comments : ' *** Kerning describes the spacing betw ' een characters when a font is written ou ' t. ' *** By default, fonts have a preset de ' fault kerning, but this very easy to mod ' ify ' *** under the Win32 API. ' * ' *** The following (rather unusally nam ' ed?) API function is all you need: ' * ' *** Private Declare Function SetTextCh ' aracterExtra Lib "gdi32" () (ByVal hdc A ' s Long, ByVal nCharExtra As Long) As Lon ' g ' * ' *** By setting nCharExtra to a negativ ' e value, you bring the characters closer ' together, ' *** and by setting to a positive value ' s the characters space out. ' *** It works with VB's print methods t ' oo. ' * ' * ' ************************************** ' ******************************** Dim lhDC As Long Dim iAs Long Dim xAs Long Dim lLen As Long Dim hBrushAs Long Static tRAs RECT Dim iDir As Long Dim bNotFirstTimeAs Boolean Dim lTimeAs Long Dim lIterAs Long Dim bSlowDownAs Boolean Dim lCOlorAs Long Dim bDoItAs Boolean lhDC = obj.hDC iDir = -1 i = lStartSpacing tR.Left = lX: tR.Top = lY: tR.Right = lX: tR.Bottom = lY OleTranslateColor oColor, 0, lCOlor hBrush = CreateSolidBrush(GetSysColor(COLOR_BTNFACE)) lLen = Len(sText) SetTextColor lhDC, lCOlor bDoIt = True Do While bDoIt lTime = timeGetTime If (i < -3) And Not (bLoop) And Not (bSlowDown) Then bSlowDown = True iDir = 1 lIter = (i + 4) End If
If (i > 128) Then iDir = -1 If Not (bLoop) And iDir = 1 Then If (i = lEndSpacing) Then ' Stop bDoIt = False Else lIter = lIter - 1 If (lIter <= 0) Then i = i + iDir lIter = (i + 4) End If
End If
Else i = i + iDir End If
FillRect lhDC, tR, hBrush x = 32 - (i * lLen) SetTextCharacterExtra lhDC, i DrawText lhDC, sText, lLen, tR, DT_CALCRECT tR.Right = tR.Right + 4 If (tR.Right > obj.ScaleWidth \ Screen.TwipsPerPixelX) Then tR.Right = obj.ScaleWidth \ Screen.TwipsPerPixelX DrawText lhDC, sText, lLen, tR, DT_LEFT obj.Refresh Do DoEvents If obj.Visible = False Then Exit Sub Loop While (timeGetTime - lTime) < 20
Loop
DeleteObject hBrush End Sub


Other 2 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
5/1/1999 3:47:00 AM:ccjx
send me a copy of that
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
6/20/1999 11:41:00 AM:Dan Sikorsky
OLE_COLOR is not defined as a user 
type. This needs to be done to pass the 
compliler.
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
7/19/1999 2:31:00 AM:saman
visual basic
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
8/28/1999 12:25:00 PM:eisi
*PLEASE* copy all this source into 
ONE File, so that you can download it 
easier.
thx, eisi
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
10/9/1999 10:17:00 PM:hernán
this page is very 
good!!!!!.CONGRATULATIONS!!!!
Writeme 
please
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
10/27/1999 9:04:00 PM:Renee
I can't get it to work, Please send me 
a zipped copy of the project
Thank you 
, Renee
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
12/22/1999 10:54:23 PM:Alaeddin
Can you 'PLEASE' send me a working copy 
of this to my email. 
I really 
appreciate this from you.
Thanks a lot 
man
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
2/24/2003 11:12:55 AM:Cy Toad
This dosen't appear to work on a text 
box or a label... Why would anyone want 
to change the text spacing in a Picture 
box, when you cant even put text in a 
picture box!!??
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.