/* ============================================ */
/* Final Writer Arexx Macro - Mehrfach Einfügen */
/* This macro will duplicate any selected       */
/* graphic objects. (group or ungroup)          */
/* by Heiko Schröder (Age Ass)                  */
/* $VER: Mehrfach Einfügen 1.5 (08.04.97)       */
/* DocItemPrefs Abfrage                         */
/* ============================================ */
R='0A'X
Dre=0
Sei=0

Address='FinalW'
Options results

STATUS PORTNAME
FW = result
address = FW

SIGNAL ON BREAK_C
SIGNAL ON SYNTAX

'ShowMessage 2 0 "Mehrfach Einfügen V1.5 - 08.04.97" "    Neu: Das Shareware-Paket" "Info im Mehrfach-Einfügen-Guide" "(-:" "Ok" ":-)"'

GetDocItemPrefs Decimal
Punkt=Result
If Punkt="Comma" then DocItemPrefs Decimal Period

GraphicTool
nr=1
CurrentObject
ObjectId = Result
IF ObjectId=0 THEN do
   'ShowMessage 1 1 "Makro: Mehrfach Einfügen" "Kein Grafikobjekt ausgewählt..." "" "Okay" "" ""'
   Call BREAK_C
End

/*Kontrolle ob ein oder mehrere Objekte ausgewählt sind*/

Objekt.0=nr; Objekt.nr=ObjectID
FirstObject Selected
ID=result
Call Zaehlen
Do While 1
   NextObject ID Selected
   ID=result
   If ID=0 then Leave
   Call Zaehlen
End

If Objekt.0=1 then do
   gruppe=false
end
else gruppe=true

Do a=2 to Objekt.0
   SelectObject Objekt.a MULTIPLE
End
SelectObject Objekt.1 MULTIPLE
/*Ende der Kontrolle*/

STATUS View
Zoom=result

STATUS Pages
Seiten=result

STATUS Page
Seite=result

If Gruppe=true then Group

Copy
IF RC=0 THEN do
   CurrentObject
   ObjectID=result
   GetObjectCoords ObjectID
   Parse var result Seite x y w h
   wl=w
   hl=h
   GetObjectRotation ObjectID
   Dreh=result
   GetObjectType ObjectID
   Typ=result

   If Typ=2|Typ=3 then do
      If Seite~=1 then do
         'ShowMessage 1 1 "FW hat Probleme mit Linien außerhalb" "der Seite 1... " "" "Okay" "" ""'
         Call BREAK_C
      End
   End
   If Gruppe=true then Ungroup

   'ShowMessage 1 0 "Wie soll die Bildschirmausgabe erfolgen?" "" "" "Normal" "Speed" ""'
   ba=result

   IF ba=2 THEN DO
      status WINDOW
      parse VAR result links oben width height minwidth minheight maxwidth maxheight
      sizewindow minwidth minheight
   End

   Do While 1
      Result="ß"
      RequestText '"Mehrfach Einfügen" "Anzahl der Kopien" ""'
      Anzahl=Result
      If Anzahl="ß" then call Ende1
      If Anzahl=""|Anzahl=0 then call Ende
      If Datatype(Anzahl,'W')=1 then leave
            else call oops
   End

   Do while 1
      Result="ß"
      RequestText '"Mehrfach Einfügen" "Horizontale Verschiebung in cm" ""'
      Hor=Result
      If Hor="ß" then call Ende1
      If Hor="" then Hor=0
      If Datatype(Hor,'N')=1 then leave
            else call oops1
   End

   Do while 1
      Result="ß"
      RequestText '"Mehrfach Einfügen" "Vertikale Verschiebung in cm" ""'
      Ver=Result
      If Ver="ß" then call Ende1
      If Ver="" then Ver=0
      If Datatype(Ver,'N')=1 then leave
            else call oops1
   End

   If Typ~=2&Typ~=3 then do                     /*Linien*/
      Do while 1
         Result="ß"
         RequestText '"Mehrfach Einfügen" "Drehung in Grad" ""'
         Dre=Result
         If Dre="ß" then call Ende1
         If Dre="" then Dre=0
         If Datatype(Dre,'W')=1 then leave
            else call oops
      End

      Do While 1
         Result="ß"
         RequestText '"Mehrfach Einfügen" "Auf welche Seite? 0=dieselbe Seite" ""'
         Sei=Result
         If Sei="ß" then call Ende1
         If Sei=""|Sei=0 then Sei=Seite
         If Datatype(Sei,'W')=1 then leave
            else call oops
      End
   end

   s=Sei-Seiten

   Do a=1 to s
      InsertPageBreak
   End
      
   If ba=2 then View 20
   Do i=1 TO Anzahl
      Paste
      CurrentObject
      ObjectID=Result
      a=x+(Hor*i)
      b=y+(Ver*i)
      Winkel=Dreh+Dre*i
      If Typ=2|Typ=3 then do                     /*Linien*/
         w=wl+(Hor*i)
         h=hl+(Ver*i)
         Sei=Seite
      End
      SetObjectCoords ObjectID Sei a b w h    /*Probleme bei Linien*/
      SetObjectRotation ObjectID Winkel
      If Gruppe=true then Ungroup
   End
End
Redraw

Call WH

'ShowMessage 2 1 "Vielen Dank für die Benutzung." "© Heiko Schröder" "http://yi.com/home/SchroederHeiko" "@-`-" "Bitte" ":-))"'
Exit

ENDE:
   Call WH
   'ShowMessage 1 1 "Falsche Anzahl an Kopien..." "A B B R U C H" "" "Okay" "" ""'
   EXIT

ENDE1:
   Call WH
   'ShowMessage 1 1 "Sie haben abgebrochen..." "© Heiko Schröder" "http://yi.com/home/SchroederHeiko" "Okay" "" ""'
   EXIT

SYNTAX:
   Call WH
   'ShowMessage 1 1 "Es ist ein Fehler aufgetreten." "Nähere Info in Datei «Ram:Fehler«" "" "Was?" "Gibts nicht!" "Sofort melden"'
   address "REXX"
   Open("F","Ram:Fehler","W")
   writeln("F","ACHTUNG! FW_MEf V1.4 Makro-Fehler"||R)
   writeln("F",'Fehler in Zeile' SIGL ':' ERRORTEXT(RC)||R)
   writeln("F", 'Bitte informieren Sie den Autor unter s93324@fh-telekom-leipzig.de')
   Close("F")
EXIT

BREAK_C:
   Call WH
   'ShowMessage 1 1 "Makro-Abbruch..." "" "" "Ich weiß..." "" ""'
   EXIT

WH:
   If ba=2 then do
      GoToPage Sei
      View Zoom
      sizewindow width height
   End
   If Punkt="Comma" then DocItemPrefs DECIMAL Comma
Return

Zaehlen:
If ID~=Objekt.1 then do
   nr=nr+1
   Objekt.0=nr; Objekt.nr=ID
End
Return

oops:
'ShowMessage 1 1 "Falsche Eingabe!" "Bitte ganzzahlige Eingabe!" "" "Okay" "" ""'
return

oops1:
'ShowMessage 1 1 "Falsche Eingabe!" "Bitte numerische Eingabe mit (.) !" "" "Okay" "" ""'
return