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

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

View File

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

View File

@ -86,6 +86,12 @@ end;
procedure TScreenForm.FormCreate(Sender: TObject);
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;
Screen.Cursors[crPickerCursor] := LoadCursor(HInstance, 'PickerCursor');
Cursor := crPickerCursor;
@ -139,19 +145,25 @@ begin
end;
end;
function TScreenForm.ReadScreenColor(const X, Y: Integer): TColor;
function TScreenForm.ReadScreenColor(const X, Y: integer):TColor;
var
c: TCanvas;
screenDC: HDC;
ScreenDC: HDC;
SaveBitmap: TBitmap;
begin
c := TCanvas.Create;
SaveBitmap := TBitmap.Create;
try
screenDC := GetDC(0);
c.Handle := screenDC;
Result := c.Pixels[X, Y];
SaveBitmap.SetSize(Screen.Width, Screen.Height);
ScreenDC := GetDC(0);
try
SaveBitmap.LoadFromDevice(ScreenDC);
finally
ReleaseDC(0, ScreenDC);
end;
Result := SaveBitmap.Canvas.Pixels[X, Y];
finally
c.Free;
SaveBitmap.Free;
end;
end;
end.