PBMiner

$PBExportHeader$u_linedraw.sru
forward
global type u_linedraw from userobject
end type
type point from structure within u_linedraw
end type
type history from structure within u_linedraw
end type
type bitmapinfoheader from structure within u_linedraw
end type
type bitmapfileheader from structure within u_linedraw
end type
type bitmapinfo from structure within u_linedraw
end type
end forward

type point from structure
   unsignedlong      xpos
   unsignedlong      ypos
end type

type history from structure
   point    ptfrom[]
   point    ptthru[]
end type

type bitmapinfoheader from structure
   long     bisize
   long     biwidth
   long     biheight
   integer     biplanes
   integer     bibitcount
   long     bicompression
   long     bisizeimage
   long     bixpelspermeter
   long     biypelspermeter
   long     biclrused
   long     biclrimportant
end type

type bitmapfileheader from structure
   integer     bftype
   long     bfsize
   integer     bfreserved1
   integer     bfreserved2
   long     bfoffbits
end type

type bitmapinfo from structure
   bitmapinfoheader     bmiheader
   unsignedlong      bmicolors[]
end type

global type u_linedraw from userobject
integer width = 2016
integer height = 836
long backcolor = 67108864
string text = "none"
long tabtextcolor = 33554432
long picturemaskcolor = 536870912
event lbuttondown pbm_lbuttondown
event lbuttonup pbm_lbuttonup
event mousemove pbm_mousemove
event paint pbm_paint
end type
global u_linedraw u_linedraw

type prototypes
Function ulong GetDC ( &
   ulong hWnd &
   ) Library "user32.dll"

Function int ReleaseDC ( &
   ulong hWnd, &
   ulong hDC &
   ) Library "user32.dll"

Function boolean DeleteObject ( &
   ulong hObject &
   ) Library "gdi32.dll"

Function ulong CreatePen ( &
   int fnPenStyle, &
   int nWidth, &
   ulong crColor &
   ) Library "gdi32.dll"

Function ulong SelectObject ( &
   ulong hdc, &
   ulong hgdiobj &
   ) Library "gdi32.dll"

Function boolean Polyline ( &
   ulong hdc, &
   POINT lppt[], &
   int cPoints &
   ) Library "gdi32.dll"

Function ulong CreateRectRgn ( &
   long x1, &
   long y1, &
   long x2, &
   long y2 &
   ) Library "gdi32.dll"

Function boolean FillRgn ( &
   ulong hdc, &
   ulong hrgn, &
   ulong hbr &
   ) Library "gdi32.dll"

Function ulong CreateSolidBrush( &
   ulong crColor &
   ) Library "gdi32.dll"

Function boolean StretchBlt ( &
   ulong hdcDest, &
   long nXOriginDest, &
   long nYOriginDest, &
   long nWidthDest, &
   long nHeightDest, &
   ulong hdcSrc, &
   long nXOriginSrc, &
   long nYOriginSrc, &
   long nWidthSrc, &
   long nHeightSrc, &
   long dwRop &
   ) Library "gdi32.dll"

Function boolean DeleteDC ( &
   ulong hdc &
   ) Library "gdi32.dll"

Function ulong CreateCompatibleDC ( &
   ulong hdc &
   ) Library "gdi32.dll"

Function ulong CreateCompatibleBitmap ( &
   ulong hdc, &
   long nWidth, &
   long nHeight &
   ) Library "gdi32.dll"

Function long GetDIBits ( &
   ulong hdc, &
   ulong hbmp, &
   uint uStartScan, &
   uint cScanLines, &
   Ref blob lpvBits, &
   Ref BITMAPINFO lpbi, &
   uint uUsage &
   ) Library "gdi32.dll"

Function long GetDIBits ( &
   ulong hdc, &
   ulong hbmp, &
   uint uStartScan, &
   uint cScanLines, &
   ulong lpvBits, &
   Ref BITMAPINFO lpbi, &
   uint uUsage &
   ) Library "gdi32.dll"

Subroutine CopyBitmapFileHeader ( &
   Ref blob Destination, &
   BITMAPFILEHEADER Source, &
   long Length &
   ) Library "kernel32.dll" Alias For "RtlMoveMemory"

Subroutine CopyBitmapInfo ( &
   Ref blob Destination, &
   BITMAPINFO Source, &
   long Length &
   ) Library "kernel32.dll" Alias For "RtlMoveMemory"

