Blend 2 images with gdiplusX
*This code makes a blend or dissolve effect with 2 images and can blend a text with adjusted format (font+size+position by dragging it).
*GdiplusX class and system.app must be reached mandatory from code making it to work
*Can choice 2 images and adjust the blend effect (relative transparency) to have the best effect.
*See the summary help in the code.
(rebuilt in html mode because the provider editor made some cuts in original code).
Click on code to select [then copy] -click outside to deselect
*Begin Code
Set Classlib To Locfile("gdiplusX.vcx") AddI
set defa to addbs(justpath(sys(16,1)))
Publi yform
yform=Newobject("ytransparency_image")
yform.Show
Release Classlib gdiplusX
Read Events
Return
*
Define Class ytransparency_image As Form
Height = 720
Width = 800
ShowWindow = 2
ShowTips = .T.
BackColor=0
AutoCenter = .T.
Picture = ""
Caption = "yTransparency image"
MinWidth = 710
xoffset = .F.
yoffset = .F.
yfont = .F.
Name = "Form1"
Add Object imgcanvas1 As imgcanvas With ;
Stretch = 2, ;
BorderStyle = 1, ;
Height = 372, ;
Left = 36, ;
Top = 12, ;
Width = 576, ;
rendermode = 4, ;
drawwheninvisible = .T., ;
Name = "IMGCANVAS1"
Add Object imgcanvas2 As imgcanvas With ;
Stretch = 2, ;
Height = 70, ;
Left = 36, ;
Top = 432, ;
Width = 576, ;
rendermode = 4, ;
drawwheninvisible = .T., ;
Name = "Imgcanvas2"
Add Object image1 As Image With ;
Stretch = 2, ;
Height = 37, ;
Left = 7, ;
Top = 12, ;
Width = 25, ;
Name = "Image1"
Add Object olecontrol1 As OleControl With ;
oleclass="MSComctlLib.Slider.2", ;
Top = 678, ;
Left = 18, ;
Height = 25, ;
Width = 89, ;
Anchor = 768, ;
Name = "Olecontrol1"
Add Object command3 As CommandButton With ;
Top = 678, ;
Left = 135, ;
Height = 27, ;
Width = 27, ;
Anchor = 768, ;
Caption = "....", ;
MousePointer = 15, ;
ToolTipText = "foreground image", ;
Name = "Command3"
Add Object command2 As CommandButton With ;
Top = 678, ;
Left = 107, ;
Height = 27, ;
Width = 27, ;
Anchor = 768, ;
backcolor=255,;
Caption = "....", ;
MousePointer = 15, ;
ToolTipText = "Background image", ;
Name = "Command2"
Add Object command4 As CommandButton With ;
Top = 678, ;
Left = 685, ;
Height = 27, ;
Width = 61, ;
Anchor = 768, ;
backcolor=Rgb(0,255,0),;
Caption = "Capture", ;
MousePointer = 15, ;
ToolTipText = "Capture image", ;
Name = "Command4"
Add Object command1 As CommandButton With ;
Top = 678, ;
Left = 161, ;
Height = 27, ;
Width = 32, ;
Anchor = 768, ;
backcolor=Rgb(0,0,255),;
Caption = "Font", ;
Name = "Command1"
Add Object text1 As TextBox With ;
Anchor = 768, ;
Value = "Blend 2 images with gdiplusX", ;
Height = 27, ;
Left = 253, ;
Top = 678, ;
Width = 336, ;
Name = "Text1"
Add Object shape1 As Shape With ;
Top = 678, ;
Left = 619, ;
Height = 27, ;
Width = 25, ;
Anchor = 768, ;
MousePointer = 15, ;
ToolTipText = "tEST FORECOLOR", ;
BackColor = Rgb(255,0,0), ;
Name = "Shape1"
Add Object shape2 As Shape With ;
Top = 678, ;
Left = 593, ;
Height = 27, ;
Width = 25, ;
Anchor = 768, ;
MousePointer = 15, ;
ToolTipText = "Text backcolor", ;
BackColor = Rgb(0,0,0), ;
Name = "Shape2"
Add Object command6 As CommandButton With ;
Top = 678, ;
Left = 646, ;
Height = 36, ;
Width = 38, ;
Anchor = 768, ;
Picture = Home(1)+"graphics\icons\win95\explorer.ico", ;
Caption = "", ;
MousePointer = 15, ;
ToolTipText = "Explorer", ;
Name = "Command6"
Add Object spinner1 As Spinner With ;
FontBold = .T., ;
Anchor = 768, ;
Height = 27, ;
Left = 195, ;
SpinnerHighValue = 128.00, ;
SpinnerLowValue = 9.00, ;
ToolTipText = "FONTsize 9-128", ;
Top = 678, ;
Width = 60, ;
Value = 9, ;
Name = "Spinner1"
Add Object command5 As CommandButton With ;
Top = 678, ;
Left = 748, ;
Height = 27, ;
Width = 25, ;
FontBold = .T., ;
FontSize = 16, ;
Anchor = 768, ;
Caption = "?", ;
MousePointer = 15, ;
ForeColor = Rgb(0,255,0), ;
Name = "Command5"
Procedure yimg
Thisform.olecontrol1.Value=100*k
_Screen.WindowState=1 &&reduce vfp screen
Thisform.imgcanvas1.Stretch=2
Messagebox("Choice the background picture image and imgcanvas",0+32+4096,"",2000)
Thisform.image1.Picture=Getpict("","","Picture1") &&background picture
Thisform.imgcanvas1.Picture=Getpict("","","Picture2") &&imgcanvas picture
Thisform.Resize()
Endproc
Procedure DragDrop
Lparameters oSource, nXCoord, nYCoord
oSource.Left = nXCoord - Thisform.xoffset
oSource.Top = nYCoord - Thisform.yoffset
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure Init
With Thisform.olecontrol1
.Max=100
.Min=0
.smallchange=1
.largeChange=5
.Refresh
Endwith
Publi k,yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
k=0.35
Thisform.yimg()
Endproc
Procedure Resize
This.LockScreen=.T.
This.imgcanvas1.Left=20
This.imgcanvas1.Top=5
This.imgcanvas1.Width=This.Width-2*20
This.imgcanvas1.Height=This.Height-3*20
This.image1.Left=This.imgcanvas1.Left
This.image1.Top=This.imgcanvas1.Top
This.image1.Width=This.imgcanvas1.Width
This.image1.Height=This.imgcanvas1.Height
* this.imgcanvas1.zorder(0)
This.image1.ZOrder(1)
This.imgcanvas2.ZOrder(0)
This.imgcanvas2.Width=Thisform.imgcanvas1.Width
This.imgcanvas2.Left=Thisform.imgcanvas1.Left
This.imgcanvas2.ZOrder(0)
This.LockScreen=.F.
Endproc
Procedure imgcanvas1.beforedraw
If Empty(Thisform.image1.Picture) Or Empty(Thisform.imgcanvas1.Picture)
Return .F.
Endi
Local loGfx As xfcGraphics, oBmp As xfcBitmap
loGfx = This.oGfx
With _Screen.System.Drawing
loGfx.Clear(.Color.Transparent)
loBmp = .Bitmap.FromFile(This.Picture)
loGfx.InterpolationMode = .Drawing2D.InterpolationMode.HighQualityBicubic
*k=0.5 &&0.35 &&adjust here the image transparency (0-1)
loMatrix = .Imaging.ColorMatrix.New( ;
1, 0, 0, 0, 0, ;
0, 1, 0, 0, 0, ;
0, 0, 1, 0, 0, ;
0, 0, 0, 1, 0, ;
0, 0, 0, -k, 1)
loAttr = .Imaging.ImageAttributes.New()
loAttr.SetColorMatrix(loMatrix)
This.oGfx.DrawImage(loBmp, This.Rectangle, loBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr)
Endwith
Endproc
Procedure imgcanvas2.MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
If nButton = 1 && Left button
Thisform.imgcanvas1.Visible=.F.
Thisform.image1.Visible=.F.
Thisform.xoffset = nXCoord - This.Left
Thisform.yoffset = nYCoord - This.Top
This.Drag
Thisform.imgcanvas1.Visible=.T.
Thisform.image1.Visible=.T.
Endif
Endproc
Procedure imgcanvas2.DragDrop
Lparameters oSource, nXCoord, nYCoord
This.Parent.DragDrop(oSource, nXCoord, nYCoord)
Endproc
Procedure imgcanvas2.beforedraw
If Empty(Thisform.image1.Picture) Or Empty(Thisform.imgcanvas1.Picture)
Return .F.
Endi
This.Width=Thisform.imgcanvas1.Width
This.Left =Thisform.imgcanvas1.Left
If This.Top>=Thisform.imgcanvas1.Top+Thisform.imgcanvas1.Height
This.Top=Thisform.imgcanvas1.Top+Thisform.imgcanvas1.Height-This.Height
Endi
If This.Left<=Thisform.imgcanvas1.Left Or This.Left>=Thisform.imgcanvas1.Leftt+Thisform.imgcanvas1.Width
This.Left=Thisform.imgcanvas1.Left
Endi
Local loFont As xfcFont
With _Screen.System.Drawing
*This.Clear()
This.Clear(.Color.Transparent)
If Empty(Thisform.yfont)
Thisform.yfont=[ARIAL,28,B]
Endi
lcfont=Getwordnum(Thisform.yfont,1,',')
lcsize=Val(Getwordnum(Thisform.yfont,2,','))
Thisform.spinner1.Value=Int(m.lcsize)
lcstyle=Getwordnum(Thisform.yfont,3,',')
Local lostyle
Do Case
Case m.lcstyle == "B"
m.lostyle = .FontStyle.Bold
Case m.lcstyle == "I"
m.lostyle = .FontStyle.Italic
Case m.lcstyle == "BI"
m.lostyle = .FontStyle.BoldItalic
Otherwise
m.lostyle = .FontStyle.Regular
Endcase
* Create a bitmap in a fixed ratio to the original drawing area.
Local loBmp As xfcBitmap
loBmp = .Bitmap.New(This.Width / 5, This.Height / 5)
* Create a GraphicsPath object.
Local loPath As xfcGraphicsPath
loPath = .Drawing2D.GraphicsPath.New()
* Add the string in the chosen style.
loPath.AddString(Thisform.text1.Value, ;
.FontFamily.New(m.lcfont), ;
m.lostyle, ;
m.lcsize, ;
.Point.New(0, 0), ;
.StringFormat.GenericTypographic)
* Get the graphics object for the image.
Local loGfx As xfcGraphics
loGfx = .Graphics.FromImage(loBmp)
* Create a matrix that shrinks the drawing output by the fixed ratio.
Local loMatrix As xfcMatrix
loMatrix = .Drawing2D.Matrix.New(1/5, 0, 0, 1/5, -1/5, -1/5)
* Choose an appropriate smoothing mode for the halo.
loGfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
* Transform the graphics object so that the same half may be used for both halo and text output.
loGfx.Transform = loMatrix
* Using a suitable pen...
Local loPen As xfcPen
loPen = .Pen.New(.Color.FromRGB(Thisform.shape2.BackColor))
* Draw around the outline of the path
loGfx.DrawPath(loPen, loPath)
* and then fill in for good measure.
loGfx.FillPath( .SolidBrush.New(.Color.FromRGB(Thisform.shape1.BackColor)), loPath)
* setup the smoothing mode for path drawing
This.oGfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
* and the interpolation mode for the expansion of the halo bitmap
This.oGfx.InterpolationMode = .Drawing2D.InterpolationMode.HighQualityBicubic
* expand the halo making the edges nice and fuzzy.
This.oGfx.DrawImage(loBmp, This.Rectangle, 0, 0, ;
loBmp.Width, loBmp.Height, .GraphicsUnit.Pixel)
* Redraw the original text
This.oGfx.FillPath(.SolidBrush.New(.Color.FromRGB(Thisform.shape1.BackColor)), loPath)
Endwith
Endproc
Procedure olecontrol1.Change
*** Événement de contrôle ActiveX ***
k=This.Value/100
Thisform.imgcanvas1.Draw
Endproc
Procedure command3.Click
Try
Thisform.imgcanvas1.Picture=Getpict()
Thisform.imgcanvas1.Draw
Catch
Endtry
Endproc
Procedure command2.Click
Try
Thisform.image1.Picture=Getpict()
Thisform.imgcanvas1.Draw
Catch
Endtry
Endproc
Procedure command4.Click
Thisform.olecontrol1.Visible=.F.
Thisform.SetAll("visible",.F.,"commandbutton")
Local loCaptureBmp As xfcBitmap
With _Screen.System.Drawing
loCaptureBmp = .Bitmap.FromScreen(Thisform.HWnd)
* Crop Top
Local loRect As xfcRectangle
loRect = .Rectangle.New(Thisform.imgcanvas1.Left+Sysmetric(3),Sysmetric(9)+Sysmetric(4)+Thisform.imgcanvas1.Top, Thisform.imgcanvas1.Width , Thisform.imgcanvas1.Height )
loCropped = loCaptureBmp.Clone(loRect)
loCropped.Save("captured.png",.Imaging.ImageFormat.Png)
Endwith
Thisform.olecontrol1.Visible=.T.
Thisform.SetAll("visible",.T.,"commandbutton")
Run/N explorer captured.Png
Endproc
Procedure command1.Click
Local lcfont,lcsize,lcstyle
Thisform.yfont=Getfont()
Thisform.imgcanvas2.Draw
Endproc
Procedure text1.Valid
Thisform.imgcanvas2.Draw
Endproc
Procedure shape1.Click
This.BackColor=Getcolor()
Thisform.imgcanvas2.Draw
Endproc
Procedure shape2.Click
This.BackColor=Getcolor()
Thisform.imgcanvas2.Draw
Endproc
Procedure command6.Click
Run/N explorer &yrep
Endproc
Procedure spinner1.InteractiveChange
If Empty(Thisform.yfont)
Thisform.yfont=[ARIAL,28,B]
Endi
lcfont=Getwordnum(Thisform.yfont,1,',')
lcsize=This.Value
lcstyle=Getwordnum(Thisform.yfont,3,',')
Thisform.yfont=m.lcfont+','+Trans(m.lcsize)+','+m.lcstyle
Thisform.imgcanvas2.Draw
Endproc
Procedure command5.Click
Local M.MYVAR
TEXT TO M.MYVAR NOSHOW
set a background image and a foreground image.
set a text in the textbox.
-can choice the dissolving state of the two images in the slider(0-100%)
-can increase or decrease the font to zoom the text set.Drag the text
-anywhere on image by mousedown.
-can adjust the text position by dragging with left button mouse.
-can choice the forecolor text and the shadow color.
-can capture the resulting imageand show in MSPAINT (save as you want to png,jpg,bmp,gif..).
ENDTEXT
Messagebox(m.MYVAR,0+32+4096,"Summary Help")
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*
*End Code
the summary help is in the code.