Xojo Conferences
XDCMay2019MiamiUSA

[MBS] Other picture routines... (MBS Xojo Plugin Mailinglist archive)

Back to the thread list
Previous thread: [MBS] DNSAddressToName Method and Proxy
Next thread: [MBS] Comparing Pictures


Re: [MBS] MIDI Destinations and External Devices   -   Ron Benditt
  [MBS] Other picture routines...   -   Greg O'Lone

[MBS] Other picture routines...
Date: 02.07.05 08:04 (Sat, 2 Jul 2005 03:04:37 -0400)
From: Greg O'Lone
Come to think of it, there are a few other functions that I could use...

TrimPicture which allows you to trim off pixels of a particular color
to its smallest possible size
---------------------------------------------
Function TrimPicture(p as picture, optional trimcolor as color =
&cFFFFFF, optional tolerance as integer = 0) as picture
dim l,r,t,b,y,x,w,h,xo,yo as integer
dim retpic as picture
dim g as graphics
dim stop as boolean
dim hh(2),vv(2) as integer
dim g as graphics
tolerance = 3
g = p.Graphics
if g<>nil then
w = p.width - 1
h = p.height - 1
l = w
t = h
r = 0
b = 0
'trim the left, right, top, bottom
for y = 0 to h
for x = 0 to w
if g.pixel(x,y) <> trimcolor then
l = min(x,l)
r = max(x,r)
t = min(y,t)
b = max(y,b)
end if
next x
next y
'Check just in case no pixels were rendered
if l>=r or t>°then
l = 0
t = 0
else
w = (r-l)+tolerance
h = (b-t)+tolerance
xo = 0
yo = 0
end if
'copy to a new picture and return it
retpic = NewPicture(w, h, 16)
if retpic <> NIL then
retpic.graphics.DrawPicture p,xo,yo,w,h,l,t,w,h
end if
return retpic
else
return nil
end if
--------------------------------------------------------------------

Threshold which converts an image into a black and white bitmap

--------------------------------------------------------------------
Function Threshold(p as picture, optional thresh as integer = 127) as
picture
dim g as Graphics
dim pc as color
dim x,y,v as integer

g = p.Graphics
if surf<>nil then
for y = 0 to p.height-1
for x = 0 to p.width-1
pc = g.Pixel(x,y)
v = round(pc.value * 255)
pc = &c000000
if v>thresh then pc = &cFFFFFF
g.Pixel(x,y) = pc
next x
next y
end if
return p
End Function
--------------------------------------------------------------------

Greg O'Lone
Stretched Out Software

_______________________________________________
Mbsplugins_monkeybreadsoftware.info mailing list
<email address removed>
http://ml01.ispgateway.de/mailman/listinfo/mbsplugins_monkeybreadsoftware.info