https://bugs.documentfoundation.org/show_bug.cgi?id=106685
Bug ID: 106685
Summary: Direct Colour Management extension doesn't work
Product: LibreOffice
Version: 5.3.1.2 release
Hardware: All
OS: Linux (All)
Status: UNCONFIRMED
Severity: normal
Priority: medium
Component: Extensions
Assignee: libreoffice-bugs@lists.freedesktop.org
Reporter: topaz3...@seznam.cz
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
--
You are receiving this mail because:
You are the assignee for the bug._______________________________________________
Libreoffice-bugs mailing list
Libreoffice-bugs@lists.freedesktop.org
https://lists.freedesktop.org/mailman/listinfo/libreoffice-bugs
