1 Тема от fomenos (изменено: alexii, 2014-02-18 16:08:03)

  • fomenos
  • Участник
  • Неактивен

Тема: VBScript: Как снизить нагрузку, создаваемую сценарием?

Есть такой пример кода на VBScript:


Option Explicit

dim oWord, oDoc, oSel, i, MyText

Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents
oDoc.Add()
oWord.Visible = True

 
dim radian, pi, deltaangle
PI=4*atn(1)
radian=PI/180
deltaangle=30*radian
 
dim shpCanvas
Set shpCanvas = oDoc(1).Shapes.AddCanvas(10, 10, 450, 300) 
shpCanvas.WrapFormat.Type = 7 
dim count
count = 0
Sub Ris(x,y, len, angle)
dim color, xnew, ynew
    if len<1 then
        Exit Sub        
    end if
    if len<15 then 
        color = RGB(0, 255, 51)
    else
        color = RGB(0, 0, 255)
    end if    
    xnew=x+round(len*cos(angle))
    ynew=y+round(len*sin(angle))
    shpCanvas.CanvasItems.AddLine x,y,xnew,ynew
    count = count + 1
    shpCanvas.CanvasItems(count).Line.ForeColor.RGB = color
    Call Ris(xnew, ynew, len*0.65, angle-deltaangle)
    Call Ris(xnew, ynew, len*0.65, angle+deltaangle)
End Sub

Call Ris(50,280,80,-40*radian)

После запуска сценария создается новый документ Word, и в нем посредством классов объектной модели Рисуется дерево Пифагора (фракталы). Все работает через рекурсию.
Проблема в том, что при рисовании создается сильная нагрузка на процессор, да и сам процесс рисования слишком долго происходит. Как можно решить данную проблему?

2 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: VBScript: Как снизить нагрузку, создаваемую сценарием?

objWord.Visible = False
objWord.ScreenUpdating = False

в начале и:

objWord.ScreenUpdating = True
objWord.Visible = True

— в конце, после всех рисований.

3 Ответ от fomenos

  • fomenos
  • Участник
  • Неактивен

Re: VBScript: Как снизить нагрузку, создаваемую сценарием?

Попробовал, но проблемы не решает. Все ровно идет нагрузка на процессор и время, затраченное на рисование не изменяется. Хотя аналогичный алгоритм работает намного быстрее, если использовать графические компоненты библиотеки WSO. Просто хочется именно в Word все это делать.

4 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: VBScript: Как снизить нагрузку, создаваемую сценарием?

и время, затраченное на рисование не изменяется.

Как говорил один товарищч — «Нэ вэрю».

Ваш код — 298.0781 секунд. С моими добавками:

+ открыть спойлер
Option Explicit

Dim lngTime

lngTime = Timer

dim oWord, oDoc, oSel, i, MyText

Set oWord = CreateObject("Word.Application")

oWord.Visible = False
oWord.ScreenUpdating = False

Set oDoc = oWord.Documents
oDoc.Add()
 
dim radian, pi, deltaangle
PI=4*atn(1)
radian=PI/180
deltaangle=30*radian
 
dim shpCanvas
Set shpCanvas = oDoc(1).Shapes.AddCanvas(10, 10, 450, 300) 
shpCanvas.WrapFormat.Type = 7 
dim count
count = 0
Sub Ris(x,y, len, angle)
dim color, xnew, ynew
    if len<1 then
        Exit Sub        
    end if
    if len<15 then 
        color = RGB(0, 255, 51)
    else
        color = RGB(0, 0, 255)
    end if    
    xnew=x+round(len*cos(angle))
    ynew=y+round(len*sin(angle))
    shpCanvas.CanvasItems.AddLine x,y,xnew,ynew
    count = count + 1
    shpCanvas.CanvasItems(count).Line.ForeColor.RGB = color
    Call Ris(xnew, ynew, len*0.65, angle-deltaangle)
    Call Ris(xnew, ynew, len*0.65, angle+deltaangle)
End Sub

Call Ris(50,280,80,-40*radian)

oWord.ScreenUpdating = True
oWord.Visible = True

WScript.Echo Timer - lngTime

— 8.640625 секунд.

5 Ответ от fomenos

  • fomenos
  • Участник
  • Неактивен

Re: VBScript: Как снизить нагрузку, создаваемую сценарием?

Действительно, время уменьшилось, Просто у меня видимо система не столь сильна, что даже с "добавками" приходится 79 секунд ждать