Basically I need to convert a bitmap image into a string but it is not a common one.
The dilemma is that this string is composed of two parts:
1) Points
2) Lines
I need to convert the image into two parts delimited by a *.
One example I have been given is:
"221A*221A270A270A2503250320072007171617160D2A0D2A07380738073F073F0B3E0B3E15311531222122212C182C183016301631173117311A311A302230222E272E272D2C2D2C2C2F2C2F2C312C312C2F2C2F2E2B2E2B3126312633223322371D371D381C381C3B1B3B1B3C1C3C1C3D1F3D1F3D243D243C2D3C2D3A333A333A363A36393939393B383B383D363D36412E412E46264626492049204B1B4B1B4E184E184F174F175017501751185118511D511D51225122502450244F294F294F2C4F2C4E2F4E2F4F314F315030503052305230552C552C582958295D225D22601E601E611C611C621B621B621A621A601A601A5D1B5D1B5B1E5B1E5723572353285328512B512B502E502E502F502F513151315231523154305430582E582E592D592D5C2C5C2C5F2A5F2A6428642865286528692669266D246D247122712275207520791D791D7D1B7D1B81198119841884188618861887198719881A881A891B891B881C881C871E871E861F861F852085208421842182228222812481247F257F257E257E257D257D257C247C247C217C217D1F7D1F7E1C7E1C801A801A81198119821782178317831784188418851A851A851C851C86208620862286228625862587278727872B872B882E882E893289328A338A338E348E349033903393329332972F972F9A2D9A2D9F299F29A426A426AB20AB20AF1CAF1CB517B517B716B716B716"
so all I know is that the 221A is the points and the other string is lines but need to be able to achieve that.
Have nay of you come across this before ?
I have tried converting the bitmap to Base64String but that doesn't give my anything near.
If it Helps I only have the reverse in VB i.e. from string to image:
Private Sub unpackBMP(ByVal BITMAP As String)
Dim points As String
Dim lines As String
Dim x As Long
Dim y As Long
Dim x1 As Long
Dim y1 As Long
points = firstItem(BITMAP, "*")
lines = BITMAP
While Len(points) > 0
x = "&H" & Mid(points, 1, 2)
y = "&H" & Mid(points, 3, 2)
points = Mid(points, 5, Len(points) - 4)
'picDraw.PSet (Val(x), Val(y)), vbBlack
'Call picDraw.DrawPoint(CDbl(x), CDbl(y))
'picDraw.Refresh
Wend
While Len(lines) > 0
x = "&H" & Mid(lines, 1, 2)
y = "&H" & Mid(lines, 3, 2)
x1 = "&H" & Mid(lines, 5, 2)
y1 = "&H" & Mid(lines, 7, 2)
lines = Mid(lines, 9, Len(lines) - 8)
'picDraw.Line (Val(x), Val(y))-(Val(x1), Val(y1)), vbBlack
'Call picDraw.DrawLine(CDbl(x), CDbl(y), CDbl(x1), CDbl(y1), 0)
'picDraw.Refresh
Wend
'Call picDraw.DrawLine(lines(1, tmp), lines(2, tmp), lines(3, tmp), lines(4, tmp), 0)
End Sub
Public Function firstItem(pstrItems As String, pstrDelim As String) As String
Dim lngPos As Long
Dim strRes As String
'Dim strDelim As String
strRes = ""
lngPos = InStr(pstrItems, pstrDelim)
If lngPos > 0 Then
strRes = Left$(pstrItems, lngPos - 1)
pstrItems = Mid$(pstrItems, lngPos + 1)
Else
strRes = pstrItems
pstrItems = ""
End If
firstItem = strRes
End Function
Let me know if you require any further details.
Background: This is a signature in a picture box on a windows mobile 6.5 device. Please see below for the image and its related string. Hopefully this helps.
String for SIGNATURE 280172:
3711*371127152715103510351F2C1F2C312231223C1C3C1C3D203D20352D352D333233323D2E3D2E52225222671A671A6C196C196D1A6D1A6D1D6D1D69226922652665266428642864296429652965296E236E23781E781E8718871891179117961896189A199A199B1B9B1B9D1E9D1E9F209F20A021A021A021
Adding the attachment stack makes it a png but it is a bmp file, however it is a 204 x 64 1 bit depth image.
Reordered string (by Spektre)
3711*3711
2715 2715
1035 1035
1F2C 1F2C
3122 3122
3C1C 3C1C
3D20 3D20
352D 352D
3332 3332
3D2E 3D2E
5222 5222
671A 671A
6C19 6C19
6D1A 6D1A
6D1D 6D1D
6922 6922
6526 6526
6428 6428
6429 6429
6529 6529
6E23 6E23
781E 781E
8718 8718
9117 9117
9618 9618
9A19 9A19
9B1B 9B1B
9D1E 9D1E
9F20 9F20
A021 A021 A021
Single horizontal line makes the following string:
101F*101F
1D21 1D21
2121 2121
2820 2820
2C20 2C20
3120 3120
3921 3921
3F21 3F21
4521 4521
4A21 4A21
5122 5122
5822 5822
6121 6121
6421 6421
6721 6721
6A20 6A20
6C20 6C20
6F20 6F20
7220 7220
7520 7520
7720 7720
7920 7920
7D20 7D20
8020 8020
8120 8120
8320 8320
861F 861F
871F 871F
891F 891F
8A1F 8A1F
8D1F 8D1F
8F1F 8F1F
931F 931F
961F 961F
971F 971F
9A1F 9A1F
9C1F 9C1F
9D1E 9D1E
A11E A11E
A31E A31E
A51D A51D
A71D A71D
A91D A91D
AA1C AA1C
AB1C AB1C
AD1C AD1C
AE1C AE1C
B01C B01C
B11B B11B
B21B B21B
B41B B41B
B51A B51A
B61A B61A
B81A B81A
B919 B919
BB19 BB19
BC19 BC19
BD19 BD19
BE19 BE19
BF19 BF19
C019 C019
C11A C11A
C31A C31A
C41A C41A
C51A C51A
C61B C61B
C71B C71B
C81C C81C
C81C
So this is what makes the PictureBox Signature to a string:
'signature
Public gSigPoints() As Long
Public gSigLines() As Long
Public gSigPointCount As Long
Public gSigLinesCount As Long
Public Function PackBMP() As String
Dim tmpStr1 As String
Dim tmpStr2 As String
Dim tmpStr3 As String
Dim tmpStr4 As String
Dim tmp As Long
gJob_Signature = ""
For tmp = 1 To gSigPointCount
tmpStr1 = CStr(Hex(gSigPoints(1, tmp)))
tmpStr2 = CStr(Hex(gSigPoints(2, tmp)))
If Len(tmpStr1) = 2 And Len(tmpStr2) = 2 Then
gJob_Signature = gJob_Signature & tmpStr1 & tmpStr2 '& ";" & ";"
Else
If Len(tmpStr1) = 1 Then tmpStr1 = "0" & tmpStr1
If Len(tmpStr2) = 1 Then tmpStr2 = "0" & tmpStr2
If Len(tmpStr1) = 2 And Len(tmpStr2) = 2 Then
gJob_Signature = gJob_Signature & tmpStr1 & tmpStr2 '& ";"& ";"
End If
End If
Next 'tmp
gJob_Signature = gJob_Signature & "*"
For tmp = 1 To gSigLinesCount
tmpStr1 = CStr(Hex(gSigLines(1, tmp)))
tmpStr2 = CStr(Hex(gSigLines(2, tmp)))
tmpStr3 = CStr(Hex(gSigLines(3, tmp)))
tmpStr4 = CStr(Hex(gSigLines(4, tmp)))
If Len(tmpStr1) = 2 And Len(tmpStr2) = 2 And Len(tmpStr3) = 2 And Len(tmpStr4) = 2 Then
gJob_Signature = gJob_Signature & tmpStr1 & tmpStr2 & tmpStr3 & tmpStr4 '& ";"
Else
If Len(tmpStr1) = 1 Then tmpStr1 = "0" & tmpStr1
If Len(tmpStr2) = 1 Then tmpStr2 = "0" & tmpStr2
If Len(tmpStr3) = 1 Then tmpStr3 = "0" & tmpStr3
If Len(tmpStr4) = 1 Then tmpStr4 = "0" & tmpStr4
If Len(tmpStr1) = 2 And Len(tmpStr2) = 2 And Len(tmpStr3) = 2 And Len(tmpStr4) = 2 Then
gJob_Signature = gJob_Signature & tmpStr1 & tmpStr2 & tmpStr3 & tmpStr4 '& ";"
End If
End If
Next 'tmp
End Function
Public Sub DrawBMP(ByRef pic As PictureBox)
Dim x As Long
pic.Cls
For x = 1 To gSigPointCount
Call pic.DrawPoint(gSigPoints(1, x), gSigPoints(2, x))
Next x
For x = 1 To gSigLinesCount
Call pic.DrawLine(gSigLines(1, x), gSigLines(2, x), gSigLines(3, x), gSigLines(4, x), 0)
Next x
pic.Refresh
End Sub
Public Sub AddPoint(x As Long, Y As Long)
gSigPointCount = gSigPointCount + 1
ReDim Preserve gSigPoints(2, gSigPointCount)
gSigPoints(1, gSigPointCount) = x
gSigPoints(2, gSigPointCount) = Y
End Sub
Public Sub AddLine(x As Long, Y As Long, x1 As Long, y1 As Long)
gSigLinesCount = gSigLinesCount + 1
ReDim Preserve gSigLines(4, gSigLinesCount)
gSigLines(1, gSigLinesCount) = x
gSigLines(2, gSigLinesCount) = Y
gSigLines(3, gSigLinesCount) = x1
gSigLines(4, gSigLinesCount) = y1
End Sub
'********signature
Private miX As Double
Private miY As Double
Private isup As Boolean
'*********end of signature
'## singnatures
Private Sub picDraw_MouseDown(Button As Long, Shift As Long, x As Double, Y As Double)
picDraw.DrawPoint x, Y, 0
picDraw.Refresh
Call AddPoint(x, Y)
miX = x
miY = Y
isup = False
End Sub
Private Sub picDraw_MouseMove(Button As Long, Shift As Long, x As Double, Y As Double)
If isup Then
miX = x
miY = Y
isup = False
Else
If Button = 1 Then
picDraw.DrawLine miX, miY, x, Y, 0
picDraw.Refresh
Call AddLine(miX, miY, x, Y)
miX = x
miY = Y
End If
End If
End Sub
Private Sub picDraw_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Double, ByVal Y As Double)
isup = True
End Sub
This is all I can see regarding the signature picture box.
I figured the encoding out from the code you posted (had to port it to C++ though) so the encoding:
string starts with list of points
Each point is present as 4-digit hex number. First 2 hex digits are x coordinate and the second 2 digits are y coordinate of point. (probably marking each mouse down event so it holds the info on how many continuous draws the image was drawn)
then separator * follows
after that list of lines is present
Each line contains 2 points so total of 8-digits hex number per line. The sequence is x0,y0,x1,y1 2-digit hex number per coordinate. If the string contains only 4-digit hex number (the end) it marks the end of signature string.
So when you want to make own signature code then:
clear list of points and list of lines
on mouse down (left button click on or pen hit) event
Add current mouse/pen position to the point list and as a start point to line list
on mouse/pen move event
First find out if the mouse button is still clicked or pen still hitting the pad. If not ignore this event. If yes then add current mouse position to line list twice (that is why they are duplicated the first ends current line and the second starts new line)
on mouse/pen up event
close the actual line so add current mouse position to line list once
before exporting
duplicate last point in lines list to mark end of string
That is all. If you need to convert already drawed image (raster) then you may have problems with comparison because is very unlikely you vectorize the image the same way as the author signs it. Resulting in miss-match of the same images. Also the tripled last point is most likely because of wrong encoding of mouse/pen up event adding the same point inside on mouse move and on mouse up events at once
The images encoded this way are limited to 256x256 pixels.
Here example of decoded image for your first signature string:
signature="221A*221A270A270A2503250320072007171617160D2A0D2A07380738073F073F0B3E0B3E15311531222122212C182C183016301631173117311A311A302230222E272E272D2C2D2C2C2F2C2F2C312C312C2F2C2F2E2B2E2B3126312633223322371D371D381C381C3B1B3B1B3C1C3C1C3D1F3D1F3D243D243C2D3C2D3A333A333A363A36393939393B383B383D363D36412E412E46264626492049204B1B4B1B4E184E184F174F175017501751185118511D511D51225122502450244F294F294F2C4F2C4E2F4E2F4F314F315030503052305230552C552C582958295D225D22601E601E611C611C621B621B621A621A601A601A5D1B5D1B5B1E5B1E5723572353285328512B512B502E502E502F502F513151315231523154305430582E582E592D592D5C2C5C2C5F2A5F2A6428642865286528692669266D246D247122712275207520791D791D7D1B7D1B81198119841884188618861887198719881A881A891B891B881C881C871E871E861F861F852085208421842182228222812481247F257F257E257E257D257D257C247C247C217C217D1F7D1F7E1C7E1C801A801A81198119821782178317831784188418851A851A851C851C86208620862286228625862587278727872B872B882E882E893289328A338A338E348E349033903393329332972F972F9A2D9A2D9F299F29A426A426AB20AB20AF1CAF1CB517B517B716B716B716";
here square example
signature="0808*080820082008202020200820082008080808";
so when reordered:
0808 // point(8h,8h);
* // separator
08 08 20 08 // line( 8h, 8h,20h, 8h)
20 08 20 20 // line(20h, 8h,20h,20h)
20 20 08 20 // line(20h,20h, 8h,20h)
08 20 08 08 // line( 8h,20h, 8h, 8h)
08 08 // not enough points -> end of string
[Edit1] raster image to string conversion
First you need to convert your image to vector form. There are many sophistikated approaches to polygonize raster image to vector form but they are usually using advanced things from math,image processing,structures etc... requiring extensive knowledge on the subject. As I assume you need this just to visualize something on the device so Instead I would use very simple conversion resulting in unreasonable big results (in comparison to the advanced approaches). If your device does not have too small limit on the string size then you should be fine otherwise you would need use something more advanced then this:
clear your vector representation
list of points and list of lines
loop through all horizontal lines of image
process each line
find first set pixel from current position x0
find first unset pixel from current position x1
if x0,x1 found then
add point (x0,y)
add line (x0,y,x1-1,y)
after whole image processed convert vector form to string
clear string
add list of all points to string
add separator * to string
add list of all lines to string
This is how it looks like in C++:
// load input 2D BW (binary) image
backbuffer in;
in.bmp->LoadFromFile("in.bmp");
in.resize(in.bmp->Width,in.bmp->Height);
int x0,x1,x,y;
// clear signature vecor represenytation
gSigPoints.num=0;
gSigLines.num=0;
for (y=0;y<in.ys;y++)
for (x=0;x<in.xs;)
{
for (;(x<in.xs)&&(!in.pyx[y][x]);x++); x0=x; // find start of V-line
for (;(x<in.xs)&&( in.pyx[y][x]);x++) x1=x; // find end of V-line
if (x0<in.xs) // add pnt,line to signature
{
gSigPoints.add(x0);
gSigPoints.add(y );
gSigLines.add(x0);
gSigLines.add(y );
gSigLines.add(x1);
gSigLines.add(y );
}
}
// update string and screen
txt=PackBMP();
draw();
where in.xs,in.ys is input image resolution
in.pyx[y][x] is the image pixel access
txt is the signature string
gSigPoints,gSigLines are lists holding the signature points and lines
these list have .num the number of items and .add(a) adds a to the end of the list
The pack/unpack ported from your VB code looks like this:
//---------------------------------------------------------------------------
#include "list.h"
//---------------------------------------------------------------------------
List<DWORD> gSigPoints;
List<DWORD> gSigLines;
// some test examples:
//AnsiString txt="221A*221A270A270A2503250320072007171617160D2A0D2A07380738073F073F0B3E0B3E15311531222122212C182C183016301631173117311A311A302230222E272E272D2C2D2C2C2F2C2F2C312C312C2F2C2F2E2B2E2B3126312633223322371D371D381C381C3B1B3B1B3C1C3C1C3D1F3D1F3D243D243C2D3C2D3A333A333A363A36393939393B383B383D363D36412E412E46264626492049204B1B4B1B4E184E184F174F175017501751185118511D511D51225122502450244F294F294F2C4F2C4E2F4E2F4F314F315030503052305230552C552C582958295D225D22601E601E611C611C621B621B621A621A601A601A5D1B5D1B5B1E5B1E5723572353285328512B512B502E502E502F502F513151315231523154305430582E582E592D592D5C2C5C2C5F2A5F2A6428642865286528692669266D246D247122712275207520791D791D7D1B7D1B81198119841884188618861887198719881A881A891B891B881C881C871E871E861F861F852085208421842182228222812481247F257F257E257E257D257D257C247C247C217C217D1F7D1F7E1C7E1C801A801A81198119821782178317831784188418851A851A851C851C86208620862286228625862587278727872B872B882E882E893289328A338A338E348E349033903393329332972F972F9A2D9A2D9F299F29A426A426AB20AB20AF1CAF1CB517B517B716B716B716";
//AnsiString txt="3711*371127152715103510351F2C1F2C312231223C1C3C1C3D203D20352D352D333233323D2E3D2E52225222671A671A6C196C196D1A6D1A6D1D6D1D69226922652665266428642864296429652965296E236E23781E781E8718871891179117961896189A199A199B1B9B1B9D1E9D1E9F209F20A021A021A021";
AnsiString txt="0808*08082008200820202020082008200808";
//---------------------------------------------------------------------------
AnsiString Hex(DWORD x,DWORD digits)
{
int i;
char *tab="0123456789ABCDEF";
AnsiString s="";
if (digits>8) digits=8;
s.SetLength(digits);
for (i=digits;i>0;i--,x>>=4) s[i]=tab[x&15];
return s;
}
//---------------------------------------------------------------------------
AnsiString PackBMP()
{
DWORD i;
AnsiString sig="";
// all points
for (i=0;i+1<gSigPoints.num;)
{
sig+=Hex(gSigPoints[i],2); i++; // x
sig+=Hex(gSigPoints[i],2); i++; // y
}
// separator
sig+="*";
// all lines
for (i=0;i+3<gSigLines.num;i++)
{
sig+=Hex(gSigLines[i],2); i++; // x0
sig+=Hex(gSigLines[i],2); i++; // y0
sig+=Hex(gSigLines[i],2); i++; // x1
sig+=Hex(gSigLines[i],2); i++; // y1
}
return sig;
}
//---------------------------------------------------------------------------
void UnpackBMP(AnsiString &sig)
{
DWORD a,x,y;
int i=1,l=sig.Length();
// all points
for(gSigPoints.num=0;(i+3<=l)&&(sig[i]!='*');)
{
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; x =a; i++;
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; x<<=4; x|=a; i++;
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; y =a; i++;
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; y<<=4; y|=a; i++;
gSigPoints.add(x);
gSigPoints.add(y);
}
// separator
i++;
// all lines
for(gSigLines.num=0;i+7<=l;)
{
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; x =a; i++;
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; x<<=4; x|=a; i++;
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; y =a; i++;
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; y<<=4; y|=a; i++;
gSigLines.add(x);
gSigLines.add(y);
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; x =a; i++;
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; x<<=4; x|=a; i++;
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; y =a; i++;
a=sig[i]-'0'; if (a>9) a+='0'-'A'+10; y<<=4; y|=a; i++;
gSigLines.add(x);
gSigLines.add(y);
}
}
//---------------------------------------------------------------------------
void DrawBMP(TCanvas *can)
{
DWORD i,x,y;
// all points
for (i=0;i+1<gSigPoints.num;)
{
x=gSigPoints[i]; i++;
y=gSigPoints[i]; i++;
can->Pixels[x][y]=can->Pen->Color;
}
// all lines
for (i=0;i+3<gSigLines.num;)
{
x=gSigLines[i]; i++;
y=gSigLines[i]; i++;
can->MoveTo(x,y);
x=gSigLines[i]; i++;
y=gSigLines[i]; i++;
can->LineTo(x,y);
}
}
//---------------------------------------------------------------------------
void signature_on_mouse(backbuffer &scr)
{
DWORD x,y;
// mouse left button last and actual
bool q0=scr.sh0.Contains(ssLeft);
bool q1=scr.sh1.Contains(ssLeft);
bool _redraw=false;
// actual mouse position
x=scr.mx1;
y=scr.my1;
// on mouse down event
if ((!q0)&&(q1))
{
gSigPoints.add(x); gSigLines.add(x);
gSigPoints.add(y); gSigLines.add(y);
_redraw=true;
}
// on mouse move event
if ((q0)&&(q1))
{
gSigLines.add(x);
gSigLines.add(y);
gSigLines.add(x);
gSigLines.add(y);
_redraw=true;
}
// mouse mouse up event
if ((q0)&&(!q1))
{
gSigLines.add(x);
gSigLines.add(y);
_redraw=true;
txt=PackBMP();
}
// right mouse button clears signature
if (scr.sh1.Contains(ssRight))
{
gSigPoints.num=0;
gSigLines.num=0;
_redraw=true;
}
if ((_redraw)&&(scr.win)) scr.win->Repaint();
scr.rfs_mouse();
}
//---------------------------------------------------------------------------
where backbuffer is mine class to interface the window backbuffer image and mouse handler events.
So just change List<>,AnsiString,Backbuffer to your platform style.
This can handle any raster binary image not just signatures:
But as you can see the size of signature string is ~ 13.9 KByte
Related
I've been working to create a random pairing algorithm for my bass club. The idea is to pair a value in Column A (Boaters) with a value in Column B (non-boaters). If there are no more non-boaters, any remaining boaters should be paired unless only one unpaired boater remains.
I found some VBA code online, which works fine in Excel, but all of my club's stuff is in Google Sheets and I'd like to have the same pairing function in GAS.
I've tried my best to convert the VBA code to GAS, but honestly, I have some experience with VBA and I'm still a relative novice at GAS, although I'm learning.
I've pasted the two VBA functions below, followed by the GAS conversion I've been working on. The comments show the areas where I'm having trouble, particularly with the called sorting function (vSortM), although I'd welcome a second set of eyes to make sure I haven't incorrectly coded something else.
Can anyone advise if I am performing the conversion from VBA to GAS correctly?
Pairing Algorithm in VBA that I found online:
Option Explicit
Sub test()
Dim Boters(), NonBoters(), i As Long, x As Long
Boters = Range("a1", Range("a" & Rows.Count).End(xlUp)).Value
Redim Preserve Boters(1 To UBound(Boters), 1 To 2)
NonBoters = Range("b1", Range("b" & Rows.Count).End(xlUp)).Value
Redim Preserve NonBoters(1 To UBound(NonBoters), 1 To 2)
Randomize
For i = 1 To UBound(Boters)
Boters(i, 2) = Rnd
Next
For i = 1 To UBound(NonBoters)
NonBoters(i, 2) = Rnd
Next
VSortM Boters, 1, UBound(Boters), 2
VSortM NonBoters, 1, UBound(NonBoters), 2
x = Application.Min(UBound(Boters), UBound(NonBoters))
With Cells(1, 4).Resize(x, 2)
.CurrentRegion.ClearContents
.Columns(1).Value = Boters
.Columns(2).Value = NonBoters
End With
If x < UBound(Boters) Then
For i = x + 1 To UBound(Boters) Step 2
If i + 1 > UBound(Boters) Then Exit For
Cells(i, 4).Value = Boters(i, 1)
Cells(i, 5).Value = Boters(i + 1, 1)
Next
End If
End Sub
Private Sub VSortM(ary, LB, UB, ref)
Dim M As Variant, i As Long, ii As Long, iii As Long, temp
i = UB: ii = LB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
Do While ary(ii, ref) < M
ii = ii + 1
Loop
Do While ary(i, ref) > M
i = i - 1
Loop
If ii <= i Then
For iii = LBound(ary, 2) To UBound(ary, 2)
temp = ary(ii, iii)
ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
Next
ii = ii + 1: i = i - 1
End If
Loop
If LB < i Then VSortM ary, LB, i, ref
If ii < UB Then VSortM ary, ii, UB, ref
End Sub
My attempt at converting the Pairing Algorithm in GAS
function test() {
//Get values for Column A and Column B starting at Row 5
var ssMatch = SpreadsheetApp.getActiveSpreadsheet().getSheetByName('Pairings');
var bRange = ssMatch.getRange("A5:A").getValues();
var nBRange = ssMatch.getRange("B5:B").getValues();
//Determine length with data to exclude blansk
var bLast = bRange.filter(String).length;
var nBLast = nBRange.filter(String).length;
//Get values for boaters & nBoaters without blanks
var boaters = ssMatch.getRange(5,1,bLast).getValues();
var nBoaters = ssMatch.getRange(5,2,nBLast).getValues();
// Populate boaters & nBoaters arrays using random numbers
for (var i = 0; i < bLast; i++) {
boaters[i][1] = Math.random();
Logger.log(boaters);
}
for (var j = 0; j<nBLast; j++) {
nBoaters[j][1] = Math.random();
Logger.log(nBoaters);
}
vSortM (boaters, 1, bLast, 1);
vSortM (nBoaters, 1, nBLast, 1);
//Determine whether there are more boaters or non-boaters
var x = Min(bLast, nBLast);
//Write boater & nBoater values in Columns
//NEED SOME HELP HERE: Certain this isn't correct for GAS
Cells(1,4).Resize(x, 2);
Cells.CurrentRegion.ClearContents;
Cells.Columns(1).setValues(boaters);
Cells.Columns(2).setValues(nBoaters);
//If no more nBoaters, pair remaining unpaired boaters
if (x < bLast) {
for (var i = x + 1; i<bLast; i = i + 2) {
if (i + 1 > bLast) { break;}
else {
//THINK I DID THIS RIGHT, BUT NOT SURE
ssMatch.getRange(i,4).setValue(boaters[i][0]);
ssMatch.getRange(i,5).setValue(boaters[i+1][0]);
}
}
}
}
//Having some trouble converting this from VBA to GAS
// not sure how to deal with the ary parameter and m statement
function vSortM(ary, lB, uB, ref) {
var temp = 0;
var i = uB;
var ii = lB;
var m = [parseInt((lB + uB) / 2), ref];
while (ii <= i);{
while ([ii, ref] < m); {
ii++;
while ([i, ref] > m); {
i--;
}
if (ii <= i); {
for (var iii = 0; i<=(ary, 2);) {
temp = [ii, iii];
[ii, iii] = [i, iii];
[i, iii] = temp;
}
ii++;
i--;
}
}
if (lB < i) {
vSortM(ary, lB, i, ref);
}
if (ii < uB) {
vSortM(ary, ii, uB, ref);
}
}
}
First off, I have to agree with the others in the comments. The question is too broad. In https://stackoverflow.com/help/dont-ask it says that questions should be reasonably scoped.
From what I see in your code that you ask for help.
//NEED SOME HELP HERE: Certain this isn't correct for GAS
Cells(1,4).Resize(x, 2);
Cells.CurrentRegion.ClearContents;
Cells.Columns(1).setValues(boaters);
Cells.Columns(2).setValues(nBoaters);
This section is easy to figure out by using the very well written documentation for GAS (always refer to it first before going anywhere else). In GAS you are essentially working with classes (or objects if you will). Here you will want the sheet class to resize the row and column (2 seperate functions) and then a range class (which is retrieved from the sheet class) to clear and set values.
//THINK I DID THIS RIGHT, BUT NOT SURE
ssMatch.getRange(i,4).setValue(boaters[i][0]);
ssMatch.getRange(i,5).setValue(boaters[i+1][0]);
Depends on what you want to accomplish. The syntax here is correct, you set a value for a single cell. Keep in mind that in google sheets it's best to try and batch such calls. So instead of setting a value on a cell by cell basis, you would get a range from A1 to B20 and set all values at once with a 2D array.
Finally you need to clarify what it is the second functions has to do and what it doesn't do right. Perhaps share a minimal example sheet (read here about Minimal, Complete, and Verifiable example)?
How can I show I winform that I create in VB.NET just below the active cell?
I have no idea how to solve this. I found the following promising solutions:
Excel addin: Cell absolute position
-The accepted solution seems too complicated to work reliably. I got an error on the first row (Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long)
-The second solution looked promising, but it didn't give me the right positions for my windows form.
The following adaptations of the second proposed solution does not create any errors but does not put the windows form in the correct position:
Public Sub GetScreenPositionFromCell(cell As Excel.Range, excel As Excel.Application)
Dim x As Double
Dim y As Double
If Not excel.ActiveWindow Is Nothing Then
x = excel.ActiveWindow.PointsToScreenPixelsX(cell.Left)
y = excel.ActiveWindow.PointsToScreenPixelsY(cell.Top)
End If
Me.Left = x
Me.Top = y
Me.Show()
Me.TopMost = True
End Sub
EDIT: #Loating, here is how I have used your code. It's great and I am very happy that you are taking your time to help me with a solution. The x-coordinates seems to work while the x-coordinates are a bit off and more or less off depending on the zoom level.
Public Sub ShowMeBelowActiveCell()
Dim ExcelApp As Excel.Application = CType(AddinExpress.MSO.ADXAddinModule.CurrentInstance, AddinModule).ExcelApp
Dim excelWindow = ExcelApp.ActiveWindow
Dim cell = ExcelApp.ActiveCell
Dim zoomFactor As Double = excelWindow.Zoom / 100
Dim ws = cell.Worksheet
' PointsToScreenPixels returns different values if the scroll is not currently 1
' Temporarily set the scroll back to 1 so that PointsToScreenPixels returns a
' value we know how to handle.
Dim origScrollCol = excelWindow.ScrollColumn
Dim origScrollRow = excelWindow.ScrollRow
excelWindow.ScrollColumn = 1
excelWindow.ScrollRow = 1
' (x,y) are screen coordinates for the top left corner of the top left cell
Dim x As Integer = excelWindow.PointsToScreenPixelsX(0)
' e.g. window.x + row header width
Dim y As Integer = excelWindow.PointsToScreenPixelsY(0)
' e.g. window.y + ribbon height + column headers height
Dim dpiX As Single = 0
Dim dpiY As Single = 0
Using g = Drawing.Graphics.FromHwnd(IntPtr.Zero)
dpiX = g.DpiX
dpiY = g.DpiY
End Using
' Note: Each column width / row height has to be calculated individually.
' Before, tried to use this approach:
' var r2 = (Microsoft.Office.Interop.Excel.Range) cell.Worksheet.Cells[origScrollRow, origScrollCol];
' double dw = cell.Left - r2.Left;
' double dh = cell.Top - r2.Top;
' However, that only works when the zoom factor is a whole number.
' A fractional zoom (e.g. 1.27) causes each individual row or column to round to the closest whole number,
' which means having to loop through.
For i As Integer = origScrollCol To cell.Column - 1
Dim col = DirectCast(ws.Cells(cell.Row, i), Microsoft.Office.Interop.Excel.Range)
Dim ww As Double = col.Width * dpiX / 72
Dim newW As Double = zoomFactor * ww
x += CInt(Math.Round(newW))
Next
For i As Integer = origScrollRow To cell.Row - 1
Dim row = DirectCast(ws.Cells(i, cell.Column), Microsoft.Office.Interop.Excel.Range)
Dim hh As Double = row.Height * dpiY / 72
Dim newH As Double = zoomFactor * hh
y += CInt(Math.Round(newH))
Next
excelWindow.ScrollColumn = origScrollCol
excelWindow.ScrollRow = origScrollRow
Me.StartPosition = Windows.Forms.FormStartPosition.Manual
Me.Location = New Drawing.Point(x, y)
Me.Show()
End Sub
End Class
When the ScrollColumn and ScrollRow are both 1, then PointsToScreenPixelsX/Y seems to return the top left point of the top left visible cell in screen coordinates. Using this, the offset width and height to the active cell is calculated, taking into consideration the zoom setting.
var excelApp = Globals.ThisAddIn.Application;
var excelWindow = excelApp.ActiveWindow;
var cell = excelApp.ActiveCell;
double zoomFactor = excelWindow.Zoom / 100;
var ws = cell.Worksheet;
var ap = excelWindow.ActivePane; // might be split panes
var origScrollCol = ap.ScrollColumn;
var origScrollRow = ap.ScrollRow;
excelApp.ScreenUpdating = false;
// when FreezePanes == true, ap.ScrollColumn/Row will only reset
// as much as the location of the frozen splitter
ap.ScrollColumn = 1;
ap.ScrollRow = 1;
// PointsToScreenPixels returns different values if the scroll is not currently 1
// Temporarily set the scroll back to 1 so that PointsToScreenPixels returns a
// value we know how to handle.
// (x,y) are screen coordinates for the top left corner of the top left cell
int x = ap.PointsToScreenPixelsX(0); // e.g. window.x + row header width
int y = ap.PointsToScreenPixelsY(0); // e.g. window.y + ribbon height + column headers height
float dpiX = 0;
float dpiY = 0;
using (var g = Graphics.FromHwnd(IntPtr.Zero)) {
dpiX = g.DpiX;
dpiY = g.DpiY;
}
int deltaRow = 0;
int deltaCol = 0;
int fromCol = origScrollCol;
int fromRow = origScrollRow;
if (excelWindow.FreezePanes) {
fromCol = 1;
fromRow = 1;
deltaCol = origScrollCol - ap.ScrollColumn; // Note: ap.ScrollColumn/Row <> 1
deltaRow = origScrollRow - ap.ScrollRow; // see comment: when FreezePanes == true ...
}
// Note: Each column width / row height has to be calculated individually.
// Before, tried to use this approach:
// var r2 = (Microsoft.Office.Interop.Excel.Range) cell.Worksheet.Cells[origScrollRow, origScrollCol];
// double dw = cell.Left - r2.Left;
// double dh = cell.Top - r2.Top;
// However, that only works when the zoom factor is a whole number.
// A fractional zoom (e.g. 1.27) causes each individual row or column to round to the closest whole number,
// which means having to loop through.
for (int i = fromCol; i < cell.Column; i++) {
// skip the columns between the frozen split and the first visible column
if (i >= ap.ScrollColumn && i < ap.ScrollColumn + deltaCol)
continue;
var col = ((Microsoft.Office.Interop.Excel.Range) ws.Cells[cell.Row, i]);
double ww = col.Width * dpiX / 72;
double newW = zoomFactor * ww;
x += (int) Math.Round(newW);
}
for (int i = fromRow; i < cell.Row; i++) {
// skip the columns between the frozen split and the first visible column
if (i >= ap.ScrollRow && i < ap.ScrollRow + deltaRow)
continue;
var row = ((Microsoft.Office.Interop.Excel.Range) ws.Cells[i, cell.Column]);
double hh = row.Height * dpiY / 72;
double newH = zoomFactor * hh;
y += (int) Math.Round(newH);
}
ap.ScrollColumn = origScrollCol;
ap.ScrollRow = origScrollRow;
excelApp.ScreenUpdating = true;
Form f = new Form();
f.StartPosition = FormStartPosition.Manual;
f.Location = new Point(x, y);
f.Show();
I need to calculate the median of a set of measurements where in some cases a value was measured, and in some cases the value was below detection (indicated by "<" sign followed by the detection limit, e.g. <1)
Here are some examples of cases that I'm encountering:
2.0; 3.0; <1.0; 4.0 --> median = 2.5
1.0; <0.5; <0.5 --> median = <0.5
1.0; 1.0; <0.5; <0.5 --> median = <0.75
I'm a little stumped about doing this in excel VBA.
How can I do math with the values that have a "<" sign while still keeping track of the "<"?
Any input is much appreciated -- thanks!
Here's something I use:
Public Function DoAvg(rng As Range)
DoAvg = Parse(rng, "Average")
End Function
Public Function DoMedian(rng As Range)
DoMedian = Parse(rng, "Median")
End Function
'This does the work...
Private Function Parse(rng As Range, CalcType As String)
Dim rv, arr() As Single, mods As String, i As Long
Dim c As Range
Dim tmp, m
For Each c In rng.Cells
tmp = Replace(Trim(c.Value), " ", "")
If tmp Like "<*" Or tmp Like ">*" Then
m = Left(tmp, 1)
If Not InStr(mods, m) > 0 Then mods = mods & m
tmp = Right(tmp, Len(tmp) - 1)
End If
If IsNumeric(tmp) And tmp <> "" Then
i = i + 1
ReDim Preserve arr(1 To i)
arr(i) = tmp
End If
Next c
If i > 1 Then
rv = CallByName(Application.WorksheetFunction, CalcType, VbGet, arr)
Parse = IIf(mods <> "", mods, "") & rv
Else
Parse = ""
End if
End Function
Given this Short (signed):
&Hxxxx
I want to:
Extract the most right &HxxFF as SByte (signed)
Extract the left &H7Fxx as Byte (unsigned)
Identify if the most left &H8xxx is positive or negative (bool result)
Extract the most right 0xxxff
myShort & 0x00FF
Extract the left 0xffxx
(myShort & 0xFF00) >> 8
Identify if the most left 0xfxxx is
positive or negative (it's a signed
short).
(myShort & 0xF000) >= 0;
Dim test As UInt16 = &HD 'a test value 1101
Dim rb As Byte 'lsb
Dim lb As Byte 'msb - 7 bits
Dim rm As UInt16 = &HFF 'lsb mask
Dim lm As UInt16 = &H7F00 'msb mask
Dim sgn As Byte = &H80 'sign mask
For x As Integer = 0 To 15 'shift the test value one bit at a time
rb = CByte(test And rm) 'get lsb
lb = CByte((test And lm) >> 8) 'get msb
Dim lbS, rbS As Boolean 'sign
'set signs
If (rb And sgn) = sgn Then rbS = True _
Else rbS = False
If (lb And sgn) = sgn Then lbS = True _
Else lbS = False 'should always be false based on mask
Console.WriteLine(String.Format("{0} {1} {2} {3} {4}",
x.ToString.PadLeft(2, " "c),
Convert.ToString(lb, 2).PadLeft(8, "0"c),
Convert.ToString(rb, 2).PadLeft(8, "0"c),
lbS.ToString, rbS.ToString))
test = test << 1
Next
inline char getLsb(short s)
{
return s & 0xff;
}
inline char getMsb(short s)
{
return (s & 0xff00) >> 8;
}
inline bool isBitSet(short s, unsigned pos)
{
return (s & (1 << pos)) > 0;
}
Uh...
value & 0x00ff
(value & 0xff00) >> 8
(value & 0xf000) >= 0
EDIT: I suppose you want the byte value and not just the upper 8 bits.
Extract the most right &HxxFF as SByte (signed)
CType(s AND &H00FF, SByte)
Extract the left &H7Fxx as Byte (unsigned)
CType((s AND &H7F00) >> 8, Byte)
Identify if the most left &H8xxx is positive or negative (bool result)
s AND &H8000 > 0
I think those work, been a while since I have worked in VB
I have written code to implement an algorithm I found on string permutations. What I have is an arraylist of words ( up to 200) and I need to permutate the list in levels of 5. Basically group the string words in fives and permutated them. What I have takes the first 5 words generates the permutations and ignores the rest of the arraylist?
Any ideas appreciated.
Private Function permute(ByVal chunks As ArrayList, ByVal k As Long) As ArrayList
ReDim ItemUsed(k)
pno = 0
Permutate(k, 1)
Return chunks
End Function
Private Shared Sub Permutate(ByVal K As Long, ByVal pLevel As Long)
Dim i As Long, Perm As String
Perm = pString ' Save the current Perm
' for each value currently available
For i = 1 To K
If Not ItemUsed(i) Then
If pLevel = 1 Then
pString = chunks.Item(i)
'pString = inChars(i)
Else
pString = pString & chunks.Item(i)
'pString += inChars(i)
End If
If pLevel = K Then 'got next Perm
pno = pno + 1
SyncLock outfile
outfile.WriteLine(pno & " = " & pString & vbCrLf)
End SyncLock
outfile.Flush()
Exit Sub
End If
' Mark this item unavailable
ItemUsed(i) = True
' gen all Perms at next level
Permutate(K, pLevel + 1)
' Mark this item free again
ItemUsed(i) = False
' Restore the current Perm
pString = Perm
End If
Next
K above is = to 5 for the number of words in one permutation but when I change the for loop to the arraylist size I get an error of index out of bounds
Index out of bounds error usually happens when you start the loop from 1 to length. The the for loop as following.
For i = 0 to array.length - 1
You will get this error.
When you do
For i = 1 To K
The last value of i will be the size of your array.
chunks.Item(i)
Will crash when i equals the size of the array since the index starts at 0.
I would suggest you change your for loop to
For i = 0 To K - 1
Or you change the way you access the values in your arrays to
chunks.Item(i-1)
C++ Permutation
#include <stdio.h>
void print(const int *v, const int size)
{
if (v != 0)
{
for (int i = 0; i < size; i++)
{
printf("%4d", v[i] );
}
printf("\n");
}
} // print
void permute(int *v, const int start, const int n)
{
if (start == n-1) {
print(v, n);
}
else {
for (int i = start; i < n; i++) {
int tmp = v[i];
v[i] = v[start];
v[start] = tmp;
permute(v, start+1, n);
v[start] = v[i];
v[i] = tmp;
}
}
}
main()
{
int v[] = {1, 2, 3, 4};
permute(v, 0, sizeof(v)/sizeof(int));
}