Function long CreateFile ( &
   string lpFileName, &
   ulong dwDesiredAccess, &
   ulong dwShareMode, &
   ulong lpSecurityAttributes, &
   ulong dwCreationDisposition, &
   ulong dwFlagsAndAttributes, &
   ulong hTemplateFile &
   ) Library "kernel32.dll" Alias For "CreateFileA"

Function boolean WriteFile ( &
   long hFile, &
   blob lpBuffer, &
   ulong nNumberOfBytesToWrite, &
   Ref ulong lpNumberOfBytesWritten, &
   ulong lpOverlapped &
   ) Library "kernel32.dll"

Function boolean CloseHandle ( &
   long hObject &
   ) Library "kernel32.dll"

end prototypes
type variables
Public:

// Web Colors
Constant Long ALICE_BLUE = 16775408
Constant Long ANTIQUE_WHITE = 14150650
Constant Long AQUAMARINE = 13959039
Constant Long AZURE = 16777200
Constant Long BEIGE = 14480885
Constant Long BISQUE = 12903679
Constant Long BLACK = 0
Constant Long BLANCHED_ALMOND = 13495295
Constant Long BLUE = 16711680
Constant Long BLUE_VIOLET = 14822282
Constant Long BROWN = 32896
Constant Long BURLYWOOD = 8894686
Constant Long CADET_BLUE = 10526303
Constant Long CHARTREUSE = 65407
Constant Long CHOCOLATE = 1993170
Constant Long CORAL = 5275647
Constant Long CORNFLOWER_BLUE = 15570276
Constant Long CORNSILK = 14481663
Constant Long CYAN = 16776960
Constant Long DARK_BLUE = 8388608
Constant Long DARK_BROWN = 4210752
Constant Long DARK_CYAN = 8421376
Constant Long DARK_GOLDENROD = 755384
Constant Long DARK_GRAY = 8421504
Constant Long DARK_GREEN = 32768
Constant Long DARK_KHAKI = 7059389
Constant Long DARK_MAGENTA = 8388736
Constant Long DARK_OLIVE_GREEN = 3107669
Constant Long DARK_ORANGE = 36095
Constant Long DARK_ORCHID = 13382297
Constant Long DARK_RED = 128
Constant Long DARK_SALMON = 8034025
Constant Long DARK_SEA_GREEN = 9419919
Constant Long DARK_SLATE_BLUE = 9125192
Constant Long DARK_SLATE_GRAY = 5197615
Constant Long DARK_TURQUOISE = 13749760
Constant Long DARK_VIOLET = 13828244
Constant Long DEEP_PINK = 9639167
Constant Long DEEP_SKY_BLUE = 16760576
Constant Long DIM_GRAY = 6908265
Constant Long DODGER_BLUE = 16748574
Constant Long FIRE_BRICK = 2237106
Constant Long FLORAL_WHITE = 15792895
Constant Long FOREST_GREEN = 2263842
Constant Long GAINSBORO = 14474460
Constant Long GHOST_WHITE = 16775416
Constant Long GOLD = 55295
Constant Long GOLDENROD = 2139610
Constant Long GRAY = 12632256
Constant Long GREEN = 65280
Constant Long GREEN_YELLOW = 3145645
Constant Long HONEYDEW = 15794160
Constant Long HOT_PINK = 11823615
Constant Long INDIAN_RED = 6053069
Constant Long IVORY = 15794175
Constant Long KHAKI = 9234160
Constant Long LAVENDER = 16443110
Constant Long LAVENDER_BLUSH = 16118015
Constant Long LAWN_GREEN = 64636
Constant Long LEMON_CHIFFON = 13499135
Constant Long LIGHT_BLUE = 15128749
Constant Long LIGHT_BROWN = 4163021
Constant Long LIGHT_CORAL = 8421616
Constant Long LIGHT_CYAN = 16777184
Constant Long LIGHT_GOLDENROD = 8576494
Constant Long LIGHT_GOLDENROD_YELLLOW = 13826810
Constant Long LIGHT_GRAY = 12632256
Constant Long LIGHT_PINK = 12695295
Constant Long LIGHT_SALMON = 8036607
Constant Long LIGHT_SEA_GREEN = 11186720
Constant Long LIGHT_SKY_BLUE = 16436871
Constant Long LIGHT_SLATE_BLUE = 16740484
Constant Long LIGHT_SLATE_GRAY = 10061943
Constant Long LIGHT_STEEL_BLUE = 14599344
Constant Long LIGHT_YELLOW = 14745599
Constant Long LIME_GREEN = 3329330
Constant Long LINEN = 15134970
Constant Long MAGENTA = 16711935
Constant Long MAROON = 6303920
Constant Long MEDIUM_AQUAMARINE = 11193702
Constant Long MEDIUM_BLUE = 13434880
Constant Long MEDIUM_ORCHID = 13850042
Constant Long MEDIUM_PURPLE = 14381203
Constant Long MEDIUM_SEA_GREEN = 7451452
Constant Long MEDIUM_SLATE_BLUE = 15624315
Constant Long MEDIUM_SPRING_GREEN = 10156544
Constant Long MEDIUM_TURQUOISE = 13422920
Constant Long MEDIUM_VOILET_RED = 8721863
Constant Long MIDNIGHT_BLUE = 7346457
Constant Long MINT_CREAM = 16449525
Constant Long MISTY_ROSE = 14804223
Constant Long MOCCASIN = 11920639
Constant Long NAVAJO_WHITE = 11394815
Constant Long OLD_LACE = 15136253
Constant Long OLIVE = 32832
Constant Long OLIVE_DRAB = 2330219
Constant Long ORANGE = 42495
Constant Long ORANGE_RED = 17919
Constant Long ORCHID = 14053594
Constant Long PALE_GOLDENROD = 11200750
Constant Long PALE_GREEN = 10025880
Constant Long PALE_TURQUOISE = 15658671
Constant Long PALE_VIOLET_RED = 9662683
Constant Long PAPAYA_WHIP = 14020607
Constant Long PEACH_PUFF = 12180223
Constant Long PINK = 13353215
Constant Long PLUM = 14524637
Constant Long POWDER_BLUE = 15130800
Constant Long PURPLE = 15736992
Constant Long RED = 255
Constant Long ROSY_BROWN = 9408444
Constant Long ROYAL_BLUE = 14772545
Constant Long RUST = 1252800
Constant Long SADDLE_BROWN = 1262987
Constant Long SALMON = 7504122
Constant Long SANDY_BROWN = 6333684
Constant Long SEA_GREEN = 5737262
Constant Long SEASHELL = 15660543
Constant Long SIENNA = 2970272
Constant Long SKY_BLUE = 15453831
Constant Long SLATE_BLUE = 13458026
Constant Long SLATE_GRAY = 9470064
Constant Long SNOW = 16448255
Constant Long SPRING_GREEN = 8388352
Constant Long STEEL_BLUE = 11829830
Constant Long TAN = 9221330
Constant Long THISTLE = 14204888
Constant Long TOMATO = 4678655
Constant Long TURQUOISE = 13688896
Constant Long VIOLET = 15631086
Constant Long VIOLET_RED = 9445584
Constant Long WHEAT = 11788021
Constant Long WHITE = 16777215
Constant Long WHITE_SMOKE = 16119285
Constant Long YELLOW = 65535
Constant Long YELLOW_GREEN = 3329434

