shape pattern in corel draw vba - vba

I want to make a patern of shapes based on the document size in corel draw. right now I have the four corners taken care of (dot1 to dot4). But, when my document size is bigger than 96" I need to put more than dots 1 to 4 so I've added the if statement but it' not quite what I want.
`
ActivePage.CreateLayer ("CCD")
Dim DOT1 As Shape
Set DOT1 = ActivePage.ActiveLayer.CreateEllipse2(0.225, 0.225, 0.125, 0.125)
DOT1.Fill.UniformColor.RGBAssign 0, 255, 255
DOT1.Outline.SetNoOutline
DOT1.Name = "DOT1"
Dim DOT2 As Shape
Set DOT2 = ActivePage.ActiveLayer.CreateEllipse2(DOCUMENTSIZEX - 0.225, 0.225, 0.125, 0.125)
DOT2.Fill.UniformColor.RGBAssign 0, 255, 255
DOT2.Outline.SetNoOutline
DOT2.Name = "DOT2"
Dim DOT3 As Shape
Set DOT3 = ActivePage.ActiveLayer.CreateEllipse2(0.225, DOCUMENTSIZEY - 0.225, 0.125, 0.125)
DOT3.Fill.UniformColor.RGBAssign 0, 255, 255
DOT3.Outline.SetNoOutline
DOT3.Name = "DOT3"
Dim DOT4 As Shape
Set DOT4 = ActivePage.ActiveLayer.CreateEllipse2(DOCUMENTSIZEX - 0.225, DOCUMENTSIZEY - 0.225, 0.125, 0.125)
DOT4.Fill.UniformColor.RGBAssign 0, 255, 255
DOT4.Outline.SetNoOutline
DOT4.Name = "DOT4"
'check the size of the document, if bigger than 96 inches it will add 2 more dots
If DOCUMENTSIZEX > 96 Then
Dim DOT5 As Shape
Set DOT5 = ActivePage.ActiveLayer.CreateEllipse2(DOCUMENTSIZEX / 2, DOCUMENTSIZEY - 0.225, 0.125, 0.125)
DOT5.Fill.UniformColor.RGBAssign 0, 255, 255
DOT5.Outline.SetNoOutline
DOT5.Name = "DOT5"
Dim DOT6 As Shape
Set DOT6 = ActivePage.ActiveLayer.CreateEllipse2(DOCUMENTSIZEX / 2, 0.225, 0.125, 0.125)
DOT6.Fill.UniformColor.RGBAssign 0, 255, 255
DOT6.Outline.SetNoOutline
DOT6.Name = "DOT6"
End If
`
I've tried the duplicate function "set dot7=dot5.duplicate" type thing which is only doing it once and I'd like to have it make a variable about of dots (only and only if the document is over 96" by multiple of 48). ie: if the document is 144" there would be one every 48"
I've added a portion of the code bellow and I'm mostly looking for a hint at what function I should look at in order to play arround with it and learn it.
thanks

Related

How to draw and format a line?

I am trying to draw a line in a PowerPoint presentation. I cannot get the desired combinations of colour, weight, zorder and to name it.
I have two ways to draw a line.
The first:
Set oLine = MyDocument.Shapes.AddLine(MyShape.Left + MyShape.Width, MyShape.Top + (MyShape.Height * 0.5) - 5, MyDocument.Shapes(lineName).Left, MyDocument.Shapes(lineName).Top + (0.5 * MyDocument.Shapes(lineName).Height)).Line
With oLine
.ZOrder (msoSendToBack)
.Line.Weight = 7
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Name = "Line"
End With
With this only the zorder works. The colour of the line is a shade of blue (which I believe was used earlier in the PowerPoint).
The second:
With MyDocument.Shapes.AddLine(MyShape.Left + MyShape.Width, MyShape.Top + (MyShape.Height * 0.5), MyDocument.Shapes(lineName).Left, MyDocument.Shapes(lineName).Top + (0.5 * MyDocument.Shapes(lineName).Height)).Line
.ForeColor.RGB = RGB(0, 0, 0)
.Weight = 5
End With
This gives the desired colour and weight, but I cannot find a way to zorder the shape nor name it.
How can I achieve all of my desired combinations?
Lines don't use a fill, only 2D shapes.
It's easier to find errors if you break long commands (like the one starting with Set oLine) into smaller chunks until you get it working. You omitted information about the MyShape from which you're getting positions, but here is a revised version of your code that runs:
Sub FormatLine()
Dim oLine As Shape
Set oLine = ActivePresentation.Slides(1).Shapes.AddLine(BeginX:=10, BeginY:=10, EndX:=40, EndY:=40)
With oLine
.ZOrder (msoSendToBack)
.Line.Weight = 7
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Name = "Line3"
End With
End Sub

SSRS Color Gradient

I've been able to figure out how to make certain values the certain colors I would like. However, I'd really like to be able to create a color gradient so that it's more of a gradual change between each value.
0 = white
from white to green between 1 and 15,
gradient from green to yellow between 16 and 25,
and gradient from yellow to red between 26 and 35,
anything above 35 is red.
This is the code I have in the background fill expression:
=SWITCH(
(Sum(Fields!Total_Transaction_Count.Value) / CountDistinct(Fields!TransUserNumber.Value)) = 0, "White",
((Sum(Fields!Total_Transaction_Count.Value) / CountDistinct(Fields!TransUserNumber.Value)) >= 1 and
(Sum(Fields!Total_Transaction_Count.Value) / CountDistinct(Fields!TransUserNumber.Value)) <= 15), "Green",
((Sum(Fields!Total_Transaction_Count.Value) / CountDistinct(Fields!TransUserNumber.Value)) >= 16 and
(Sum(Fields!Total_Transaction_Count.Value) / CountDistinct(Fields!TransUserNumber.Value)) <= 25), "Yellow",
((Sum(Fields!Total_Transaction_Count.Value) / CountDistinct(Fields!TransUserNumber.Value)) >= 26 and
(Sum(Fields!Total_Transaction_Count.Value) / CountDistinct(Fields!TransUserNumber.Value))) <= 35, "Orange",
(Sum(Fields!Total_Transaction_Count.Value) / CountDistinct(Fields!TransUserNumber.Value)) > 35, "Red")
This is the matrix I have so far
Take a look at this answer I wrote a while back. It's for a chart but the principle should be the same.
the basic idea is to calculate the colour in SQL and then use that to set the color properties in SSRS
Applying Custom Gradient to Chart Based on Count of Value
Keeping it all in SSRS
If you want to keep this within the report you could write a function to do the calculation.
For a very simple red gradient, it might look something like this..
Public Function CalcRGB (minVal as double, maxVal as double, actualVal as double) as String
Dim RedValue as integer
Dim GreenValue as integer
Dim BlueValue as integer
RedValue = ((actualVal - minVal) / (maxVal - minVal)) * 256
GreenValue = 0
BlueValue = 0
dim result as string
result = "#" & RedValue.ToString("X2") & greenValue.ToString("X2") & BlueValue.ToString("X2")
Return result
End Function
In this function I have set green and blue to 0 but these could be calculated too based on requirements.
To use this function as a background colour, set the Background Color property to something like
=Code.CalcRGB(
MIN(Fields!myColumn.Value),
MAX(Fields!myColumn.Value),
Fields!myColumn.Value
)

VB.NET Draw on top of rectangle e.Graphics

I want to draw to my form using e.Graphics. So I've drawn a set of rectangles (for the chess tiles for the game I'm making) and now I want to draw the pieces on top of the already drawn (and working) rectangles. The chess pieces are transparent png's saved in my Resources folder. I have no problem drawing them normally, but whenever I want to draw them on top of the tiles, only the tiles are visible - regardless of which line of code goes first. How do I add the pieces on top of the tiles, so the tiles are underneath?
This is the problematic code:
If Not alreadydrawn Then
Dim g As Graphics = Graphics.FromImage(screenbuffer)
Checked = False
For y = 1 To 8
For x = 1 To 8
If Checked Then g.FillRectangle(Brushes.LightGray, (x * 85) - 40, (y * 85) - 40, 85, 85)
If Not Checked Then g.FillRectangle(Brushes.Black, (x * 85) - 40, (y * 85) - 40, 85, 85)
Checked = Not Checked
Next
Checked = Not Checked
Next
e.Graphics.DrawImage(My.Resources.Bishop_White, New Rectangle(New Point(50, 50), New Size(64, 64)))
alreadydrawn = True
End If
e.Graphics.DrawImageUnscaledAndClipped(screenbuffer, New Rectangle(New Point(0, 0), New Size(795, 805)))
This is the solution I made:
checked = False
For y = 1 To 8
For x = 1 To 8
If clickedsquare(0) = x - 1 And clickedsquare(1) = y - 1 And Not boardlayout(y - 1, x - 1) = 0 And clickmode = "options" Then
t.FillRectangle(New SolidBrush(Color.FromArgb(225, 212, 128)), x * 75, y * 75, 75, 75)
Else
If checked Then t.FillRectangle(New SolidBrush(Color.FromArgb(64, 64, 64)), x * 75, y * 75, 75, 75)
If Not checked Then t.FillRectangle(New SolidBrush(Color.FromArgb(224, 224, 224)), x * 75, y * 75, 75, 75)
End If
checked = Not checked
Next
checked = Not checked
Next
...
Then:
tiles.Image = tilebuffer
pieces.Image = piecebuffer
BackgroundImage = tiles.Image
pieces.BackColor = Color.Transparent
alreadydrawn = True

