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

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

View File

@@ -12,30 +12,32 @@ uses
PalUtils;
const
crPickerCursor = 13;
crPickerCursor = 13;
type
TScreenForm = class(TForm)
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure EndSelection(x, y: integer; ok: boolean);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
TScreenForm = class(TForm)
procedure EndSelection(x, y: integer; ok: boolean);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormShow(Sender: TObject);
private
FOnSelColorChange: TNotifyEvent;
FOnKeyDown: TKeyEvent;
FOnSelColorChange: TNotifyEvent;
FOnKeyDown: TKeyEvent;
protected
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
public
FHintFormat: string;
SelectedColor: TColor;
property OnSelColorChange: TNotifyEvent read FOnSelColorChange write FOnSelColorChange;
property OnScreenKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
FHintFormat: string;
SelectedColor: TColor;
property OnSelColorChange: TNotifyEvent read FOnSelColorChange write FOnSelColorChange;
property OnScreenKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
end;
var
@@ -46,10 +48,8 @@ implementation
{$R *.lfm}
{$R PickCursor.res}
function ColorToHex(Color: TColor): string;
begin
Result := IntToHex(GetRValue(Color), 2) + IntToHex(GetGValue(Color), 2) + IntToHex(GetBValue(Color), 2);
end;
uses
HTMLColors;
function GetDesktopColor(const X, Y: Integer): TColor;
var