Abnormal Map Draw

Sub map()

Dim p As PowerPoint.Presentation

Dim sd As Slide

Dim pptLayout As CustomLayout

Dim sdid As Long

Dim shp As Shape

Dim x0 As Double, y0 As Double, scx As Double, scy As Double

Dim x As Double, y As Double, xxx As Double, yyy As Double, r As Double, c As Double

Dim xx As Double, yy As Double

Dim cc As Double, dd As Double, ddx As Double, ddy As Double

Dim cw1 As Double, cw2 As Double, cw3 As Double

Dim rcol As Single, gcol As Single, bcol As Single

Dim rcol0 As Double, gcol0 As Double, bcol0 As Double

Dim rcol1 As Double, gcol1 As Double, bcol1 As Double

Dim rcol2 As Double, gcol2 As Double, bcol2 As Double

Dim rcola As Double, gcola As Double, bcola As Double

Dim rcolb As Double, gcolb As Double, bcolb As Double

Dim rcolc As Double, gcolc As Double, bcolc As Double

Dim pi As Double

pi = 3.1415926535898

rcol0 = 255: gcol0 = 0: bcol0 = 0

rcol1 = 255: gcol1 = 235: bcol1 = 132

rcol2 = 99: gcol2 = 190: bcol2 = 123

scx = 8 * 72 / 2.54

scy = 8 * 72 / 2.54

x0 = 16 * 72 / 2.54

y0 = 9 * 72 / 2.54

Set p = ActivePresentation

Set sd = p.Slides.Add(2, ppLayoutBlank)

sdid = sd.SlideIndex

ActiveWindow.View.GotoSlide (sd.SlideIndex)

dd = 0.1

For x = -1 To 1 - (dd / 2) Step dd

For y = -1 To 1 - (dd / 2) Step dd

xx = x + dd / 2: yy = y + dd / 2

xxx = x + dd: yyy = y + dd

r = xx * xx + yy * yy

If r > 1 Then

r = 1

End If

cc = fcnatn(xx, yy)

cw1 = cc

cw2 = cc / pi

cc = 1 - cc / pi

cw3 = cc

cc = cc * r

'MsgBox cc / pi

If cc > 0 Then

rcola = rcol1: gcola = gcol1: bcola = bcol1

rcolb = rcol2: gcolb = gcol2: bcolb = bcol2

Else

rcola = rcol1: gcola = gcol1: bcola = bcol1

rcolb = rcol0: gcolb = gcol0: bcolb = bcol0

End If

c = Abs(cc)

rcolc = rcola + c * (rcolb - rcola)

gcolc = gcola + c * (gcolb - gcola)

bcolc = bcola + c * (bcolb - bcola)

rcol = Round(rcolc, 0)

gcol = Round(gcolc, 0)

bcol = Round(bcolc, 0)

If (c > 0.95) Then

MsgBox cc

MsgBox Format(rcol, "0") + ":" + Format(gcol, "0") + ":" + Format(bcol, "0")

End If

xx = scx * x + x0

yy = scy * y + y0

xxx = scx * xxx + x0

yyy = scy * yyy + y0

ddx = dd * scx

ddy = dd * scy

Set shp = sd.Shapes.AddShape(msoShapeRectangle, xx, yy, ddx, ddy)

shp.Line.Visible = msoFalse

shp.Fill.ForeColor.RGB = RGB(rcol, gcol, bcol)

Next y

Next x

Set shp = sd.Shapes.AddShape(msoShapeOval, x0 - scx, y0 - scy, 2 * scx, 2 * scy)

shp.Fill.Visible = msoFalse

Set shp = sd.Shapes.AddShape(msoShapeRectangle, x0 - scx, y0 - scy, 2 * scx, 2 * scy)

shp.Line.Visible = msoFalse

shp.Fill.ForeColor.RGB = RGB(128, 128, 128)

End Sub