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

ColorPalette: Support for popup hints.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4282 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-21 15:27:19 +00:00
parent 7d6e60fc65
commit 895bad7c04
3 changed files with 96 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

79
components/colorpalette/colorpalette.pas
View File

@ -84,7 +84,9 @@ type
FMouseIndex: Integer;
FPrevMouseIndex: Integer;
FStoredShift: TShiftState;
FShowColorHint: Boolean;
FShowSelection: Boolean;
FSavedHint: String;
function GetColorCount: Integer;
function GetColors(AIndex: Integer): TColor;
function GetPickedColor: TColor;
@ -93,6 +95,7 @@ type
procedure SetColors(AIndex: Integer; const AValue: TColor);
procedure SetCols(AValue: Integer);
procedure SetSelectedIndex(AValue: Integer);
// procedure SetShowColorHint(AValue: Boolean);
procedure SetShowSelection(AValue: Boolean);
protected
procedure ColorPick(AIndex: Integer; Shift: TShiftState); dynamic;
@ -101,8 +104,11 @@ type
procedure DoColorPick(AColor: TColor; AShift: TShiftState); virtual;
procedure DoDeleteColor(AIndex: Integer); virtual;
procedure DoSelectColor(AColor: TColor); virtual;
function GetHintText(AColor: TColor): String; virtual;
function IsCorrectShift(Shift: TShiftState): Boolean;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
procedure UpdateSize; virtual;
@ -112,6 +118,7 @@ type
property PickMode: TPickMode read FPickMode write FPickMode default pmDefault;
property PickShift: TPickShift read FPickShift write FPickShift default [ssLeft];
property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex default 0;
property ShowColorHint: Boolean read FShowColorHint write FShowColorHint default true;
property ShowSelection: Boolean read FShowSelection write SetShowSelection default false;
public
constructor Create(TheOwner: TComponent); override;
@ -157,6 +164,7 @@ type
property PickShift;
property PopupMenu;
property SelectedIndex;
property ShowColorHint;
property ShowHint;
property ShowSelection;
property Visible;
@ -198,6 +206,7 @@ begin
FButtonHeight := 12;
FPrevMouseIndex := -1;
FPickShift := [ssLeft];
FShowColorHint := true;
FCols := 8;
@ -296,6 +305,27 @@ begin
Result := TColor(PtrUInt(FColors.Items[AIndex]));
end;
function TCustomColorPalette.GetHintText(AColor: TColor): string;
const
INDENT = '* ';
MASK = '%sRed: %d'#13'%sGreen: %d'#13'%sBlue: %d';
begin
if AColor = clNone then
Result := 'NONE'
else
begin
Result := ColorToString(AColor);
if (Result[1] = 'c') and (Result[2] = 'l') then
begin
Delete(Result, 1, 2);
Result := Uppercase(Result) + #13 + Format(MASK, [
INDENT, Red(AColor), INDENT, Green(AColor), INDENT, Blue(AColor)]
);
end else
Result := Format(MASK, ['', Red(AColor), '', Green(AColor), '', Blue(AColor)]);
end;
end;
function TCustomColorPalette.GetPickedColor: TColor;
begin
Result := GetColors(FMouseIndex);
@ -424,25 +454,42 @@ begin
end;
end;
procedure TCustomColorPalette.MouseEnter;
begin
FSavedHint := Hint;
inherited;
end;
procedure TCustomColorPalette.MouseLeave;
begin
inherited;
Hint := FSavedHint;
end;
procedure TCustomColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer);
var
C: TColor;
begin
inherited;
X := X div FButtonWidth;
Y := Y div FButtonHeight;
FMouseIndex := X div FButtonWidth + (Y div FButtonHeight) * FCols;
FMouseIndex := X + Y * FCols;
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
(FMouseIndex <> FPrevMouseIndex) then
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) then
begin
C := GetColors(FMouseIndex);
if C <> clNone then
ColorMouseMove(C, Shift);
if FPickMode = pmContinuous then
ColorPick(FMouseIndex, Shift);
if ShowHint and FShowColorHint then
begin
Hint := GetHintText(c);
if FMouseIndex <> FPrevMouseIndex then
Application.ActivateHint(ClientToScreen(Point(X, Y)));
end;
if (FMouseIndex <> FPrevMouseIndex) then
begin
if C <> clNone then
ColorMouseMove(C, Shift);
if FPickMode = pmContinuous then
ColorPick(FMouseIndex, Shift);
end;
end;
FPrevMouseIndex := FMouseIndex;
@ -558,7 +605,17 @@ begin
UpdateSize;
Invalidate;
end;
{
procedure TCustomColorPalette.SetShowColorHint(AValue: Boolean);
begin
if FShowColorHint = AValue then exit;
if AValue then
FSavedHint := Hint
else
Hint := FSavedHint;
FShowColorHint := AValue;
end;
}
procedure TCustomColorPalette.SetShowSelection(AValue: Boolean);
begin
if FShowSelection = AValue then exit;

