libreoffice-dmaths 3.4+dfsg1-1 / usr / lib / libreoffice / share / extensions / DmathsAddon / OOoGdmath / ReseauForm.xba

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ReseauForm" script:language="StarBasic">&apos;OOoGdmath
&apos;Copyright (C) 2005-2009  Gilles Daurat

&apos;This program is free software; you can redistribute it and/or
&apos;modify it under the terms of the GNU General Public License
&apos;as published by the Free Software Foundation; either version 2
&apos;of the License, or (at your option) any later version.

&apos;This program is distributed in the hope that it will be useful,
&apos;but WITHOUT ANY WARRANTY; without even the implied warranty of
&apos;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
&apos;GNU General Public License for more details.

&apos;You should have received a copy of the GNU General Public License
&apos;along with this program; if not, write to the Free Software
&apos;Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

Option Explicit

Dim oReseauForm as Object

Sub Main
	oReseauForm=LoadDialog(&quot;OOoGdmath&quot;, &quot;ReseauForm&quot;)
	ChangeTitreDialog(oReseauForm)
	oReseauForm.Model.Step = 1
&apos;	RestaureForm(oReseauForm)
	oReseauForm.Execute()
End Sub

Private Sub ReseauForm_CommandButton1()
Dim posx, posy, l1, l2, tm, ep, nx, ny
dim Shapes as Object

	oReseauForm.Model.Step = 2
	oReseauForm.Model.Label7.Label = &quot;0 %&quot;
    PointInsertion posx, posy
    InitialiseDessin(False)
    Shapes=InitialiseGroupe()
    
    l1 = oReseauForm.Model.TextField1.Text
    RemplaceVirgulePoint l1
    l1 = Val(l1) * 1000
    l2 = oReseauForm.Model.TextField2.Text
    RemplaceVirgulePoint l2
    l2 = Val(l2) * 1000
    tm = oReseauForm.Model.TextField3.Text
    RemplaceVirgulePoint tm
    If (tm = &quot;&quot;) Then
        tm = 500 
    Else
        tm = Val(tm)*1000
    End If
    ep = ExtraitEpaisseur(oReseauForm.Model.ImageControl1.HelpText)
    RemplaceVirgulePoint ep
    If (oReseauForm.Model.OptionButton2.State) Then
    	nx = Int(l1 / (tm * Cos(30 * Pi / 180))) + 1
	    ny = Int(l2 / (tm * Cos(30 * Pi / 180))) + 1
        ReseauTriangle posx, posy, nx, ny, oReseauForm.Model.CheckBox1.State, tm, val(ep), Shapes, oReseauForm.Model.ImageControl1
    End If
    If (oReseauForm.Model.OptionButton1.State) Then
	    nx = Int(l1 / tm) + 1
	    ny = Int(l2 / tm) + 1
        ReseauCarre posx, posy, nx, ny, oReseauForm.Model.CheckBox1.State, tm, val(ep), Shapes, oReseauForm.Model.ImageControl1
    End If
	Shapes=GroupeObjet(Shapes)
	DeplaceSelection(posx,posy,Shapes)
	TermineDessin()
    oReseauForm.EndExecute()
	sauveForm(oReseauForm)
End Sub

Private Sub ReseauForm_CommandButton2()
    oReseauForm.EndExecute()
End Sub

Private Sub ReseauForm_ImageControl1()
    ChangeCouleur oReseauForm.Model.ImageControl1
End Sub

Sub UnSeulPoint(x as long, y as long, epaisseur as double, ts As Object, uneImage as Object)
Dim uneForme as Object

	uneForme=InsereQuadrilatereB(x,y,x+epaisseur*10, y+epaisseur*10, ts, uneImage)
	uneForme.FillColor=uneImage.BackgroundColor
End Sub

Sub ReseauTriangle(px as long, py as long, lx as long, ly as long, ori as Boolean, maille as long, epaisseur as double, Shapes as object, uneImage as object)
Dim cs, tx, ty, j, i
Dim tot as long

    cs = maille * Sin(60 * Pi / 180)
    If (ori) Then
        ty = Int(ly * 3 / 2)
        tx = Int(lx * 2 / 3)
    Else
        tx = lx
        ty = ly
    End If
	tot = tx * ty
    For j = 0 To ty - 1
        For i = 0 To tx - 1
            If (ori) Then
                UnSeulPoint px + 2 * i * cs - cs * (Int(j / 2) * 2 = j), py + j * maille / 2, epaisseur, Shapes, uneImage
            Else
                UnSeulPoint px + maille * i - maille / 2 * (Int(j / 2) * 2 = j), py + j * maille * Sin(60 * Pi / 180), epaisseur, Shapes, uneImage
            End If
			oReseauForm.GetControl(&quot;ProgressBar1&quot;).Value = int(100*((j*tx+i+1)/tot))
			oReseauForm.Model.Label7.Label = trim(str(int(100*((j*tx+i+1)/tot)))) &amp; &quot; %&quot;
			oReseauForm.Model.Label7.Width = 114*(int(100*((j*tx+i+1)/tot)))/100
        Next i
    Next j
End Sub

Sub ReseauCarre(px as long, py as long, lx as long, ly as long, ori as boolean, maille as long, epaisseur as double, Shapes as Object, uneImage as Object)
Dim pas, tx, ty, j, i
Dim tot as long

    pas = 2 * maille * Cos(45 * Pi / 180)
    If (ori) Then
        ty = Int(ly * 4 / 3)
        tx = Int(lx * 3 / 4)
    Else
        tx = lx
        ty = ly
    End If
    tot = tx * ty 
    For j = 0 To ty - 1
        For i = 0 To tx - 1
            If (ori) Then
                UnSeulPoint px + i * pas - pas / 2 * (Int(j / 2) * 2 = j), py + j * pas / 2, epaisseur, Shapes, uneImage
            Else
                UnSeulPoint px + maille * i, py + maille * j, epaisseur, Shapes, uneImage
            End If
			oReseauForm.GetControl(&quot;ProgressBar1&quot;).Value = int(100*((j*tx+i+1)/tot))
			oReseauForm.Model.Label7.Label = trim(str(int(100*((j*tx+i+1)/tot)))) &amp; &quot; %&quot;
			oReseauForm.Model.Label7.Width = 114*(int(100*((j*tx+i+1)/tot)))/100
		Next i
    Next j
End Sub

</script:module>