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

mbColorLib: Add TmbDeskPickerAction for more flexible picking of colors from desktop.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5559 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-22 14:46:18 +00:00
parent dfd7cb0a8a
commit d6e3ba3a4f
4 changed files with 153 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

135
components/mbColorLib/mbDeskPickerButton.pas
View File

@ -1,11 +1,14 @@
unit mbDeskPickerButton;
{$MODE DELPHI}
//{$MODE DELPHI}
{$MODE ObjFPC}{$H+}
interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, StdCtrls, Graphics, Forms, ScreenWin;
LCLIntf, LCLType, SysUtils, Classes, Controls, StdCtrls, Graphics, Forms,
ActnList,
ScreenWin;
type
TmbDeskPickerButton = class(TButton)
@ -38,6 +41,50 @@ type
property OnSelMouseWheelUp: TMouseWheelUpDownEvent read FOnWheelUp write FOnWheelUp;
end;
TmbDeskPickerAction = class(TCustomAction)
private
FHintFmt: String;
FSelColor: TColor;
FScreenFrm: TScreenForm;
FShowScreenHint: Boolean;
FOnWheelUp, FOnWheelDown: TMouseWheelUpdownEvent;
FOnColorPicked: TNotifyEvent;
FOnScreenKeyDown: TKeyEvent;
protected
procedure ColorPicked(Sender: TObject);
procedure ScreenKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure StartPicking;
procedure WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint;
var Handled: Boolean);
procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint;
var Handled: Boolean);
public
constructor Create(AOwner: TComponent); override;
procedure ExecuteTarget(Target: TObject); override;
function HandlesTarget(Target: TObject): Boolean; override;
// procedure UpdateTarget(Target: TObject); override;
published
property Caption;
property Enabled;
property HelpContext;
property HelpKeyword;
property HelpType;
property Hint;
property ImageIndex;
property ScreenHintFormat: string read FHintFmt write FHintFmt;
property SecondaryShortCuts;
property SelectedColor: TColor read FSelColor;
property ShortCut;
property ShowScreenHint: boolean read FShowScreenHint write FShowScreenHint default false;
property Visible;
property OnExecute;
property OnHint;
property OnScreenKeyDown: TKeyEvent read FOnScreenKeyDown write FOnScreenKeyDown;
property OnSelColorChange: TNotifyEvent read FOnColorPicked write FOnColorPicked;
property OnSelMouseWheelDown: TMouseWheelUpDownEvent read FOnWheelDown write FOnWheelDown;
property OnSelMouseWheelUp: TMouseWheelUpDownEvent read FOnWheelUp write FOnWheelUp;
property OnUpdate;
end;
implementation
@ -63,14 +110,20 @@ begin
FOnColorPicked(Self);
end;
procedure TmbDeskPickerButton.ScreenKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Assigned(FOnKeyDown) then
FOnKeyDown(Self, Key, Shift);
end;
procedure TmbDeskPickerButton.StartPicking;
begin
FScreenFrm := TScreenForm.Create(Application);
try
FScreenFrm.OnSelColorChange := ColorPicked;
FScreenFrm.OnScreenKeyDown := ScreenKeyDown;
FScreenFrm.OnMouseWheelDown := WheelDown;
FScreenFrm.OnMouseWheelUp := WheelUp;
FScreenFrm.OnSelColorChange := @ColorPicked;
FScreenFrm.OnScreenKeyDown := @ScreenKeyDown;
FScreenFrm.OnMouseWheelDown := @WheelDown;
FScreenFrm.OnMouseWheelUp := @WheelUp;
FScreenFrm.ShowHint := FShowScreenHint;
FScreenFrm.FHintFormat := FHintFmt;
FScreenFrm.ShowModal;
@ -79,12 +132,6 @@ begin
end;
end;
procedure TmbDeskPickerButton.ScreenKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Assigned(FOnKeyDown) then
FOnKeyDown(Self, Key, Shift);
end;
procedure TmbDeskPickerButton.WheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
@ -99,4 +146,68 @@ begin
FOnWheelDown(Self, Shift, MousePos, Handled);
end;
{ TmbDeskPickerAction }
constructor TmbDeskPickerAction.Create(AOwner: TComponent);
begin
inherited;
FHintFmt := 'RGB(%r, %g, %b)'#13'Hex: %h';
end;
procedure TmbDeskPickerAction.ExecuteTarget(Target: TObject);
begin
StartPicking;
end;
function TmbDeskPickerAction.HandlesTarget(Target: TObject): Boolean;
begin
Result := true;
end;
procedure TmbDeskPickerAction.ScreenKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Assigned(FOnScreenKeyDown) then
FOnScreenKeyDown(Self, Key, Shift);
end;
procedure TmbDeskPickerAction.ColorPicked(Sender: TObject);
begin
FSelColor := FScreenFrm.SelectedColor;
if Assigned(FOnColorPicked) then
FOnColorPicked(Self);
end;
procedure TmbDeskPickerAction.StartPicking;
begin
FScreenFrm := TScreenForm.Create(Application);
try
FScreenFrm.OnSelColorChange := @ColorPicked;
FScreenFrm.OnScreenKeyDown := @ScreenKeyDown;
FScreenFrm.OnMouseWheelDown := @WheelDown;
FScreenFrm.OnMouseWheelUp := @WheelUp;
FScreenFrm.ShowHint := FShowScreenHint;
FScreenFrm.FHintFormat := FHintFmt;
FScreenFrm.ShowModal;
finally
FScreenFrm.Free;
end;
end;
procedure TmbDeskPickerAction.WheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
if Assigned(FOnWheelUp) then
FOnWheelUp(Self, Shift, MousePos, Handled);
end;
procedure TmbDeskPickerAction.WheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
if Assigned(FOnWheelDown) then
FOnWheelDown(Self, Shift, MousePos, Handled);
end;
end.