mbColorLib: Fix DeskPickerButton.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5483 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-14 10:35:17 +00:00
parent 857380bf12
commit 524a3881c6
6 changed files with 45 additions and 45 deletions

View File

@ -4,6 +4,8 @@ object ScreenForm: TScreenForm
Top = 117
Width = 149
Align = alClient
AlphaBlend = True
AlphaBlendValue = 1
BorderIcons = []
BorderStyle = bsNone
Caption = 'Pick a color...'

View File

@ -33,7 +33,6 @@ type
FOnKeyDown: TKeyEvent;
protected
procedure CreateParams(var Params:TCreateParams); override;
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
public
@ -62,18 +61,20 @@ begin
end;
function GetDesktopColor(const X, Y: Integer): TColor;
{$IFDEF DELPHI}
var
c: TCanvas;
screenDC: HDC;
begin
c := TCanvas.Create;
try
c.Handle := GetWindowDC(GetDesktopWindow);
Result := GetPixel(c.Handle, X, Y);
screenDC := GetDC(0);
c.Handle := screenDC;
Result := c.Pixels[X, Y];
finally
c.Free;
c.Free;
end;
end;
(*
{$ELSE}
var
bmp: TBitmap;
@ -87,12 +88,7 @@ begin
bmp.Free;
end;
{$ENDIF}
procedure TScreenForm.CreateParams(var Params:TCreateParams);
Begin
inherited CreateParams(Params);
Params.ExStyle := WS_EX_TRANSPARENT or WS_EX_TOPMOST;
end;
*)
procedure TScreenForm.FormShow(Sender: TObject);
begin
@ -114,19 +110,23 @@ end;
procedure TScreenForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key = VK_ESCAPE) or (ssAlt in Shift) or (ssCtrl in Shift) then
EndSelection(0, 0, false);
if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);
if (key = VK_ESCAPE) or (ssAlt in Shift) or (ssCtrl in Shift) then
EndSelection(0, 0, false);
if (key = VK_RETURN) then
EndSelection(Mouse.CursorPos.X, Mouse.CursorPos.Y, true);
if Assigned(FOnKeyDown) then
FOnKeyDown(Self, Key, Shift);
end;
procedure TScreenForm.EndSelection(x, y: integer; ok: boolean);
begin
if ok then
SelectedColor := GetDesktopColor(x, y)
else
SelectedColor := clNone;
close;
if Assigned(FOnSelColorChange) then FOnSelColorChange(Self);
if ok then
SelectedColor := GetDesktopColor(x, y)
else
SelectedColor := clNone;
Close;
if Assigned(FOnSelColorChange) then
FOnSelColorChange(Self);
end;
procedure TScreenForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
@ -138,25 +138,26 @@ end;
procedure TScreenForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
SelectedColor := GetDesktopColor(x, y);
if Assigned(FOnSelColorChange) then FOnSelColorChange(Self);
SelectedColor := GetDesktopColor(x, y);
if Assigned(FOnSelColorChange) then FOnSelColorChange(Self);
Application.ProcessMessages;
end;
procedure TScreenForm.CMHintShow(var Message: TCMHintShow);
begin
with TCMHintShow(Message) do
if not ShowHint then
Message.Result := 1
else
with HintInfo^ do
begin
Result := 0;
ReshowTimeout := 1;
HideTimeout := 5000;
HintPos := Point(HintPos.X + 16, HintPos.y - 16);
HintStr := FormatHint(FHintFormat, SelectedColor);
end;
inherited;
with TCMHintShow(Message) do
if not ShowHint then
Message.Result := 1
else
with HintInfo^ do
begin
Result := 0;
ReshowTimeout := 1;
HideTimeout := 5000;
HintPos := Point(HintPos.X + 16, HintPos.y - 16);
HintStr := FormatHint(FHintFormat, SelectedColor);
end;
inherited;
end;
end.

View File

@ -62,11 +62,6 @@
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>

View File

@ -56,7 +56,7 @@ object Form1: TForm1
Height = 287
Top = 8
Width = 377
SelectedColor = 488198
SelectedColor = 488454
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex'
LPickerHintFormat = 'Luminance: %l'
Anchors = [akTop, akLeft, akRight, akBottom]
@ -691,6 +691,7 @@ object Form1: TForm1
TabOrder = 0
OnSelColorChange = mbDeskPickerButton1SelColorChange
ScreenHintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h'
ShowScreenHint = True
end
object Button3: TButton
Left = 8

View File

@ -211,7 +211,7 @@ end;
procedure TForm1.mbColorPalette1SelColorChange(Sender: TObject);
begin
sc.color := mbcolorpalette1.selectedcolor;
uc.Color := mbColorPalette1.SelectedColor;
end;
procedure TForm1.mbColorPalette1MouseMove(Sender: TObject;
@ -401,6 +401,7 @@ procedure TForm1.CbShowHintsChange(Sender: TObject);
begin
PageControl1.ShowHint := CbShowHints.Checked;
mbOfficeColorDialog1.UseHints := CbShowHints.Checked;
mbDeskPickerButton1.ShowScreenHint := CbShowHints.Checked;
end;
end.

View File

@ -51,7 +51,7 @@ constructor TmbDeskPickerButton.Create(AOwner: TComponent);
begin
inherited;
DoubleBuffered := true;
ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}];
// ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}];
FHintFmt := 'RGB(%r, %g, %b)'#13'Hex: %h';
FShowScreenHint := false;
end;
@ -80,8 +80,8 @@ end;
procedure TmbDeskPickerButton.ColorPicked(Sender: TObject);
begin
FSelColor := ScreenFrm.SelectedColor;
if Assigned(FOnColorPicked) then FOnColorPicked(Self);
FSelColor := ScreenFrm.SelectedColor;
if Assigned(FOnColorPicked) then FOnColorPicked(Self);
end;
procedure TmbDeskPickerButton.ScreenKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);