Long BackgroundColor = WHITE

Private:

Constant Integer BITMAPTYPE = 19778
Constant Uint DIB_RGB_COLORS = 0
Constant Long SRCCOPY = 13369376
HISTORY istr_hist[]
ULong iul_hDC
ULong iul_hPen
Integer ii_xpos
Integer ii_ypos

end variables

forward prototypes
private subroutine of_clear ()
public subroutine of_reset ()
public subroutine of_setbackgroundcolor (long al_value)
public function unsignedlong of_writeblob (string as_filename, blob ablb_bitmap)
public function blob of_capturebitmap ()
public subroutine of_setpensizecolor (long al_size, long al_color)
private function blob of_capture (long al_hwnd, unsignedlong al_xpos, unsignedlong al_ypos, unsignedlong al_width, unsignedlong al_height)
private subroutine of_createpen (integer ai_width, unsignedlong aul_color)
private subroutine of_drawlines ()
end prototypes

event lbuttondown;Long ll_occur
HISTORY lstr_empty

// initialize array occurrence
ll_occur = UpperBound(istr_hist) + 1
istr_hist[ll_occur] = lstr_empty

// save mouse position in pixels
ii_xpos = UnitsToPixels(xpos, XUnitsToPixels!)
ii_ypos = UnitsToPixels(ypos, YUnitsToPixels!)

end event

event lbuttonup;// allow it to create a dot for clicks without movement
this.Event mousemove(1, xpos, ypos)

end event

