You've already forked lazarus-ccr
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:
@ -4,6 +4,8 @@ object ScreenForm: TScreenForm
|
||||
Top = 117
|
||||
Width = 149
|
||||
Align = alClient
|
||||
AlphaBlend = True
|
||||
AlphaBlendValue = 1
|
||||
BorderIcons = []
|
||||
BorderStyle = bsNone
|
||||
Caption = 'Pick a color...'
|
||||
|
@ -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;
|
||||
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
|
||||
@ -116,7 +112,10 @@ procedure TScreenForm.FormKeyDown(Sender: TObject; var Key: Word;
|
||||
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_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);
|
||||
@ -125,8 +124,9 @@ begin
|
||||
SelectedColor := GetDesktopColor(x, y)
|
||||
else
|
||||
SelectedColor := clNone;
|
||||
close;
|
||||
if Assigned(FOnSelColorChange) then FOnSelColorChange(Self);
|
||||
Close;
|
||||
if Assigned(FOnSelColorChange) then
|
||||
FOnSelColorChange(Self);
|
||||
end;
|
||||
|
||||
procedure TScreenForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
@ -140,6 +140,7 @@ procedure TScreenForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||
begin
|
||||
SelectedColor := GetDesktopColor(x, y);
|
||||
if Assigned(FOnSelColorChange) then FOnSelColorChange(Self);
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
|
||||
procedure TScreenForm.CMHintShow(var Message: TCMHintShow);
|
||||
|
@ -62,11 +62,6 @@
|
||||
<Debugging>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
@ -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;
|
||||
|
Reference in New Issue
Block a user