Spacing out 4 areas in a defined width

Hey all i am trying to add 4 boxes to an image that's 1280 x 720.
I am wanting to add the boxes to the top of the image but space them out evenly across the 1280 width.
Dim g As Graphics = Graphics.FromImage(image)
g.FillRectangle(New SolidBrush(Color.FromArgb(90, 255, 255, 255)), New Rectangle(3, 7, 270, 25)) 'The transparent square for Date
g.DrawString(Format(DateTime.Now, "MM/dd/yyyy HH:mm:ss tt"), New Font("Arial", 18), Brushes.Black, New PointF(3, 5)) 'The date
g.FillRectangle(New SolidBrush(Color.FromArgb(90, 255, 255, 255)), New Rectangle(350, 7, 170, 25)) 'The transparent square for Latitude
g.DrawString("Lat: " & "30.976154", New Font("Arial", 18), Brushes.Black, New PointF(352, 5))
g.FillRectangle(New SolidBrush(Color.FromArgb(90, 255, 255, 255)), New Rectangle(670, 7, 180, 25)) 'The transparent square for longitude
g.DrawString("Lng: " & "33.351328", New Font("Arial", 18), Brushes.Black, New PointF(672, 5))
g.FillRectangle(New SolidBrush(Color.FromArgb(90, 255, 255, 255)), New Rectangle(970, 7, 120, 25)) 'The transparent square for MPH
g.DrawString("MPH: " & "000", New Font("Arial", 18), Brushes.Black, New PointF(972, 5))
g.Dispose()
However i haven't found a sure fire way to making them even across the screen since each rectangle/text is a different width than the ones around it.
Any ideas, thoughts would be great!
Simply divide the width by the number of labels. Here's some pseudocode:
const int NUM_LABELS = 4;
int divWidth = width / NUM_LABELS;
int i;
for i = 0 to (NUM_LABELS - 1)
FillRect(i * divWidth, LABEL_HEIGHT, (i + 1) * divWidth, 0); // or whatever you want to do
MoveTo (i * divWidth, LABEL_HEIGHT);
DrawString("some string");

Shifting Byte Array

If have an array of Bytes in visual basic:
Dim data() As Byte = {0, 128, 0, 4, 9, 9, 32, 0, 0, 0, 0, 0, 0, 0, 0}
Is there a quick and easy way to insert two data values to the front of this array, and knock off the last two values?
Dim data() As Byte = {128, 128, 0, 128, 0, 4, 9, 9, 32, 0, 0, 0, 0, 0, 0}
Yes. First you need to move all of the existing values up 2 places in your array. Doing so will overwrite the last 2 values. You'll then want to set the first two values of your array.
'Move data up 2 spots. This needs to be done in reverse order so we don't lose any data
For i as Integer = data.Length - 1 To 2 Step -1
data(i) = data(i - 2)
End
'Assign the new values
data(0) = 128
data(1) = 128
You could load the bytes into a vb.net stack with a loop then use the stack.push then rewrite the data back