Download it now!
Bug 106685 - Direct Colour Management extension doesn't work
Summary: Direct Colour Management extension doesn't work
Status: CLOSED DUPLICATE of bug 106529
Alias: None
Product: LibreOffice
Classification: Unclassified
Component: Extensions (show other bugs)
Version:
(earliest affected)
5.3.1.2 release
Hardware: All Linux (All)
: medium normal
Assignee: Not Assigned
URL:
Whiteboard:
Keywords:
Depends on:
Blocks:
 
Reported: 2017-03-21 21:00 UTC by Petr Valach
Modified: 2017-04-11 16:25 UTC (History)
3 users (show)

See Also:
Crash report or crash signature:


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Petr Valach 2017-03-21 21:00:20 UTC
I installed extension Direct Colour Management (http://extensions.libreoffice.org/extension-center/dcm-direct-colour-management). This extension worked perfectly in earlier version (see https://www.openoffice.cz/navody/odstranovani-duplicit-export-obrazku-a-prime-michani-barev). But now, in last version, doesn't work on Linux Mint and Windows 10. After starting you can see error dialog screen and screen with BASIC code; there is:




REM		+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
REM		Differentiation between LO and AOO is done via the variable product; so searching for this string will
REM		yield all occurrences of differences.
REM		+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

option explicit

public dlg as object, langNr as string, ratioX as single, ratioY as single
global copyPasteStore as long
public dcmRunning as boolean

' +++++++++++++++++++++++++  check whether DCM is already running  ++++++++++++++++++++++++
function checkRunning as boolean

if dcmRunning then

	msgbox (langtext(langNr,50),16,langtext(langNr,15))
	checkRunning = TRUE
  else
	dcmRunning = TRUE
	checkRunning = FALSE
end if

end function

' ==================== Start modules called from toolbars ================================

' -------------------- Shapes --------------------------------
Sub DCMShape

dim oDoc as object, oSel as object, selShapes as object
dim drawpage as object
dim i as integer, j as integer, colorType as string
dim prop as object, csgFound as boolean

oDoc = ThisComponent

initLangtextEtc()	'initialise the texts table and other values

if checkRunning then exit sub

if isEmpty(oDoc.CurrentController.Selection) then
  msgbox (langtext(langNr,39),48,langtext(langNr,15))	'please select some text
  exit sub
end if

oSel = oDoc.CurrentController.Selection		'this may be a (multiply) nested collection

if isNull(oSel) then	' if a fontwork is contained in the visible selection, this selection is null.
  drawpage = oDoc.drawpage
  for i = 0 to drawpage.count - 1
  csgFound = FALSE 
  prop = drawpage.getByIndex(i).getPropertySetInfo.Properties
  for j = 0 to uBound(prop)
    if prop(j).Name = "CustomShapeGeometry" then
      csgFound = TRUE
      exit for
    end if
  next
  if csgFound then
    for j = 0 to uBound(drawpage.getByIndex(i).CustomShapeGeometry)
      if drawpage.getByIndex(i).CustomShapeGeometry(j).Name = "Type" then
        if left(drawpage.getByIndex(i).CustomShapeGeometry(j).Value,9) = "fontwork-" then
          msgbox (langtext(langNr,45),48,langtext(langNr,15))
          exit sub
        end if
      end if
    next
  end if
  next
  msgbox (langtext(langNr,43),48,langtext(langNr,15))
  exit sub
end if

if not (oSel.ImplementationName = "com.sun.star.drawing.SvxShapeCollection") or oSel.count = 0 then
	msgbox (langtext(langNr,39),48,langtext(langNr,15))	'no shape object selected
	exit sub
end if
selShapes = createUnoService("com.sun.star.drawing.ShapeCollection")	'collection of selected shapes, for updating

colorType = objShape (oSel, selShapes)
select case colorType
  case "Fill"
    setShapeColor (selShapes, "FillColor")
  case "Line"
    setShapeColor (selShapes, "LineColor")
  case "Grad1"
    setShapeColor (selShapes, "FillGradient", "Start")
  case "Grad2"
    setShapeColor (selShapes, "FillGradient", "End")
  case "Hatch"
    setShapeColor (selShapes, "FillHatch")
  case "Shadow"
    setShapeColor (selShapes, "ShadowColor")
end select

'dcmRunning = FALSE

end sub

' -------------------- text: in a document, a frame --------------------------------
Sub DCMText

dim oDoc as object, oSel as object, undo as object, enum as object, enum2 as object, elem as object, elem2 as object
Dim elemColor as long
dim origColor as long, newColor as long, origColorMult as string, colorType as string, selCount as long
dim selstart as integer, i as integer, collapsed as boolean
dim table as object, range as string, cells as object	' for text tables

oDoc = ThisComponent
undo = oDoc.UndoManager

initLangtextEtc()	'initialise the texts table and other values

if checkRunning then exit sub

oSel = oDoc.CurrentSelection
if isNull(oSel) then
	msgbox (langtext(langNr,41),48,langtext(langNr,15))
	exit sub
end if
'	---------------------------   com.sun.star.text.TextRanges   --------------------------------------
if oSel.supportsService("com.sun.star.text.TextRanges") then
	selCount = oSel.count
	if selCount = 1 and oSel.getByIndex(0).Text.createTextCursorByRange(oSel.getByIndex(0)).isCollapsed then
		collapsed = TRUE
	  else
		collapsed = FALSE
	end if
	if selCount = 1 then	'one text range selected -> count = 1; more than one, say n -> count = n + 1,
	  						'  indexes starting with 1 contain the selected ranges
	    selStart = 0
	  else
    	selStart = 1
	end if
	if NOT isEmpty(oSel(selStart).cell) then	'if the text is within a table, then the cell colour shall also be selectable
		colorType = objTableText(collapsed)
	  else
		colorType = objText(collapsed)
	end if
	select case colorType
		case "none"
			exit sub
		case "BackColor"	'Cell back colour
			origColor = oSel(selStart).cell.BackColor	' get the colour of the first element
			for i = selStart + 1 to selCount - 1		' start the loop with the second selection element
				if oSel(i).cell.BackColor <> origColor then
					origColorMult = "Y"
					exit for
				end if
			next
		case = "ParaBackColor", "CharBackColor", "CharColor"
			if isEmpty(oSel(selStart).getPropertyValue(colorType)) then
				origColorMult = "Y"
				origColor = RGB(255, 255, 255)
			  else
				origColor = oSel(selStart).getPropertyValue(colorType)	' get the colour of the first element
				for i = selStart + 1 to selCount - 1		' start the loop with the second selection element
					if isEmpty(oSel(i).getPropertyValue(colorType)) or oSel(i).getPropertyValue(colorType) <> origColor then
						origColorMult = "Y"
						exit for
					end if
				next
			end if
		case else	' should not happen
			msgbox "unsupported colorType " & colorType & " in program DCMStart . DCMText"
			exit sub
	end select

	HSVDialog (origColor, newColor, origColorMult)
	if newColor = -111 then exit sub
	undo.enterUndoContext(langtext(langNr,19))	'group all changes into one undo action
	for i = selstart to selCount - 1
		if colorType = "BackColor" then
			oSel(i).cell.BackColor = newColor
		  else
			oSel(i).setPropertyValue(colorType, newColor)
			' in LO this does not work for ParaBackColor since at least release 4.4.6 due to a bug ( # 99125).
			' Selecting ParaBackColor is therefore deactivated for LO
		end if
	next
	undo.leaveUndoContext
'	---------------------------   com.sun.star.text.TextTableCursor   --------------------------------------
 elseif oSel.supportsService("com.sun.star.text.TextTableCursor") then
  table = oDoc.currentController.ViewCursor.TextTable
  origColorMult = "N"
  colorType = objTableText(FALSE)
  if colorType = "none" then exit sub
  if colorType = "BackColor" then
    origColor = table.getCellByName(oSel.RangeName).getPropertyValue(colorType)
	range = oSel.RangeName
	if Instr(range, ":") = 0 then	'only one cell; in this case getCellRangeByName returns an error message
    	cells = table.getCellByName(range)
	  else
    	cells = table.getCellRangeByName(range)
	end if
	if isEmpty(cells.BackColor) then origColorMult = "Y"
   else
	if isEmpty(oSel.getPropertyValue(colorType)) then	'if there are several colours used then the property is empty
		if colorType = "ParaBackColor" then
			origColor = table.getCellByName(oSel.RangeName).createEnumeration.nextElement.getPropertyValue(colorType)
	      else
			origColor = table.getCellByName(oSel.RangeName).createEnumeration.nextElement.createEnumeration.nextElement.getPropertyValue(colorType)
    	end if
    	origColorMult = "Y"
     else
      origColor = oSel.getPropertyValue(colorType)
    end if
  end if
  HSVDialog (origColor, newColor, origColorMult)
  if newColor = -111 then exit sub
  if colorType = "BackColor" then
	cells.setPropertyValue(colorType, newColor)
   else
    oSel.setPropertyValue(colorType, newColor)
  end if
 else
      msgUnsupp(oSel)
end if

end sub

' -------------------- text object = text in a shape, in Draw, Impress --------------------------------
sub DCMTextObject

dim oDoc as object, oSel as object, obj as object
dim origColor as long, newColor as long, origColorMult as string
dim enum as object, elem as object, enum2 as object, elem2 as object, s as string
dim document as object, dispatcher as object, args1(0) as new com.sun.star.beans.PropertyValue
dim selNormalisedStart as object, selNormalisedEnd as object

oDoc = ThisComponent

initLangtextEtc()	'initialise the texts table and other values

if checkRunning then exit sub

oSel = oDoc.CurrentSelection

if oSel.supportsService("com.sun.star.text.TextCursor") then	' text in Draw, Impress
  ' if the text is selected from right to left, then the start is at the right end of the text. This yelds
  '   different esults when comparing starts/ends of elements with starts/ends of the selection. Therefore start
  '   and end are vertauscht in this case.
  if oSel.compareRegionStarts(oSel.getStart,oSel.getEnd) = 1 then	' selection from left to right
	selNormalisedStart = oSel.getStart
	selNormalisedEnd = oSel.getEnd
   else									' = -1, selectiom from right to left; case 0 is handled beforehand
	selNormalisedStart = oSel.getEnd
	selNormalisedEnd = oSel.getStart
  end if
  enum = oSel.text.createEnumeration	' to find out if there is more than one colour
  origColorMult = " "
  do while enum.hasMoreElements
    elem = enum.nextElement
    enum2 = elem.createEnumeration
    do while enum2.hasMoreElements
      elem2 = enum2.nextElement
      if origColorMult = "N" and oSel.compareRegionStarts(selNormalisedEnd,elem2) >= 0 then exit Do
      	' text element starts at or after end of selection -> rest of text not relevant for this part of selection
      if origColorMult = "N" and oSel.compareRegionStarts(elem2,selNormalisedEnd) = 1 and _
          elem2.CharColor <> origColor then
      	' subsequent text element which contains part of selection and has different colour (there may be another
    	' reason for a new text element, e.g. another character weight)
        origColorMult = "Y"
        exit Do
      end if
      if origColorMult = " " and oSel.compareRegionStarts(selNormalisedStart,elem2.getEnd) = 1 then
      	' text element which contains start of selection
        origColor = elem2.CharColor
        origColorMult = "N"
      end if
    loop
    if origColorMult =  "Y" then exit Do
  loop
 elseif oSel.supportsService("com.sun.star.drawing.ShapeCollection") then	' text in Writer; also possible is 
 				'a combination of a table shape and another shape
  if oSel.count > 1 then	'e.g. combination of a table shape and another shape
    msgbox langtext(langNr,47),48,langtext(langNr,38)
    exit sub
  end if
  obj = oSel(0)
  if obj.supportsService("com.sun.star.drawing.Shape") then	'Cursor without extension in a shape
    msgbox langtext(langNr,41),48,langtext(langNr,38)
    exit sub
   elseif obj.supportsService("com.sun.star.presentation.Shape") then
    s = obj.ShapeType
    select case s
	  case "com.sun.star.drawing.TableShape"
	    tableShape(obj)
	    exit sub
	  case else
        msgUnsupp(obj)
        exit sub
	end select
   else
  end if
 else
  msgUnsupp(oSel)
  exit sub
end if

HSVDialog (origColor, newColor, origColorMult)

if newColor >= -1 then
' oSel.CharColor = newColor does not create an entry in the undo stack
'	We use the dispatcher instead:
   document   = ThisComponent.CurrentController.Frame
   dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
   args1(0).Name = "Color"
   args1(0).Value = newColor
   dispatcher.executeDispatch(document, ".uno:Color", "", 0, args1())
end if

end sub

' --------------------  text in a shape in Writer or Calc --------------------------------
sub DCMShapeText

dim oDoc as object, oSel as object, i as long, selStart as long
dim origColor as long, newColor as long, origColorMult as string
dim document as object, dispatcher as object, args1(0) as new com.sun.star.beans.PropertyValue
dim enum as object, elem as object, enum2 as object, elem2 as object, elemColor as long

oDoc = ThisComponent

initLangtextEtc()	'initialise the texts table and other values

if checkRunning then exit sub

oSel = oDoc.CurrentSelection

if oSel.supportsService("com.sun.star.drawing.ShapeCollection") then
    origColor = oSel.getByIndex(0).CharColor
    origColorMult = "N"
    origColor = -999999999
	for i = 0 to oSel.count - 1
   ' oSel.count > 1 can happen if one has selected the text of a shape and then selects another shape
   '  while pressing Ctrl. This is probably not meant to be a correct behaviour; it is only possible in Writer.
   '  Selecting the texts of more than one shape doesn't seem possible for the moment but the code will probably
   '  work correctly in this case.
	    if NOT hasCharColor(oSel.getByIndex(i)) then
	        msgbox langtext(langNr,47),48,langtext(langNr,38)
	        exit sub
	    end if
		enum = oSel(i).createEnumeration
		do while enum.hasMoreElements
		 	elem = enum.nextElement
		 	enum2 = elem.createEnumeration
		 	do while enum2.hasMoreElements
			 	elem2 = enum2.nextElement
			 	elemColor = elem2.CharColor
				if elemColor <> origColor then
					if origColor = -999999999 then	'initial value
						origcolor = elemColor
					  else
						' In this case the selection supplies only the shape with its entire text;
						' the view cursor has an empty text. So we cannot recognize the colour of
						' the selected text if there is more than one colour present.
						origColorMult = " "
						origcolor = RGB(255, 255, 255)
						exit do
					end if
				end if
			loop
		loop
	next
 else
  msgUnsupp(oSel)
  exit sub
end if

HSVDialog (origColor, newColor, origColorMult)

if newColor >= -1 then

'	In this case the selection supplies only the shape with its entire text; the view cursor has an empty text.
'	Therefore the only way was to use the dispatcher:
   document   = ThisComponent.CurrentController.Frame
   dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
   args1(0).Name = "Color"
   args1(0).Value = newColor
   dispatcher.executeDispatch(document, ".uno:Color", "", 0, args1())
end if

end sub

' --------------  text frame  -----------------------
sub DCMFrame

dim oDoc as object, oSel as object
dim origColor as long, newColor as long, origColorMult as string
dim dlgLib as object, dlgFrame as object
dim ctrl as object
dim imageFolder as string
dim choice as integer
dim stru as variant

oDoc = ThisComponent

initLangtextEtc()	'initialise the texts table and other values

if checkRunning then exit sub

oSel = oDoc.CurrentController.Selection
if isNull(oSel) then
	msgbox (langtext(langNr,41),48,langtext(langNr,15))
	exit sub
end if

DialogLibraries.LoadLibrary("DirectColourManager")
dlgLib = DialogLibraries.GetByName("DirectColourManager")
dlgFrame = createUnoDialog(dlgLib.getByName("DlgFrame")
imageFolder = getimageFolder()

dlgFrame.Title = langtext(langNr,20)
ctrl = dlgFrame.getControl("bBack")
ctrl.label = " " & langtext(langNr,27)
ctrl.model.ImageURL = imageFolder & "DCMParBack.png"
ctrl = dlgFrame.getControl("bBorder")
ctrl.label = " " & langtext(langNr,25)
ctrl.model.ImageURL = imageFolder & "DCMLineColor.png"
ctrl = dlgFrame.getControl("bShadow")
ctrl.label = " " & langtext(langNr,26)
ctrl.model.ImageURL = imageFolder & "DCMShadowColor.png"
ctrl = dlgFrame.getControl("bKO").model
ctrl.label = " " & langtext(langNr,13)
ctrl.ImageURL = imageFolder & "SignKO.png"

choice = dlgFrame.execute
select case choice
  case 0	'button KO
    exit sub
' return codes from sub ColorPropSel
  case 1041
    origColor = oSel.BackColor
  case 1042
    origColor = oSel.LeftBorder.Color
  case 1043
    origColor = oSel.ShadowFormat.Color
  case else	' cannot happen
    exit sub
end select

origColorMult = "N"
HSVDialog (origColor, newColor, origColorMult)
if newColor >= -1 then
  if oDoc.wasModifiedSinceLastSave then
	if  msgbox (langtext(langNr,40), 4 + 32, langtext(langNr,38)) = 6 then oDoc.store
   																'com.sun.star.awt.MessageBoxResults.YES ( = 1 ) is  N O T  the right value!!!
  end if
  select case choice
' return codes from sub ColorPropSel
    case 1041
      oSel.setPropertyValue("BackColor", newColor)
    case 1042
      stru = oSel.TopBorder
      stru.Color = newColor
      oSel.TopBorder = stru
      stru = oSel.BottomBorder
      stru.Color = newColor
      oSel.BottomBorder = stru
      stru = oSel.LeftBorder
      stru.Color = newColor
      oSel.LeftBorder = stru
      stru = oSel.RightBorder
      stru.Color = newColor
      oSel.RightBorder = stru
    case 1043
      stru = oSel.ShadowFormat
      stru.Color = newColor
      if stru.location = 0 then stru.location = 4	' no shadow --> to the right and below
      oSel.ShadowFormat = stru
  end select
end if

end sub

' ----------------------  cell or cell range in Calc  -----------------------------
sub DCMCell

dim oDoc as object, oSel as object, undo as object
dim origColor as long, newColor as long, origColorMult as string, colorType as string
dim i as long, selUpper as long, s as string
dim enum as object, elem as object, enum2 as object, elem2 as object

oDoc = ThisComponent

initLangtextEtc()	'initialise the texts table and other values

if checkRunning then exit sub

oSel = oDoc.currentSelection

'	if there are two paragraphs or text portions with different colours, then setting CharColor
'	changes only the first text portion. Therefore the option for CharColor is disabled in this case.
colorType = objCell
if colorType = "none" then exit sub
origColorMult = " "

if oSel.supportsService("com.sun.star.sheet.SheetCellRanges") then	' mind the plural !!
  for i = 0 to oSel.Count - 1
    analyseCellSel(oSel(i), colorType, origColor, origColorMult)
    if origColorMult = "Y" then exit for
  next
 elseif oSel.supportsService("com.sun.star.sheet.SheetCellRange") _
     or  oSel.supportsService("com.sun.star.sheet.SheetCell") then
  analyseCellSel(oSel, colorType, origColor, origColorMult)
 else
  msgUnsupp(oSel)
end if

HSVDialog (origColor, newColor, origColorMult)
if newColor = -111 then exit sub
if colortype = "CharColor" then
	if oSel.supportsService("com.sun.star.sheet.SheetCellRanges") then	' mind the plural !!
			selUpper = oSel.count - 1	' count exists only in this case
	  else
		selUpper = 0
	end if
	undo = oDoc.UndoManager
	undo.enterUndoContext(langtext(langNr,19))	'group all changes into one undo action
	for i = 0 to selUpper
		if oSel(i).supportsService("com.sun.star.sheet.SheetCell") then	'single cell
			DCMCellset (oSel(i).createEnumeration, newColor)
		  else					'rectangle of selected cells
			DCMCellset(oSel(i).CellFormatRanges.createEnumeration, newColor)
		end if
	next
	oSel.setPropertyValue(colorType, newColor)
	undo.leaveUndoContext
  else
	oSel.setPropertyValue(colorType, newColor)
end if

end sub

sub DCMCellSet (enum as object, newColor as long)

dim elem as object, enum2 as object, elem2 as object, enum3 as object, elem3 as object, s as string

do while enum.hasMoreElements
 	elem = enum.nextElement
	s = elem.dbg_methods
	if Instr(s,"createEnumeration") > 0 then	'then there's another enumeration level
	 	enum2 = elem.createEnumeration
 		do while enum2.hasMoreElements
 			elem2 = enum2.nextElement
			s = elem2.dbg_methods
			if Instr(s,"createEnumeration") > 0 then	'then there's another enumeration level
				enum3 = elem2.createEnumeration
				do while enum3.hasMoreElements
					elem3 = enum3.nextElement
					elem3.CharColor = newColor
				loop
			  else
				elem2.CharColor = newColor
			end if
		loop
	  else
		elem.CharColor = newColor
	end if
loop

end sub

'  ============================   start modules called from menus  ===============================================
'   It is not possible to enter dedicated menu items for the different object types, in all cases. There is
'    therefore only one menu item, and the dedicated modules are called from there.

'  -------------------------  called from menu "Format" in Writer  ------------------------------------------
sub menuWriter

dim oDoc as object, oSel as object

oDoc = ThisComponent
oSel = oDoc.CurrentController.Selection

if oSel.supportsService("com.sun.star.text.TextRanges") then
  ' if nothing is selected, then the selection is a collapsed string. In the context of this module it is not clear
  ' which objects shall be selected, so there has to be a message different from the one supplied by the same
  ' question in DCMText
  if oSel.Count = 1 and oSel.getByIndex(0).Text.createTextCursorByRange(oSel.getByIndex(0)).isCollapsed then
	initLangtextEtc()	'initialise the texts table and other values
	msgbox langtext(langNr,42),48,langtext(langNr,38)
	exit sub
  end if
  DCMText()    
 elseif oSel.supportsService("com.sun.star.text.TextTableCursor")then
  DCMText()    
 elseif oSel.supportsService("com.sun.star.text.TextFrame") then
  DCMFrame()
 elseif oSel.supportsService("com.sun.star.drawing.ShapeCollection") then
  callDlgMenuShape
  exit sub
 else
  initLangtextEtc()	'initialise the texts table and other values
  msgUnsupp(oSel)
end if

end sub

sub callDlgMenuShape 

dim dlgLib as object, dlgMenuShape as object, ctrl as object

initLangtextEtc()	'initialise the texts table and other values
if checkRunning then exit sub

DialogLibraries.LoadLibrary("DirectColourManager")
dlgLib = DialogLibraries.GetByName("DirectColourManager")
dlgMenuShape = createUnoDialog(dlgLib.getByName("DlgMenuShape")
dlgMenuShape.Title = langtext(langNr,35)
dlgMenuShape.getControl("bShape").label = langtext(langNr,36)
dlgMenuShape.getControl("bText").model.label = langtext(langNr,37)
ctrl = dlgMenuShape.getControl("bKO").model
ctrl.label = " " & langtext(langNr,13)
ctrl.ImageURL = imageFolder & "SignKO.png"

dlgMenuShape.execute
' buttons bShape and bText are handled in the subs below
dlgMenuShape.dispose

end sub

sub menuShapeShape (evt as object)

  DCMShape()
  evt.source.context.endExecute()
  
end sub

sub menuShapeText (evt as object)

  DCMShapeText()
  evt.source.context.endExecute()

end sub

'  -------------------------  called from menu "Format" in Draw & Impress  ------------------------------------
sub menuDraw

dim oDoc as object, oSel as object

oDoc = ThisComponent
oSel = oDoc.CurrentController.Selection

if oSel.supportsService ("com.sun.star.text.TextCursor") then
  DCMTextObject()
 else
  DCMShape()
endif

end sub

'  -------------------------  called from menu "Format" in Calc  ------------------------------------
sub menuCalc

dim oDoc as object, oSel as object

oDoc = ThisComponent
oSel = oDoc.CurrentController.Selection

if oSel.supportsService ("com.sun.star.drawing.ShapeCollection") then
  callDlgMenuShape()
 else
  DCMCell()
endif

end sub

' ===================  auxiliary modules  ====================================

' -------------   analyse colours used in cells  ----------------------
sub analyseCellSel (obj as object, colorType as string, origColor as long, origColorMult as string)
dim cellFormat as object, i as integer

cellFormat = obj.getCellFormatRanges

if origColorMult = " " then
  origColorMult = "N"
  origColor = cellFormat(0).getPropertyValue(colorType)
end if

for i = 0 to cellFormat.Count - 1
  if cellFormat(i).getPropertyValue(colorType) <> origColor then
    origColorMult = "Y"
    exit for
  end if
next

end sub

'  ---------------------- set shape color  -------------------------------
sub setShapeColor (selShapes as object, colorType as string, optional subType as string)

dim oDoc as object
dim prop as variant, selShape as object, prop2 as variant, prop3 as variant
dim origColor as long, newColor as long, origColorMult as string
dim i as integer

oDoc = ThisComponent
origColorMult = " "

for i = 0 to selShapes.count - 1
  if origColorMult = "Y" then exit for
  selShape = selShapes.getByIndex(i)
  prop = selShape.GetPropertyValue(colorType)
  if selShape.supportsService("com.sun.star.drawing.RectangleShape") or _
     selShape.supportsService("com.sun.star.drawing.EllipseShape") or _
     selShape.supportsService("com.sun.star.drawing.OLE2Shape") or _
     selShape.supportsService("com.sun.star.drawing.TextShape") or _
     selShape.supportsService("com.sun.star.drawing.CustomShape") then
    if origColorMult = " " then
      origColorMult = "N"
      select case colorType
        case "FillGradient"
          if subType = "Start" then
            origColor = prop.StartColor
           elseif subType = "End" then
            origColor = prop.EndColor
          end if
        case "FillHatch"
          origColor = prop.Color
        case else
          origColor = prop
      end select
     else
      select case colorType
        case "FillGradient"
          if subType = "Start" and origColor <> prop.StartColor then
            origColorMult = "Y"
           elseif subType = "End" and origColor <> prop.EndColor then
            origColorMult = "Y"
          end if
        case "FillHatch"
         if origColor <> prop.Color then origColorMult = "Y"
        case else
          if origColor <> prop then origColorMult = "Y"
      end select
    end if
   else
    if origColorMult = " " then
      origColorMult = "N"
      origColor = prop
     else
      if origColor <> prop then origColorMult = "Y"
    end if
  end if
next

HSVDialog (origColor, newColor, origColorMult)

if newColor >= -1 then
  if oDoc.wasModifiedSinceLastSave then
	if  msgbox (langtext(langNr,40), 4 + 32, langtext(langNr,38)) = 6 then oDoc.store
   																'com.sun.star.awt.MessageBoxResults.YES is  N O T  the right value!!!
  end if
  for i = 0 to selShapes.count - 1
    selShape = selShapes.getByIndex(i)
    prop2 = selShape.GetPropertyValue(colorType)
    if selShape.supportsService("com.sun.star.drawing.RectangleShape") or _
       selShape.supportsService("com.sun.star.drawing.EllipseShape") or _
       selShape.supportsService("com.sun.star.drawing.OLE2Shape") or _
       selShape.supportsService("com.sun.star.drawing.TextShape") or _
       selShape.supportsService("com.sun.star.drawing.CustomShape") then
      select case colorType
        case "FillGradient"
          if subType = "Start" then
            prop2.StartColor = newColor
           elseif subType = "End" then
            prop2.EndColor = newColor
          end if
          prop3 = prop2
          selShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
        case "FillHatch"
          prop2.Color = newColor
          prop3 = prop2
          selShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
        case "FillColor"
          prop3 = newColor
          selShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
        case "ShadowColor"
          selShape.Shadow = TRUE
          prop3 = newColor
        case "LineColor"
          prop3 = newColor
          selShape.LineStyle = com.sun.star.drawing.LineStyle.SOLID
        case else
          prop3 = newColor
      end select
     else
      prop3 = newColor
    end if
    selShape.setPropertyValue(colorType, prop3)
  next
  selShapes.dispose
  oDoc.setModified(TRUE)
end if

end sub

'  ------------------------  table shape (in Impress, Draw)   -----------------------------------------------
'	 The selection returns the entire shape, so there was no way to format one or several cells, this has to be done
'	 using the standard tools. The actions below change the table template, i.e. all table shapes in the document
sub tableShape (obj as object)

dim dlglib as object, dlgTS as object, elemt as string, templ as object
dim origColor as long, newColor as long, origColorMult as string
dim imageFolder as string, ctrl as object

if not ( obj.UseFirstRowStyle and obj.UseBandingRowStyle) then
  msgbox langtext(langNr,44),48,langtext(langNr,38)
  exit sub
end if
templ = obj.tableTemplate
if not ( templ.hasByName("first-row") and templ.hasByName("odd-rows") and templ.hasByName("body") ) then
  msgbox langtext(langNr,44),48,langtext(langNr,38)
  exit sub
end if
if isNull (templ.getByName("first-row")) or isNull (templ.getByName("odd-rows")) or isNull (templ.getByName("body")) then
  msgbox langtext(langNr,52),48,langtext(langNr,38)
  exit sub
end if

DialogLibraries.LoadLibrary("DirectColourManager")
dlgLib = DialogLibraries.GetByName("DirectColourManager")
dlgTS = createUnoDialog(dlgLib.getByName("DlgTableShape")
imageFolder = getimageFolder()

dlgTS.Title = langtext(langNr,20)
dlgTS.getControl("info").text = langtext(langNr,46)
ctrl = dlgTS.getControl("bFirstRow")
ctrl.label = " " & langtext(langNr,32)
ctrl.model.ImageURL = imageFolder & "DCMTableFirstColor.png"
ctrl = dlgTS.getControl("bOddRows")
ctrl.label = " " & langtext(langNr,33)
ctrl.model.ImageURL = imageFolder & "DCMTableOddColor.png"
ctrl = dlgTS.getControl("bEvenRows")
ctrl.label = " " & langtext(langNr,34)
ctrl.model.ImageURL = imageFolder & "DCMTableEvenColor.png"
ctrl = dlgTS.getControl("bKO").model
ctrl.label = " " & langtext(langNr,13)
ctrl.ImageURL = imageFolder & "SignKO.png"

select case dlgTS.execute
  case 0	'button KO
    exit sub
' return codes from sub ColorPropSel
  case 1031
    elemt = "first-row"
  case 1032
    elemt = "odd-rows"
  case 1033
    elemt = "body"
  case else	' cannot happen
    exit sub
end select

origColor = templ.getByName(elemt).FillColor

origColorMult = "N"
HSVDialog (origColor, newColor, origColorMult)
if newColor = -111 then exit sub
if ThisComponent.wasModifiedSinceLastSave then
	if  msgbox (langtext(langNr,40), 4 + 32, langtext(langNr,38)) = 6 then ThisComponent.store
   																'com.sun.star.awt.MessageBoxResults.YES is  N O T  the right value!!!
end if
templ.getByName(elemt).FillColor = newColor

end sub
Comment 1 Xisco Faulí 2017-03-22 09:35:50 UTC
it seems like a duplicate of bug 106529. Closing as RESOLVED DUPLICATED.
Thanks for reporting.

*** This bug has been marked as a duplicate of bug 106529 ***
Comment 2 Mike Kaganski 2017-03-22 09:56:44 UTC
You may want to notify the author (gerhard.weydt@t-online.de) about that.
Comment 3 Gerhard Weydt 2017-03-23 15:44:45 UTC
I have added a new release 1.1.3 to DCM on the extensions site. It worked fine on release 5.3.1.2 of LibO.
It is not yet displayed as the current release, and I am waiting for someone to help with this issue, but you will find it at the bottom of the list of releases whence you can download it.
Comment 4 Mike Kaganski 2017-03-24 06:22:55 UTC
(In reply to Gerhard Weydt from comment #3)
> I have added a new release 1.1.3 to DCM on the extensions site. It worked
> fine on release 5.3.1.2 of LibO.

Thank you! That's great news.

> It is not yet displayed as the current release, and I am waiting for someone
> to help with this issue, but you will find it at the bottom of the list of
> releases whence you can download it.

I suppose you should file a bug report about it here; please CC Andreas Mantke who is the expert in the Extensions site infrastructure (I CC him also to this bug).
Comment 5 Mike Kaganski 2017-03-24 08:23:24 UTC
I see that TextMath (https://extensions.libreoffice.org/extensions/texmaths-1) managed to make their fix (released a day ago to address the same issue) to be current.
Comment 6 Gerhard Weydt 2017-04-11 16:25:51 UTC
The problem of the new version not being visible as latest reffered to in comment 3 has been solved. So this bug can be regarded as finally closed.

Gerhard