In Expression Web stellt dies bspw. kein Problem dar. Dort ist ein 'Color Picker' integriert. Im Fux ist dem leider nicht so.
Bisher kam deswegen immer das kleine Tool 'Pixie' von Nattyware zum Einsatz. Im UT stolperte ich vor ein paar Tagen dann über ein kleines Tool (MousetrackedColorPicker). Diesem Programm fehlten jedoch zwei Kleinigkeiten, um einen Mehrwert zu Pixie darzustellen. Deshalb habe ich den Code um die entsprechenden Features erweitert und umgestellt.
Punkt 1: Es genügt nicht, nur den Farbwert unter dem Mousecursor angezeigt zu bekommen. Wenn, dann sollte dieser Wert auch in die Zwischenablage kopiert werden können.
Punkt 2: Je nach Bedarf muss der Wert in der Zwischenablage den Integer-Farbwert, den RGB-Wert oder den Hex-Wert darstellen.
Gesteuert wird dies zum Einen über eine kleine Optiongroup direkt hinter den Anzeigewerten. Die Übernahme des selektierten Farbtyps in die Zwischenablage erfolgt über STRG+m.
Wer möchte legt sich den Aufruf des kleines PRGs auf eine F-Taste (Extras\Makros) und sofort steht der kleine ColorPicker jederzeit auf Abruf bereit.
PUBLIC oForm
oForm = CREATEOBJECT([frmcolorpicker])
oForm.Show
READ EVENTS
RELEASE oForm
DEFINE CLASS frmcolorpicker AS form
Top = 0
Left = 0
Height = 150
Width = 235
ShowWindow = 2
DoCreate = .T.
BorderStyle = 0
Caption = [Color Picker]
BackColor = RGB(255,255,255)
posx = 0
posy = 0
pixelcolor = 0
rgbcolor = []
hexcolor = []
errorstatus = 0
errortext = []
Name = [frmcolorpicker]
ADD OBJECT lblxpos AS label WITH ;
BackStyle = 0, ;
Caption = [XPos], ;
Height = 17, ;
Left = 7, ;
Top = 4, ;
Width = 40, ;
Name = [lblxpos]
ADD OBJECT lblypos AS label WITH ;
BackStyle = 0, ;
Caption = [YPos], ;
Height = 17, ;
Left = 7, ;
Top = 32, ;
Width = 40, ;
Name = [lblypos]
ADD OBJECT lblcolor AS label WITH ;
BackStyle = 0, ;
Caption = [Color], ;
Height = 17, ;
Left = 7, ;
Top = 60, ;
Width = 40, ;
Name = [lblColor]
ADD OBJECT lblrgbcolor AS label WITH ;
BackStyle = 0, ;
Caption = [RGB], ;
Height = 17, ;
Left = 7, ;
Top = 88, ;
Width = 40, ;
Name = [lblrgbcolor]
ADD OBJECT lblhexcolor AS label WITH ;
BackStyle = 0, ;
Caption = [Hex], ;
Height = 17, ;
Left = 7, ;
Top = 116, ;
Width = 40, ;
Name = [lblhexcolor]
ADD OBJECT txtxpos AS textbox WITH ;
FontBold = .T., ;
BorderStyle = 0, ;
ControlSource = [Thisform.PosX], ;
Height = 23, ;
Left = 45, ;
ReadOnly = .T., ;
Top = 2, ;
Width = 100, ;
DisabledBackColor = RGB(255,255,255), ;
Name = [txtXpos]
ADD OBJECT txtypos AS textbox WITH ;
FontBold = .T., ;
BorderStyle = 0, ;
ControlSource = [Thisform.PosY], ;
Height = 23, ;
Left = 45, ;
ReadOnly = .T., ;
Top = 30, ;
Width = 100, ;
DisabledBackColor = RGB(255,255,255), ;
Name = [txtYpos]
ADD OBJECT txtcolor AS textbox WITH ;
FontBold = .T., ;
BorderStyle = 0, ;
ControlSource = [Thisform.PixelColor], ;
Height = 23, ;
Left = 45, ;
ReadOnly = .T., ;
Top = 58, ;
Width = 100, ;
DisabledBackColor = RGB(255,255,255), ;
Name = [txtColor]
ADD OBJECT txtrgbcolor AS textbox WITH ;
FontBold = .T., ;
Alignment = 1, ;
BorderStyle = 0, ;
ControlSource = [Thisform.RgbColor], ;
Height = 23, ;
Left = 45, ;
ReadOnly = .T., ;
Top = 86, ;
Width = 100, ;
DisabledBackColor = RGB(255,255,255), ;
Name = [txtRgbColor]
ADD OBJECT txthexcolor AS textbox WITH ;
FontBold = .T., ;
Alignment = 1, ;
BorderStyle = 0, ;
ControlSource = [Thisform.HexColor], ;
Height = 23, ;
Left = 45, ;
ReadOnly = .T., ;
Top = 114, ;
Width = 100, ;
DisabledBackColor = RGB(255,255,255), ;
Name = [txtHexColor]
ADD OBJECT timer1 AS timer WITH ;
Top = 0, ;
Left = 0, ;
Height = 23, ;
Width = 23, ;
Interval = 100, ;
Name = [Timer1]
ADD OBJECT colorshower AS container WITH ;
Top = 5, ;
Left = 165, ;
Width = 65, ;
Height = 130, ;
BorderWidth = 0, ;
Name = [colorshower]
ADD OBJECT lblinfo AS label WITH ;
AutoSize = .T., ;
FontSize = 7, ;
BackStyle = 0, ;
Caption = [STRG+m kopiert markierten Wert in die Zwischenablage], ;
Height = 14, ;
Left = 0, ;
Top = 138, ;
Width = 235, ;
ForeColor = RGB(128,128,128), ;
Name = [lblInfo]
ADD OBJECT opgclipselect AS optiongroup WITH ;
ButtonCount = 3, ;
BackStyle = 0, ;
BorderStyle = 0, ;
Value = 2, ;
Height = 77, ;
Left = 149, ;
Top = 56, ;
Width = 15, ;
Name = [opgClipselect], ;
Option1.Caption = [], ;
Option1.Value = 0, ;
Option1.Height = 17, ;
Option1.Left = 0, ;
Option1.Top = 5, ;
Option1.Width = 15, ;
Option1.Name = [Option1], ;
Option2.Caption = [], ;
Option2.Value = 1, ;
Option2.Height = 17, ;
Option2.Left = 0, ;
Option2.Top = 31, ;
Option2.Width = 15, ;
Option2.Name = [Option2], ;
Option3.Caption = [], ;
Option3.Height = 17, ;
Option3.Left = 0, ;
Option3.Top = 58, ;
Option3.Width = 15, ;
Option3.Name = [Option3]
PROCEDURE color2rgb
LPARAMETERS tnColor
LOCAL lnRed as Integer, lnGreen as Integer, lnBlue as Integer
lnRed = BITRSHIFT(BITAND(tnColor, 0x0000FF),0)
lnGreen = BITRSHIFT(BITAND(tnColor, 0x00FF00),8)
lnBlue = BITRSHIFT(BITAND(tnColor, 0xFF0000),16)
RETURN TRANSFORM(lnRed) + [,] + TRANSFORM(lnGreen) + [,] + TRANSFORM(lnBlue)
ENDPROC
PROCEDURE timerbasedrefresh
LOCAL lpPoint as String, liPosX as Integer, liPosY as Integer
lpPoint = SPACE(8)
WITH Thisform
IF GetCursorPos(@lpPoint) # 0
liPosX = ASC(SUBSTR(lpPoint,1)) * 256 ^ 0 + ;
ASC(SUBSTR(lpPoint,2)) * 256 ^ 1 + ;
ASC(SUBSTR(lpPoint,3)) * 256 ^ 2 + ;
ASC(SUBSTR(lpPoint,4)) * 256 ^ 3
liPosY = ASC(SUBSTR(lpPoint,5)) * 256 ^ 0 + ;
ASC(SUBSTR(lpPoint,6)) * 256 ^ 1 + ;
ASC(SUBSTR(lpPoint,7)) * 256 ^ 2 + ;
ASC(SUBSTR(lpPoint,8)) * 256 ^ 3
.PosX = IIF(liPosX > 10000,INT(liPosX) - 4294967295,INT(liPosX))
.PosY = INT(liPosY)
.PixelColor = GetPixel(GetWindowDC(0), .posx, .posy)
.RGBColor = .Color2RGB(.PixelColor)
.HexColor = STUFF(TRANSFORM(.PixelColor,[@0]),3,2,[])
.ColorShower.BackColor = .PixelColor
.Refresh()
ENDIF
ENDWITH
ENDPROC
PROCEDURE Release
LPARAMETERS vKey
WITH Thisform
IF VARTYPE(m.vKey) = [C] AND m.vKey = [m]
* Selektierten Wert in die Zwischenablage kopieren
DO CASE
CASE .opgClipSelect.Value = 1 && Color
_cliptext = ALLTRIM(CAST(.txtColor.Value as c(10)))
CASE .opgClipSelect.Value = 2 && RGB
_cliptext = .txtRgbColor.Value
CASE .opgClipSelect.Value = 3 && Hex
_cliptext = .txtHexColor.Value
ENDCASE
ENDIF
ENDWITH
ENDPROC
PROCEDURE Unload
CLEAR EVENTS
ENDPROC
PROCEDURE Init
TRY
DECLARE Sleep IN Win32API Integer
DECLARE Short GetCursorPos IN win32api String @ lpPoint
DECLARE Integer GetWindowDC IN Win32API Integer HWnd
DECLARE Integer GetPixel IN win32API Integer hdc, Integer nXPos, Integer nYPos
ON KEY LABEL CTRL+m _screen.ActiveForm.Release([m])
BINDEVENT(Thisform.Timer1,[Timer],Thisform,[TimerBasedRefresh])
CATCH
TEXT TO lcMsg TEXTMERGE NOSHOW PRETEXT 3
ColorPicker kann auf Grund fehlender Win32 API
Unterstützung auf diesem System nicht genutzt werden.
ENDTEXT
MESSAGEBOX(lcMsg,0+16+0,[Programminformation])
This.Release
ENDTRY
ENDPROC
ENDDEFINE
Keine Kommentare:
Kommentar veröffentlichen