VB中自定義乙個調色盤

2021-04-20 16:55:57 字數 3804 閱讀 8067

'

'圖形顏色類'

option explicit

dim colors() as

variant

dim colortouse as

long

' '建立乙個調色盤.

'函式名: createcolorpal

'入口引數: colorpic as object

'說明:colorpic 欲設定成調色盤的物件名

'作用: 將乙個物件設定成乙個調色盤

public

sub createcolorpal(colorpic as

object)

dim i as

long

colorpic.autoredraw = true

colorpic.scale (0, 0)-(16, 3)

colors = array(16777215, 14737632, 12632319, 12640511, _

14745599, 12648384, 16777152, 16761024, _

16761087, 192, 16576, 49344, _

49152, 12632064, 12582912, 12583104, _

12632256, 4210752, 8421631, 8438015, _

8454143, 8454016, 16777088, 16744576, _

16744703, 128, 16512, 32896, _

32768, 8421376, 8388608, 8388736, _

8421504, 0, 255, 33023, _

65535, 65280, 16776960, 16711680, _

16711935, 64, 4210816, 16448, _

16384, 4210688, 4194304, 4194368)

for i = 0 to 15

colorpic.line (i, 0)-(i + 1, 1), colors(i), bf

colorpic.line (i, 1)-(i + 1, 2), colors(i + 16), bf

colorpic.line (i, 2)-(i + 1, 3), colors(i + 32), bf

if i > 0 then

colorpic.line (i, 0)-(i, 3)

endif

next i

colorpic.line (0, 1)-(16, 1)

colorpic.line (0, 2)-(16, 2)

endsub

' '從調色盤中取顏色.

'函式名: getpiccolor

'入口引數: colorpic as object, x as single, y as single

'返回值:該點的顏色值

'說明:colorpic已設定成調色盤的物件名:(x,y)該點座標.

'作用: 從調色盤中取(x,y)點顏色值

'*注: 請在mousedown 或 mouseup事件中使用

public

function getpiccolor(colorpic as

object, x as

single, y as

single) as

long

onerror

resume

next

dim w as

long, h as

long, c as

long

w = colorpic.scalewidth

h = colorpic.scaleheight

if (x <= 0) or (x >= w) or (y <= 0) or (y > h) then

exit

function

endif

c = fix(x) + fix(y) * 16

colortouse = colors(c)

getpiccolor = colortouse

endfunction

private

sub class_initialize()

dim t as

new clsrev

call t.getinival

set t = nothing

endsub

' '設定按鈕顏色.

'函式:setcomfore

'引數:objwin 目標窗體名.fontcolor 按鈕的字型顏色,ptwidth 如果存在,設定與檔案字間距.

'返回值:無

public

function setcomfore(objwin as

object, optional fontcolor as

long = 0, optional ptwidth as

long = 0)

dim frm as form

set frm = objwin

with setfrmcom

call .chcomfcolor(frm, .cjhpictocomm, .cjhfontsize, .cjhpicsize, fontcolor, ptwidth)

endwith

unload setfrmcom

set setfrmcom = nothing

endfunction

' '到複製..

'函式:pictopic

'引數:bigwidth 最大寬度.bigheight 最大高度,sourpic 源框,objpic 目標框.

'返回值:無

public

function pictopic(bigwidth as

long, bigheight as

long, byref sourpic as

object, byref objpic as

object)

dim rname as

string

dim pw as

long

dim ph as

long

dim t1 as

double

dim t2 as

double

pw = sourpic.width: ph = sourpic.height

if sourpic.picture <> 0 then

objpic.visible = false

t2 = pw / ph

t1 = bigwidth / bigheight

if pw > bigwidth or ph > bigheight then

if t2 > t1 then

objpic.width = bigwidth

objpic.height = bigwidth / t2

else

objpic.width = bigheight * t2

objpic.height = bigheight

endif

else

objpic.width = pw

objpic.height = ph

endif

objpic.picture = sourpic.picture

objpic.move (bigwidth - objpic.width) / 2, (bigheight - objpic.height) / 2

objpic.visible = true

endif

endfunction

UWP 分享乙個基於HSV色輪的調色盤應用

原文 uwp 分享乙個基於hsv色輪的調色盤應用 colorfulbox是adobe 色輪的簡單模仿,只實現了最基本的功能,ui也沒那麼好看,也沒用mvvm框架。這個應用最好玩的地方在於分布於hsv色輪上的各個點 colorpoint 以及可以通過拖動它們改變顏色。colorpoint的基本結構如下...

UWP 分享乙個基於HSV色輪的調色盤應用

colorfulbox是adobe 色輪的簡單模仿,只實現了最基本的功能,ui也沒那麼好看,也沒用mvvm框架。這個應用最好玩的地方在於分布於hsv色輪上的各個點 colorpoint 以及可以通過拖動它們改變顏色。colorpoint的基本結構如下 不是完整 public class colorp...

安全調色盤或巢狀下乙個迴圈和陣列

瀏覽器能解決很多問題,但是有216種顏色的顯示限制 不用抖掉或者洗掉顏色 幸運的是,有很多種方法你能顯示所有顏色混合的瀏覽器安全顏色調色盤 我不認為我已經以同樣的方式看見了兩個地方 通過把乙個陣列的6種可能的顏色值 00,33,66,99,cc,ff 把接下來的所有顏色 的乙個框架的1到6的三個語句...