event mousemove;POINT lstr_point[2]
Long ll_draw, ll_occur

// draw the line if mouse button is down
If flags > 0 Then
   If ii_xpos = xpos And ii_ypos = ypos Then
      // eliminate duplicates
   Else
      // set from location
      lstr_point[1].xpos = ii_xpos
      lstr_point[1].ypos = ii_ypos
      // set thru location
      lstr_point[2].xpos = UnitsToPixels(xpos, XUnitsToPixels!)
      lstr_point[2].ypos = UnitsToPixels(ypos, YUnitsToPixels!)
      // draw the line
      Polyline(iul_hDC, lstr_point, 2)
      // save the from/thru points in array
      ll_occur = UpperBound(istr_hist)
      ll_draw  = UpperBound(istr_hist[ll_occur].ptFrom) + 1
      istr_hist[ll_occur].ptFrom[ll_draw] = lstr_point[1]
      istr_hist[ll_occur].ptThru[ll_draw] = lstr_point[2]
      // save current location
      ii_xpos = lstr_point[2].xpos
      ii_ypos = lstr_point[2].ypos
   End If
End If

end event

event paint;// repaint the lines
of_DrawLines()

end event

private subroutine of_clear ();// This function blanks out the image

HISTORY lstr_empty[]
ULong lul_hBrush, lul_region
Integer li_fwidth, li_fheight

// convert x, y, width and height from PBU to Pixels
li_fwidth = UnitsToPixels(this.width, XUnitsToPixels!) - 4
li_fheight = UnitsToPixels(this.height, YUnitsToPixels!) - 4

// create a brush
lul_hBrush = CreateSolidBrush(BackgroundColor)

// create a rectangular region
lul_region = CreateRectRgn(0, 0, li_fwidth, li_fheight)

// fill the region using the white brush
FillRgn(iul_hDC, lul_region, lul_hBrush)

// delete the region
DeleteObject(lul_region)

// delete the brush
DeleteObject(lul_hBrush)

end subroutine

public subroutine of_reset ();// This function blanks out the image and initializes
// the instance array.

HISTORY lstr_empty[]

// clear the control
of_Clear()

// reset point array
istr_hist = lstr_empty
ii_xpos = 0
ii_ypos = 0

end subroutine

public subroutine of_setbackgroundcolor (long al_value);BackgroundColor = al_value

of_Reset()

end subroutine

public function unsignedlong of_writeblob (string as_filename, blob ablb_bitmap);// write blob to disk

Constant Long INVALID_HANDLE_VALUE = -1
Constant ULong GENERIC_WRITE     = 1073741824
Constant ULong FILE_SHARE_WRITE  = 2
Constant ULong CREATE_ALWAYS     = 2

Long ll_file
ULong lul_length, lul_written
Boolean lb_rtn

// open file for write
ll_file = CreateFile(as_filename, GENERIC_WRITE, &
               FILE_SHARE_WRITE, 0, CREATE_ALWAYS, 0, 0)
If ll_file = INVALID_HANDLE_VALUE Then
   Return -999
End If

// write file to disk
lul_length = Len(ablb_bitmap)
lb_rtn = WriteFile(ll_file, ablb_bitmap, &
               lul_length, lul_written, 0)

// close the file
CloseHandle(ll_file)

Return 0

end function

public function blob of_capturebitmap ();// capture control contents to a blob

DragObject ldrg_object
PowerObject lpo_parent
Long ll_xpos, ll_ypos, ll_width, ll_height, ll_hWnd

ldrg_object = This

// loop thru parents until a window is found
lpo_parent = ldrg_object.GetParent()
Do While lpo_parent.TypeOf() <> Window! and IsValid (lpo_parent)
   lpo_parent = lpo_parent.GetParent()
Loop

// get handle to window
ll_hWnd = Handle(lpo_parent)

// convert x, y, width and height from PBU to Pixels
ll_xpos   = UnitsToPixels(ldrg_object.X, XUnitsToPixels!)
ll_ypos   = UnitsToPixels(ldrg_object.Y, YUnitsToPixels!)
ll_width  = UnitsToPixels(ldrg_object.Width, XUnitsToPixels!)
ll_height = UnitsToPixels(ldrg_object.Height, YUnitsToPixels!)

Return this.of_Capture(ll_hWnd, ll_xpos, &
                  ll_ypos, ll_width, ll_height)

end function

public subroutine of_setpensizecolor (long al_size, long al_color);of_CreatePen(al_size, al_color)

