pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

mbColorLib: Fix colorpickerbutton (did not work unter Linux qt).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7131 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-08-15 10:27:13 +00:00
parent 0fd65273d4
commit 5aa5b8cfe2
2 changed files with 25 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
components/mbColorLib/ScreenWin.lfm
View File

@@ -1,15 +1,14 @@
object ScreenForm: TScreenForm object ScreenForm: TScreenForm
Left = 198 Left = 0
Height = 96 Height = 190
Top = 117 Top = 0
Width = 149 Width = 307
Align = alClient Align = alClient
AlphaBlend = True AlphaBlend = True
AlphaBlendValue = 1 AlphaBlendValue = 1
BorderIcons = [] BorderIcons = []
BorderStyle = bsNone BorderStyle = bsNone
Caption = 'Pick a color...' Caption = 'Pick a color...'
Color = clBtnFace
Font.Color = clWindowText Font.Color = clWindowText
FormStyle = fsStayOnTop FormStyle = fsStayOnTop
OnCreate = FormCreate OnCreate = FormCreate
@@ -18,5 +17,5 @@ object ScreenForm: TScreenForm
OnMouseUp = FormMouseUp OnMouseUp = FormMouseUp
OnShow = FormShow OnShow = FormShow
Position = poDefault Position = poDefault
LCLVersion = '1.7' LCLVersion = '2.1.0.0'
end end

28
components/mbColorLib/ScreenWin.pas
View File

@@ -86,6 +86,12 @@ end;
procedure TScreenForm.FormCreate(Sender: TObject); procedure TScreenForm.FormCreate(Sender: TObject);
begin begin
// The screen form is the same size of the screen and is transparent.
// Unfortunately it cannot be made fully transparent (AlphaBlendvalue=0)
// because it would not react on mouse event this way.
AlphaBlendValue := 1; // range 0..255; 1 is "almost" transparent
AlphaBlend := true;
Brush.Style := bsClear; Brush.Style := bsClear;
Screen.Cursors[crPickerCursor] := LoadCursor(HInstance, 'PickerCursor'); Screen.Cursors[crPickerCursor] := LoadCursor(HInstance, 'PickerCursor');
Cursor := crPickerCursor; Cursor := crPickerCursor;
@@ -139,19 +145,25 @@ begin
end; end;
end; end;
function TScreenForm.ReadScreenColor(const X, Y: Integer): TColor; function TScreenForm.ReadScreenColor(const X, Y: integer):TColor;
var var
c: TCanvas; ScreenDC: HDC;
screenDC: HDC; SaveBitmap: TBitmap;
begin begin
c := TCanvas.Create; SaveBitmap := TBitmap.Create;
try try
screenDC := GetDC(0); SaveBitmap.SetSize(Screen.Width, Screen.Height);
c.Handle := screenDC; ScreenDC := GetDC(0);
Result := c.Pixels[X, Y]; try
SaveBitmap.LoadFromDevice(ScreenDC);
finally
ReleaseDC(0, ScreenDC);
end;
Result := SaveBitmap.Canvas.Pixels[X, Y];
finally finally
c.Free; SaveBitmap.Free;
end; end;
end; end;
end. end.