OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   Feature requests/wishlist (http://forum.oberonplace.com/forumdisplay.php?f=33)
-   -   A macro that does this would be REALLY cool! (http://forum.oberonplace.com/showthread.php?t=7538)

runflacruiser 06-02-2011 08:43

A macro that does this would be REALLY cool!
 
Code:


MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM~8ZZ+:N
M?DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD8DDDDDDDDD$ODI$D
M+88888888888OOOOOOOO8DD8OOOOOOOOOOOOOOO8O88888O88888OOOOOOOOOO88O8O88888888D=MD
M+8888888888OOOOOOOD88DNNNDDO8OOOOOOOO8O8888888888888O8OOOOOOO8888O888888888D=MD
M+O8888888OOOOOODNNNNNN8NNMMNMMDNDOOOOOOO888888OO8888888OOO8OO8O8OO888888888D=MD
M+O88888OOOOOO8DNDNNNOOD8NNMMMMN8DMOOOOO88O8888O88888OOOOOOOOO8O88O8D8DO8888D=MD
M+888OOOOOOOOODNNDDM8NO7?=~DDNDMNDDNOOO8888888O88888O888O8OO88DO8,Z78OO88888D=MD
M+8OOOOOOOOOOZMDDNNDNNNNNN8INDZ~N8NNNOOOO888888O8888O8O888888OI7:~,,$?,,O888D=MD
M+8OOOOOOOO8ONNNNNNNNNNNNNND7,..,NMNNDOOO88O888O88888888888888+8I+Z7+~7?8888D=MD
M+OOOOOOZZZONMNNMNMNNNNNNNO~,..,.:MNMNDOOOOOOO88888888O8O88O88$88DDDD8OO8888D=MD
M+OOOOZZZZDDN8NMNMMNMNNNDNNI:,:$ZDMMNMOOOOOOOOO888888OOOOO8OO8888888D8888888D=MD
M+OOOOZZZZMZNNMMMMMMNNNDZ~+8=.~D+~$MNNDOOOOOOOOOOOOOOOOOOOO888~:I:D=$:,88888D=MD
M+OOZZZZZZZZNMMMMMMNNNNNN8?7+.:DNM~NN8OOOOOOOOOOOO8OOOOOOO8888=7I=,~=+:?O888D=MD
M+OOZZZZZZ$$DNMMNMMNNNZ=:,,:=,,,,,,MM88OZOOOOOOOOOOOOOOOOOO8O88O8888O$8=OO88D=MD
M+ZZZZ$$$$$NONMMMMNNNDOI~,,:+=,,,,:NMMZZZOZOOOOOOOOOOOOOOOO888888O88?O88O8O8D=MD
M+ZZ$$$$$$$OOMMMMMNDNDDZ+:,IDD8+,,~MMNZZZOZOOOOOOOOOOOOOOO8O8O$7:~:Z888888O8D=MD
M+ZZ$$ZOO8NNMMMMMNNNNDD87+~~=7$,,:=MMN8$ZZZZZZOOOOOOOOOOOOOOOOO888OO8O88O88OD=MD
M+$$$$77778NMNMNMNNNND88$7NO:D8DZ=DMMO$$$$$$ZZZZZZZOZOOOOOOOOOOOO8OOOOO88O88D=MD
M+$$$7$77IONNMMMNNNNND8OOZO88888=?MMM$8$$$$$$ZZZZZZZZOOOOOOOOOOOOOOOOOOOOO88D=MD
M+Z$$$777IINNMNNNNNNNNDOOOZ7=~::+OM$$DII7777$$$Z$ZZZZZZZZZOZZOOOOOOOOOOOOO8OD=MD
M+$$$77777IINMNDNNNNDNND8OZOO888MNN?III7II7777$$$$$$ZZZZZZZZOZOOOZZOOOOOOOOOD=MD
M+$$777777II?NNNN8$IDO8DDD88DNNMN8DI?II?.I=I~7I:++~+=?$?ZOII+??ZZZZZZOZOOZOOD=MD
M+$77777IIII?NNN8:,,,,,DDDDDDDNDNI?+??II??IIII77777$$$$$Z$ZZZZZZZZZZZZZZZOZZD=MD
M+77777IIIIIND=~::::,,....:DDZ88O??+?+???I~+?~,7=:.$77~$I$7+I?IZ$ZZZZZOZZZZZD=MD
M+777IIII??MOZ7?++==~:,.....DI8N7++?++??I??????I,III77777$$$$$Z$$$$$ZZ$ZZZZZD=MD
M+77III???ND8Z$???+===~::,,,,8DI+++++++???=?????.,??,II7I??7777777$$$$$$$ZZZN=MD
M+77II???ON8OOZ$I?I7II?=~::,,:==+=+++++?+?++?????II?IIIIII:III7777777$7$$$$$N=MD
M+II?????ND8O888O$7777?+=~~:,,=++==++++++++++?:?++????I?? ?I????III7I777777$D=MD
M+II??++?DD88DDDD8OZ7I?+=~~~:,:====+++++?+++++++++++?????+?+?+?++???I?III777D=MD
M+??++++=NDDDDDDND8OZ7?+++==~::+===++++++=+=+?+=+++++++ +.+=+++?+???????III7D=MD
M+??++=+NNNNNDDDNNND8Z7?++===~::=======++=++===~+====+~=+=~+++++++++??????IID=MD
M+??++++NNNNNNDDNNNDD8OZI+++==~~:======++=+===+++++++++++=+++++++++++?++????D=MD
M++++++=NNNNNDDDNDDDDDD8Z7I++==~~:=======+=+=+===+=+=+++++======++=+++++?+??D=MD
M+?++++=NNNNDD88DDNNNDDD8Z7?++==~::=============++=+==========++====++++++++D=MD
M++++++8NNDDD8OZODDNND888OZ$?+=~~:::~====+===================,,....,==++++++D=MD
M++++++NDD88OZ$7$ZDDNNND888O$?+=~::,:,====================,...........==+==+D=MD
M++++++NND8OZ7I???78DDNN88D8O$I+=~~::,,~===============~,,,.,,:~I??~,..,=+++D=MD
M+++++7NNDOZ$?++==+7DNNNN88D8O$I?+=~::,.:===========:,,,,,,:~IOOOZOO:,,..~=+N=MD
M+++++NNN8O$I+=~~~~=7DNNNND8D8OO$7?+~::,,:======::,,,,,::~?O8O====+ZO7::,,~=D=MD
M+++=INNN8Z7I+==~~~==IO8DNND8DDD88O7+=~:,,,,::::,:::::~=7888========DN$I:,,~N=MD
M+++=NNNNDZI+=====~=+?I?++DNN8DDDDD8$?=~~:::::~:~~~~=IO88NNNDO$I+=~=:::?$~,:N=MD
M+==ONNNNDO7+=~=====+IOZI+?8NNDDDDDD8O7+~~===++?I?IZ8DDMNN+:,,......... . =,N=MD
M+++NNNNND8$I==~~~~~=I8OZ7I7DNO~DDDDDDOOII$$ZOOOZ8DDNNNDOII7777I$Z$77??=,..~N=MD
M++NNNNDDDO$I+==~~~==+88OOOO88~~~?DNDDDDD88D8O8DDMMMNMMN88OOZ7+~=~~~~~OO87~,D=MD
M+=NNNND8OZ7+=======++7DDDI~~~~=~~~DNND8DDDDDDMN+~:,,,:,~~~~~~~~~~~~~~~~~Z88D=MD
M+NNDDD8Z$I?+========+?DND:~~~~~~~~=~MMNNN~:,,...,,,,,,,,:~:~~:~~~~~~~~~~~~ZD=MD
M+ND8OO$7?++======+=++I$D7~~~~~~~~~~=~::,,,,..,,:::::::::::~~~~~~~~~~~~~~~~~N=MD
M+NDZ$I?+===~====++++?IZD~~~~~=~~~::::,,,...,,::~~=+++~:::,:~~~::::~:~~~~~~~N=MD
M+DO$?+==~~~~=~===?I7$88:~~~~~~~::::,,,....,:::~~+?7+=~::::::~~~:::::~~::~:~D=MD
M+O$?+=~~~~::::~~=?$88D~~~~~:::::,,,,,...,::::=++7?=~~::,::::~~::~~::~:::::~D=MD
M+Z$?+=~~~~::~~~==IOND~~~~::::,,,,.,,,,:::::~=?7Z+==++=~~:::::~~~::::::::~::D=MD
M+7I++===~~~~~~=+IZN~~~~~::::,,,,.,,:::::~==+?$O++ZND7+~~::::::~:::::::~::::D=MD
M+++===~~~~~====?ZD~==~::::,,,,,,,,::::~==+?7ZOODNNDZI+=~=~~::::::::~::~~:~:D=MD
M+==~::::::::~+?ZD+~~::::,,,,,::::::~~~=+I7Z88DNNNMN8$?=====~~~::::::~~~~:~~D=MD
M+~~:::,,,,:::~?=~::,::,,,,,::::~~~===+I7ZO8DDDO~~NNDO7?+==+==~~::::::::::::D=MD
M+~~~:::,,,,:=~::,:,,,,,,:::::::~==++?7$Z8DD8~~~~~~NNDO$I+===+=~~:~:::::::::D=MD
M+=~~~:::::,,:::,,,,,,,::::~~~==+++I7ZO88DD~~~~~~~~DNN8Z7?+===+=~~:~::::::::D=MD
M++==~~~::::,:,,,,,,:,::~~===+??I77ZOO8DD7~~~~~~~~~~NNDOZ7?+==+?==~~~:::::::D=MD
M++===~~~::::::,,,:::~~~=+++?II$ZOO88DDD~~~~~~~~~~~~~NND8Z7?+++++==~=:::~:::D=MD
M+I++===~=~~~~::::~~===+?I777$ZOO88DDD~~~~~~~~~~~~~~~DNND8O$I++++?+=~=:::::~D=MD
M+7I++=======~====++++II7$$$ZOO88DDDD~~~~~~~~~~~~~~~~~DNND8O$I?++I?++=::::::D=MD
M+Z$I?+========+=++?I77$ZZOO888DDD8=~~=~~~~~~~~~~~~~~~~DDDD8O$7???7?+==::~~~D=MD
M+OZ$7??+=====+=+?I7$$ZZOO88DDDDD~~~~~~~~~~~~~~~~~=~~~~~+DDD88ZZ7I77I+++~~:~D=MD
M+D8OZZ7II?++++?I7$ZOO8888DDDDD~===~==~~~~~=~~~=~~=~~~~~~~8DDD8Z$77$7I++=~~~D=MD
M+NDDD8OOZ$$7777$ZO88DDDDDD8~=~~~==~~~~=~~~~~~~~=~~~~~~~~~~~DDD8OZ$ZZ7?++:~~D=MD
M+NNNNDDD888O8OO88DDDDDD8~===~~====~~~~~~~~~~~=~~~~~=~~~~~~~:?DDDOZZOZ7I?+::D=MD
M+MNNNNNNNNNNDDDDDDDDDO~~~~~=~~~=~~~~~~~~~~=~~~~~~~~~~~~~~~~~::8DD8OO8Z$II?~D=MD
M?NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNO=MD
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMD
NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNND
                                                                GlassGiant.com


Joe 22-08-2013 14:24

Sorry for necromancing, but I happened upon this post while searching for something. There is a way, albeit a REALLY inefficient one - using WinAPI GetPixel calls to get pixel colors from screen and use the color values to determine shape size, for example.

I have been hoping to have a code-driven way to take colors from the document for versions, but no cigar.

So here's some ultra-rough code that does something similar to your example. It could be improved by refining the glyph string and just cleaning up in general:

Code:

Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Sub TestIt()

    Textify 5

End Sub

Sub Textify(Size As Double)
    Dim lDC As Long
    lDC = GetWindowDC(0)

    Dim RR, GG, BB
    Dim RRh, GGh, BBh
    Dim strBGR
    Dim strBGRLen
   
    Dim StartX As Long, StartY As Long
   
    ActiveDocument.Unit = cdrMillimeter
   
    Dim S As Shape
   
    Dim Glyphs() As String
   
    Glyphs = Split(". _ o b O 9 8 M G")
   
    'boostStart "LEDalize"
   
    Set S = ActiveSelection.Shapes.Last
   
    Dim SR As New ShapeRange, V As Shape
   
    For X = Size / 2 To S.SizeWidth Step Size
        For Y = Size / 2 To S.SizeHeight Step Size
            ActiveWindow.DocumentToScreen S.LeftX + X + Size / 2, S.BottomY + Y + Size / 2, StartX, StartY
            strBGR = (Hex(GetPixel(lDC, StartX, StartY)))
            strBGRLen = Len(strBGR)

            If strBGRLen < 6 Then
                For cnt = 1 To 6 - strBGRLen Step 1
                    strBGR = "0" & strBGR
                Next cnt
            End If
           
            BBh = VBA.Left(strBGR, 2)
            GGh = Mid(strBGR, 3, 2)
            RRh = VBA.Right(strBGR, 2)
     
            BB = Val("&H" & BBh)
            GG = Val("&H" & GGh)
            RR = Val("&H" & RRh)

            If Size > 0 Then
                Set V = ActiveVirtualLayer.CreateEllipse2(X, Y, Size / 2)
                V.Fill.UniformColor.RGBAssign RR, GG, BB
                V.Outline.SetNoOutline
               
                V.Fill.UniformColor.ConvertToHSB
               
                With ActiveLayer.CreateArtisticText(0, 0, Glyphs(1 + V.Fill.UniformColor.HSBBrightness / 40))
               
                    .SetSize , Size
               
                    .CenterX = X
                    .CenterY = Y
               
                End With
               
                SR.Add V
            End If
        Next Y
    Next X
   
    ActiveDocument.LogCreateShapeRange SR
   
    'boostFinish True
   
End Sub

One way to test it would be to put some art that's about 100x100mm and then run the TestIt bit.


All times are GMT -5. The time now is 22:32.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com