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

mbColorLib: Eliminate effect of ScreenWin on result of TmbDeskPickerButton (based on code by forum user "d-_-b", https://forum.lazarus.freepascal.org/index.php/topic,46415.0.html)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7130 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-08-15 09:48:55 +00:00
parent b40b912d74
commit 0fd65273d4
1 changed files with 30 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
components/mbColorLib/ScreenWin.pas
View File

@ -29,6 +29,8 @@ type
private private
FOnSelColorChange: TNotifyEvent; FOnSelColorChange: TNotifyEvent;
FOnKeyDown: TKeyEvent; FOnKeyDown: TKeyEvent;
function GetDesktopColor(const X, Y: Integer): TColor;
function ReadScreenColor(const X, Y: Integer): TColor;
protected protected
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
@ -51,21 +53,6 @@ implementation
uses uses
HTMLColors; HTMLColors;
function GetDesktopColor(const X, Y: Integer): TColor;
var
c: TCanvas;
screenDC: HDC;
begin
c := TCanvas.Create;
try
screenDC := GetDC(0);
c.Handle := screenDC;
Result := c.Pixels[X, Y];
finally
c.Free;
end;
end;
{ TScreenForm } { TScreenForm }
@ -139,4 +126,32 @@ begin
Top := 0; Top := 0;
end; end;
function TScreenForm.GetDesktopColor(const X, Y: Integer): TColor;
var
savedAlphaBlendValue: Integer;
begin
savedAlphaBlendValue := AlphablendValue;
try
AlphaBlendValue := 0;
Result := ReadScreenColor(X, Y);
finally
AlphaBlendValue := savedAlphaBlendValue;
end;
end;
function TScreenForm.ReadScreenColor(const X, Y: Integer): TColor;
var
c: TCanvas;
screenDC: HDC;
begin
c := TCanvas.Create;
try
screenDC := GetDC(0);
c.Handle := screenDC;
Result := c.Pixels[X, Y];
finally
c.Free;
end;
end;
end. end.