30
components/colorpalette/demo/unit1.lfm
View File

@ -12,6 +12,7 @@ object MainForm: TMainForm
object ColorPalette: TColorPalette
Left = 176
Height = 33
Hint = 'Click to select a color'
Top = 15
Width = 129
ButtonWidth = 16
@ -64,7 +65,7 @@ object MainForm: TMainForm
object BtnLoadRndPalette: TButton
Left = 10
Height = 25
Top = 190
Top = 181
Width = 137
Caption = 'Load random palette'
Enabled = False
@ -74,7 +75,7 @@ object MainForm: TMainForm
object BtnCreateRndPalette: TButton
Left = 10
Height = 25
Top = 161
Top = 152
Width = 137
Caption = 'Create random palette'
OnClick = BtnCreateRndPaletteClick
@ -83,7 +84,7 @@ object MainForm: TMainForm
object BtnAddColor: TButton
Left = 10
Height = 25
Top = 282
Top = 264
Width = 137
Caption = 'Add color...'
OnClick = BtnAddColorClick
@ -92,7 +93,7 @@ object MainForm: TMainForm
object BtnLoadDefaultPal: TButton
Left = 10
Height = 25
Top = 121
Top = 112
Width = 137
Caption = 'Load Default.pal'
OnClick = BtnLoadDefaultPalClick
@ -101,7 +102,7 @@ object MainForm: TMainForm
object BtnDeleteColor: TButton
Left = 10
Height = 25
Top = 311
Top = 293
Width = 137
Caption = 'Delete color #0'
OnClick = BtnDeleteColorClick
@ -110,7 +111,7 @@ object MainForm: TMainForm
object BtnLoadDefaultPal1: TButton
Left = 10
Height = 25
Top = 228
Top = 219
Width = 137
Caption = 'Save palette...'
TabOrder = 6
@ -137,7 +138,7 @@ object MainForm: TMainForm
Left = 11
Height = 23
Hint = 'Defines when the picked color is determined and when the OnPickColor event is generated:'#13#10#13#10'pmDefault: '#13#10' Color selection at mouse-down, OnPickColor event at mouse-up if at same location'#13#10#13#10'pmImmediate:'#13#10' Color selection and OnPickColor event at mouse-down'#13#10#13#10'pmContinuous:'#13#10' Color selection and OnPickColor event while mouse is down'
Top = 376
Top = 358
Width = 136
ItemHeight = 15
ItemIndex = 0
@ -154,7 +155,7 @@ object MainForm: TMainForm
object LblPickMode: TLabel
Left = 10
Height = 15
Top = 355
Top = 337
Width = 56
Caption = 'Pick mode'
ParentColor = False
@ -162,12 +163,23 @@ object MainForm: TMainForm
object CbShowSelection: TCheckBox
Left = 11
Height = 19
Top = 413
Top = 395
Width = 99
Caption = 'Show selection'
OnChange = CbShowSelectionChange
TabOrder = 9
end
object CbShowColorHints: TCheckBox
Left = 11
Height = 19
Top = 416
Width = 108
Caption = 'Show color hints'
Checked = True
OnChange = CbShowColorHintsChange
State = cbChecked
TabOrder = 10
end
end
object Bevel1: TBevel
Left = 160

7
components/colorpalette/demo/unit1.pas
View File

@ -22,6 +22,7 @@ type
BtnLoadDefaultPal: TButton;
BtnEditColor: TButton;
CbShowSelection: TCheckBox;
CbShowColorHints: TCheckBox;
ColorDialog: TColorDialog;
ColorPalette: TColorPalette;
CbPickMode: TComboBox;
@ -42,6 +43,7 @@ type
procedure BtnLoadDefaultPalClick(Sender: TObject);
procedure BtnLoadRndPaletteClick(Sender: TObject);
procedure CbPickModeSelect(Sender: TObject);
procedure CbShowColorHintsChange(Sender: TObject);
procedure CbShowSelectionChange(Sender: TObject);
procedure ColorPaletteDblClick(Sender: TObject);
procedure ColorPaletteMouseDown(Sender: TObject; Button: TMouseButton;
@ -149,6 +151,11 @@ begin
ColorPalette.PickMode := TPickMode(CbPickMode.ItemIndex);
end;
procedure TMainForm.CbShowColorHintsChange(Sender: TObject);
begin
ColorPalette.ShowColorHint := CbShowColorHints.Checked;
end;
procedure TMainForm.CbShowSelectionChange(Sender: TObject);
begin
ColorPalette.ShowSelection := CbShowSelection.Checked;