of_Reset()

end subroutine

private function blob of_capture (long al_hwnd, unsignedlong al_xpos, unsignedlong al_ypos, unsignedlong al_width, unsignedlong al_height);// capture bitmap and return as blob

BitmapInfo lstr_Info
BitmapFileHeader lstr_Header
Blob lblb_header, lblb_info, lblb_bitmap
ULong lul_hdc, lul_hdcMem, lul_hBitmap
Integer li_pixels
Boolean lb_result

// Get the device context of window and allocate memory
lul_hdc = GetDC(al_hWnd)
lul_hdcMem = CreateCompatibleDC(lul_hdc)
lul_hBitmap = CreateCompatibleBitmap(lul_hdc, al_width, al_height)

If lul_hBitmap <> 0 Then
   // Select an object into the specified device context
   SelectObject(lul_hdcMem, lul_hBitmap)
   // Copy the bitmap from the source to the destination
   lb_result = StretchBlt(lul_hdcMem, 0, 0, al_width, al_height, &
                           lul_hdc, al_xpos, al_ypos, al_width, al_height, SRCCOPY)
   // try to store the bitmap into a blob so we can save it
   lstr_Info.bmiHeader.biSize = 40
   // Get the bitmapinfo
   If GetDIBits(lul_hdcMem, lul_hBitmap, 0, al_height, &
                     0, lstr_Info, DIB_RGB_COLORS) > 0 Then
      li_pixels = lstr_Info.bmiHeader.biBitCount
      lstr_Info.bmiColors[li_pixels] = 0
      lblb_bitmap = Blob(Space(lstr_Info.bmiHeader.biSizeImage))
      // get the actual bits
      GetDIBits(lul_hdcMem, lul_hBitmap, 0, al_height, &
                     lblb_bitmap, lstr_Info, DIB_RGB_COLORS) 
      // create a bitmap header
      lstr_Header.bfType = BITMAPTYPE
      lstr_Header.bfSize = lstr_Info.bmiHeader.biSizeImage
      lstr_Header.bfOffBits = 54 + (li_pixels * 4)
      // copy the header structure to a blob
      lblb_header = Blob(Space(14))
      CopyBitmapFileHeader(lblb_header, lstr_Header, 14)
      // copy the info structure to a blob
      lblb_Info = Blob(Space(40  + li_pixels * 4))
      CopyBitmapInfo(lblb_Info, lstr_Info, 40 + li_pixels * 4)
      // add all together and we have a window bitmap in a blob
      lblb_bitmap = lblb_header + lblb_info + lblb_bitmap
   End If
End If

// Clean up handles
DeleteDC(lul_hdcMem)
ReleaseDC(al_hWnd, lul_hdc)

Return lblb_bitmap

end function

private subroutine of_createpen (integer ai_width, unsignedlong aul_color);// create a pen to draw width

Constant Integer PS_SOLID  = 0

// delete current custom pen
If iul_hPen > 0 Then
   DeleteObject(iul_hPen)
End If

// create new custom pen
iul_hPen = CreatePen(PS_SOLID, ai_width, aul_color)
SelectObject(iul_hDC, iul_hPen)

end subroutine

private subroutine of_drawlines ();// This function drawliness the image from the instance
// array of drawing points.

Long ll_occur, ll_draw, ll_point
POINT lstr_point[], lstr_empty[]

// clear the control
of_Clear()

// draw the image
For ll_occur = 1 To UpperBound(istr_hist)
   ll_point = 0
   lstr_point = lstr_empty
   For ll_draw = 1 To UpperBound(istr_hist[ll_occur].ptFrom)
      // populate from location
      ll_point = ll_point + 1
      lstr_point[ll_point] = istr_hist[ll_occur].ptFrom[ll_draw]
      // populate thru location
      ll_point = ll_point + 1
      lstr_point[ll_point] = istr_hist[ll_occur].ptThru[ll_draw]
   Next
   // draw the line
   Polyline(iul_hDC, lstr_point, UpperBound(lstr_point))
Next

end subroutine

on u_linedraw.create
end on

on u_linedraw.destroy
end on

event constructor;// get a dc handle
iul_hDC = GetDC(Handle(this))

// create default pen (3 pixels black)
of_CreatePen(3, 0)

end event

event destructor;// delete current custom pen
If iul_hPen > 0 Then
   DeleteObject(iul_hPen)
End If

// release the dc
ReleaseDC(Handle(this), iul_hdc)

end event