'encoding UTF-8 Do not remove or change this line! global iSaveSetting as Integer sub main use "graphics\tools\id_tools.inc" GetOLEDefaultNames printlog "------------------------------- T h e m e s -----------------------------" call tSettingsToCM call tLoadAllGalleryGraphicFiles call tResetSettings end sub testcase tLoadAllGalleryGraphicFiles '/// Inserting all gallery graphics in a Writer document and checking the sizes. Dim lsFiles (3000) as String Dim lsGraphics (3000) as String Dim i as Integer, iCount as Integer Dim corLoad as Boolean dim x as boolean '/// Geting all installed gallery objects out of the installation in a list. if gNetzInst = TRUE then GetAllFileList ( ConvertPath ( gNetzOfficePath + "share\gallery\" ), "*.*", lsFiles () ) else GetAllFileList ( ConvertPath ( gOfficePath + "share\gallery\" ), "*.*", lsFiles () ) end if call GetOnlyGraphics ( lsFiles (), lsGraphics() ) iCount = ListCount ( lsGraphics() ) printlog "We have " + iCount + " graphics in the our gallery!" '///+ Open a new document call hNewDocument for i=1 to iCount corLoad = FALSE try '/// Loop begin '///+ Inserting all gallery files and checking the sizes '///+- Iinsert / graphic / from file '///+- Check the size in 'format / graphics' on the Type tabpage '///+-- The size should noz be smaler than 17*25cm / photos 21*25cm '///+ Deleting the graphic with <delete> of the keyboard '/// Loop ends x = LoadGraphic ( lsGraphics(i), corLoad ) printlog catch ExceptLog if corLoad = FALSE then warnlog "Problems with " + lsGraphics(i) ResetApplication call hNewDocument end if endcatch if (not x) then printlog "" + i endif next i ' Kontext "Gallery" ' ' IF Gallery.Exists(2) THEN ToolsGallery sleep (2) ' END IF call hCloseDocument '/// Close the document endcase '------------------------------------------------------------------------- sub LoadGraphic ( sFile as String, bOK as Boolean ) as boolean Dim iW, iWMax, iH, iHMax call hGrafikEinfuegen ( sFile ) FormatGraphics Kontext Active.SetPage TabType Kontext "TabType" OriginalSize.Click iW = Val ( makeNumOutOfText ( Width.GetText ) ) iH = Val ( makeNumOutOfText ( Height.GetText ) if instr ( sFile, "photo" ) <> 0 then iWMax = 22 iHMax = 25 else iWMax = 17 iHMax = 25 end if if iW > iWMax OR iH > iHMax then printlog sFile + " :" warnlog "Size is too big ( max should be '" + iWMax + "' cm* '" + iHMax + "'cm DinA4 with default borders ), but it is '" + iW + "' * '" + iH + "'" LoadGraphic = false end if TabType.OK sleep (1) Kontext "DocumentWriter" DocumentWriter.TypeKeys "" sleep (1) bOK = TRUE end sub '------------------------------------------------------------------------- sub GetOnlyGraphics ( OldList() as String, NewList() as String ) Dim i as Integer Dim sExtension as String ListAllDelete ( NewList() ) for i=1 to ListCount ( OldList() ) sExtension = lcase ( Right ( OldList(i), 3 ) ) if sExtension = "jpg" OR sExtension = "gif" OR sExtension = "wmf" OR sExtension = "png" then ListAppend ( NewList(), OldList(i) ) end if next i end sub '------------------------------------------------------------------------- function makeNumOutOfText ( sNum as String ) as String Dim sDummy as String Dim iComma as Integer iComma = Instr ( sNum, "," ) if iComma <> 0 then sDummy = Left ( sNum, iComma-1 ) + "." + Mid ( sNum, iComma+1, len ( sNum )-2 ) else sDummy = Left ( sNum, len (sNum)-2 ) end if makeNumOutOfText = sDummy end function '------------------------------------------------------------------------- sub tSettingsToCM '///Setting the measurement unit for textdocuments to cm. '///+Tools / options / text documents / general ToolsOptions hToolsOptions ( "Textdocument", "General" ) sleep 2 iSaveSetting = Masseinheit.GetSelIndex Masseinheit.Select 2 Kontext "ExtrasOptionenDlg" ExtrasOptionenDlg.OK end sub '------------------------------------------------------------------------- sub tResetSettings '///Resetting the measurement unit for textdocuments. '///+Tools / options / text documents / general ToolsOptions hToolsOptions ( "Textdocument", "General" ) Masseinheit.Select iSaveSetting Kontext "ExtrasOptionenDlg" ExtrasOptionenDlg.OK end sub '------------------------------------------------------------------------- sub LoadIncludeFiles use "global\system\inc\master.inc" use "global\system\inc\gvariabl.inc" gApplication = "Writer" Call GetUseFiles end sub