ColorPalette: Add new properties "PickMode" and "PickShift" to select when and by which mouse button the color is selected. Some reorganisation of code. Update demo.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4279 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/colorpalette/colorpalette.pas

@@ -52,6 +52,15 @@ uses
   
 type
 
+  TPickMode = (
+    pmDefault,   // Select color at mouse-down, ColorPick event at mouse-up if at same pos
+    pmImproved,  // Select color and ColorPick event at mouse-down
+    pmContinuous // Select color at mouse-down and mouse-move, ColorPick event at mouse-up
+  );
+
+  TPickShiftEnum = (ssLeft, ssRight, ssMiddle);
+  TPickShift = set of TPickShiftEnum;
+
   TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of object;
 
   { TCustomColorPalette }
@@ -65,7 +74,13 @@ type
     FOnColorPick: TColorMouseEvent;
     FRows: Integer;
     FColors: TList;
-    MX, MY: integer;
+    FPickedColor: TColor;
+    FPickMode: TPickMode;
+    FPickShift: TPickShift;
+    FMousePt: TPoint;
+    FMouseIndex: Integer;
+    FPrevMouseIndex: Integer;
+    FStoredShift: TShiftState;
     function GetColorCount: Integer;
     function GetColors(Index: Integer): TColor;
     procedure SetButtonHeight(const AValue: Integer);
@@ -73,17 +88,21 @@ type
     procedure SetColors(Index: Integer; const AValue: TColor);
     procedure SetCols(AValue: Integer);
   protected
-    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
-    procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
-    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
     procedure ColorPick(AColor: TColor; Shift: TShiftState); dynamic;
     procedure ColorMouseMove(AColor: TColor; Shift: TShiftState); dynamic;
     procedure DoAddColor(AColor: TColor); virtual;
     procedure DoDeleteColor(AIndex: Integer); virtual;
+    function IsCorrectShift(Shift: TShiftState): Boolean;
+    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
+    procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
     procedure UpdateSize; virtual;
+    property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
+    property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
+    property ColumnCount: Integer read FCols write SetCols;
+    property PickMode: TPickMode read FPickMode write FPickMode default pmDefault;
+    property PickShift: TPickShift read FPickShift write FPickShift default [ssLeft];
   public
-    PickedColor: TColor;
-    PickShift: TShiftState;
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     procedure Paint; override;
@@ -93,11 +112,9 @@ type
     procedure LoadPalette(const FileName: String);
     procedure SavePalette(const FileName: String);
   
-    property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
-    property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
     property Colors[Index: Integer]: TColor read GetColors write SetColors;
     property ColorCount: Integer read GetColorCount;
-    property ColumnCount: Integer read FCols write SetCols;
+    property PickedColor: TColor read FPickedColor;
 
     property OnColorPick: TColorMouseEvent read FOnColorPick write FOnColorPick;
     property OnColorMouseMove: TColorMouseEvent read FOnColorMouseMove write FOnColorMouseMove;
@@ -123,6 +140,8 @@ type
     property Hint;
     property ParentColor;
     property ParentShowHint;
+    property PickMode;
+    property PickShift;
     property PopupMenu;
     property ShowHint;
     property Visible;
@@ -180,6 +199,7 @@ end;
 procedure TCustomColorPalette.SetColors(Index: Integer; const AValue: TColor);
 begin
   FColors.Items[Index] := Pointer(AValue);
+  Invalidate;
 end;
 
 procedure TCustomColorPalette.SetCols(AValue: Integer);
@@ -205,27 +225,49 @@ procedure TCustomColorPalette.MouseDown(Button: TMouseButton;
 begin
   inherited;
 
-  MX := X;
+  FMousePt.X := X;
-  MY := Y;
+  FMousePt.Y := Y;
 
   X := X div FButtonWidth;
   Y := Y div FButtonHeight;
 
-  if X + Y * FCols < 0 then
+  FMouseIndex := X + Y * FCols;
+  FPrevMouseIndex := FMouseIndex;
+
+  if FMouseIndex < 0 then
     Exit;
 
-  if X + Y * FCols < FColors.Count then
+  if (FMouseIndex < FColors.Count) then
   begin
-    PickedColor := GetColors(X + Y * FCols);
+    FPickedColor := GetColors(FMouseIndex);
-    PickShift := Shift;
+    FStoredShift := Shift;       // store for usage by pmDefault at MouseUp
+    if FPickMode <> pmDefault then
+      ColorPick(FPickedColor, Shift);
   end;
 end;
 
 procedure TCustomColorPalette.MouseUp(Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
-  if (PickedColor <> clNone) and (MX = X) and (MY = Y) then
+  case FPickMode of
-    ColorPick(PickedColor, PickShift);
+    pmDefault:
+      if (FMousePt.X = X) and (FMousePt.Y = Y) then
+        ColorPick(FPickedColor, FStoredShift);
+    pmImproved, pmContinuous:
+      begin
+        X := X div FButtonWidth;
+        Y := Y div FButtonHeight;
+        FMouseIndex := X + Y * FCols;
+        if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
+           (FMouseIndex <> FPrevMouseIndex) then
+        begin
+          FPickedColor := GetColors(FMouseIndex);
+          ColorPick(FPickedColor, Shift);
+        end;
+      end;
+  end;
+  FPrevMouseIndex := -1;
+
   inherited;
 end;
 
@@ -238,23 +280,44 @@ begin
   X := X div FButtonWidth;
   Y := Y div FButtonHeight;
 
-  if X + Y * FCols < 0 then
+  FMouseIndex := X + Y * FCols;
-    Exit;
+  if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
-  if X + Y * FCols < FColors.Count then
+     (FMouseIndex <> FPrevMouseIndex) then
   begin
-    C := GetColors(X + Y * FCols);
+    C := GetColors(FMouseIndex);
-    if C <> clNone then ColorMouseMove(C, Shift);
+    if C <> clNone then
+      ColorMouseMove(C, Shift);
+
+    if FPickMode = pmContinuous then begin
+      FPickedColor := GetColors(FMouseIndex);
+      ColorPick(FPickedColor, Shift);
+    end;
   end;
+
+  FPrevMouseIndex := FMouseIndex;
+end;
+
+function TCustomColorPalette.IsCorrectShift(Shift: TShiftState): Boolean;
+var
+  ss: TShiftState;
+begin
+  Result := True;
+  if (ssLeft in FPickShift) and (Classes.ssLeft in Shift) then exit;
+  if (ssRight in FPickShift) and (Classes.ssRight in Shift) then exit;
+  if (ssMiddle in FPickShift) and (Classes.ssMiddle in Shift) then exit;
+  Result := false;
 end;
 
 procedure TCustomColorPalette.ColorPick(AColor: TColor; Shift: TShiftState);
 begin
-  if Assigned(FOnColorPick) then FOnColorPick(Self, AColor, Shift);
+  if IsCorrectShift(Shift) and Assigned(FOnColorPick) then
+    FOnColorPick(Self, AColor, Shift);
 end;
 
 procedure TCustomColorPalette.ColorMouseMove(AColor: TColor; Shift: TShiftState);
 begin
-  if Assigned(FOnColorMouseMove) then FOnColorMouseMove(Self, AColor, Shift);
+  if IsCorrectShift(Shift) and Assigned(FOnColorMouseMove) then
+    FOnColorMouseMove(Self, AColor, Shift);
 end;
 
 constructor TCustomColorPalette.Create(TheOwner: TComponent);
@@ -264,6 +327,8 @@ begin
   FColors := TList.Create;
   FButtonWidth := 12;
   FButtonHeight := 12;
+  FPrevMouseIndex := -1;
+  FPickShift := [ssLeft];
   ControlStyle := ControlStyle + [csFixedWidth, csFixedHeight];
   
   FCols := 8;

components/colorpalette/demo/project1.lpi

@@ -9,6 +9,7 @@
       <Title Value="project1"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>

components/colorpalette/demo/unit1.lfm

@@ -1,7 +1,7 @@
 object MainForm: TMainForm
-  Left = 522
+  Left = 358
   Height = 502
-  Top = 211
+  Top = 179
   Width = 455
   Caption = 'MainForm'
   ClientHeight = 502
@@ -17,8 +17,10 @@ object MainForm: TMainForm
     ButtonWidth = 16
     ButtonHeight = 16
     ColumnCount = 8
+    PickShift = [ssLeft, ssMiddle]
     PopupMenu = PalettePopupMenu
     OnColorPick = ColorPaletteColorPick
+    OnDblClick = ColorPaletteDblClick
     OnMouseDown = ColorPaletteMouseDown
   end
   object Panel1: TPanel
@@ -35,7 +37,7 @@ object MainForm: TMainForm
       Left = 10
       Height = 29
       Top = 13
-      Width = 69
+      Width = 63
     end
     object LblInfo: TLabel
       Left = 12
@@ -50,11 +52,11 @@ object MainForm: TMainForm
       WordWrap = True
     end
     object BtnEditColor: TButton
-      Left = 91
+      Left = 83
       Height = 19
       Hint = 'Edit current color'
       Top = 13
-      Width = 56
+      Width = 64
       Caption = 'Edit'
       OnClick = BtnEditColorClick
       TabOrder = 0
@@ -62,7 +64,7 @@ object MainForm: TMainForm
     object BtnLoadRndPalette: TButton
       Left = 10
       Height = 25
-      Top = 188
+      Top = 190
       Width = 137
       Caption = 'Load random palette'
       Enabled = False
@@ -99,7 +101,7 @@ object MainForm: TMainForm
     object BtnDeleteCurrent: TButton
       Left = 10
       Height = 25
-      Top = 314
+      Top = 311
       Width = 137
       Caption = 'Delete color #0'
       OnClick = BtnDeleteCurrentClick
@@ -108,10 +110,9 @@ object MainForm: TMainForm
     object BtnLoadDefaultPal1: TButton
       Left = 10
       Height = 25
-      Top = 227
+      Top = 228
       Width = 137
       Caption = 'Save palette...'
-      OnClick = BtnLoadDefaultPal1Click
       TabOrder = 6
     end
     object LblPaletteSize: TLabel
@@ -140,6 +141,32 @@ object MainForm: TMainForm
       Caption = 'Column count:'
       ParentColor = False
     end
+    object CbPickMode: TComboBox
+      Left = 12
+      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'pmImproved:'#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
+      Width = 135
+      ItemHeight = 15
+      ItemIndex = 0
+      Items.Strings = (
+        'default'
+        'improved'
+        'continuous'
+      )
+      OnSelect = CbPickModeSelect
+      Style = csDropDownList
+      TabOrder = 8
+      Text = 'default'
+    end
+    object LblPickMode: TLabel
+      Left = 12
+      Height = 15
+      Top = 355
+      Width = 56
+      Caption = 'Pick mode'
+      ParentColor = False
+    end
   end
   object Bevel1: TBevel
     Left = 160

components/colorpalette/demo/unit1.pas

@@ -23,6 +23,8 @@ type
     BtnEditColor: TButton;
     ColorDialog: TColorDialog;
     ColorPalette: TColorPalette;
+    CbPickMode: TComboBox;
+    LblPickMode: TLabel;
     LblPaletteSize: TLabel;
     EdColCount: TSpinEdit;
     Label2: TLabel;
@@ -33,14 +35,15 @@ type
     Panel1: TPanel;
     SaveDialog: TSaveDialog;
     curColor: TShape;
-    procedure BtnDeleteCurrentClick(Sender: TObject);
-    procedure BtnLoadDefaultPal1Click(Sender: TObject);
-    procedure BtnLoadRndPaletteClick(Sender: TObject);
-    procedure BtnCreateRndPaletteClick(Sender: TObject);
     procedure BtnAddColorClick(Sender: TObject);
+    procedure BtnCreateRndPaletteClick(Sender: TObject);
+    procedure BtnDeleteCurrentClick(Sender: TObject);
     procedure BtnLoadDefaultPalClick(Sender: TObject);
+    procedure BtnLoadRndPaletteClick(Sender: TObject);
+    procedure CbPickModeSelect(Sender: TObject);
     procedure ColorPaletteColorPick(Sender: TObject; AColor: TColor;
       Shift: TShiftState);
+    procedure ColorPaletteDblClick(Sender: TObject);
     procedure ColorPaletteMouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure EdColCountChange(Sender: TObject);
@@ -53,6 +56,7 @@ type
     curIndex: integer;
     procedure EditCurColor;
     procedure SetLabel(ATitle: string; AColor: TColor);
+    procedure UpdateColorCountInfo;
     procedure UpdatePalette;
   public
     { public declarations }
@@ -72,7 +76,7 @@ procedure TMainForm.BtnAddColorClick(Sender: TObject);
 begin
   if ColorDialog.Execute then
     ColorPalette.AddColor(ColorDialog.Color);
-  LblPaletteSize.caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
+  LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
 end;
 
 procedure TMainForm.BtnCreateRndPaletteClick(Sender: TObject);
@@ -108,6 +112,9 @@ begin
       DeleteColor(curIndex);
       if curIndex = ColorCount then dec(curIndex);
       curColor.Brush.Color := Colors[curIndex] ;
+      if Colors[curIndex] = clNone then
+        curColor.Brush.Style := bsClear else
+        curColor.Brush.Style := bsSolid;
       LblPaletteSize.Caption := IntToStr(ColorCount) + ' colors available';
       SetLabel('Current', ColorPalette.Colors[curIndex]);
     end;
@@ -126,15 +133,6 @@ begin
   EdColCount.Value := ColorPalette.ColumnCount;
 end;
 
-procedure TMainForm.BtnLoadDefaultPal1Click(Sender: TObject);
-begin
-  Showmessage('???');
-  SaveDialog.FileName := 'random_palette.pal';
-  SaveDialog.InitialDir := ExtractFileDir(ParamStr(0));
-  if SaveDialog.Execute then
-    ColorPalette.SavePalette(SaveDialog.FileName);
-end;
-
 procedure TMainForm.BtnLoadRndPaletteClick(Sender: TObject);
 begin
   ColorPalette.LoadPalette('random_palette.pal');
@@ -150,13 +148,41 @@ begin
     UpdatePalette;
 end;
 
+procedure TMainForm.CbPickModeSelect(Sender: TObject);
+begin
+  ColorPalette.PickMode := TPickMode(CbPickMode.ItemIndex);
+end;
+
 procedure TMainForm.ColorPaletteColorPick(Sender: TObject; AColor: TColor;
   Shift: TShiftState);
 begin
   curColor.Brush.Color := ColorPalette.PickedColor;
+  if ColorPalette.Colors[curIndex] = clNone then
+    curColor.Brush.Style := bsClear else
+    curColor.Brush.Style := bsSolid;
   SetLabel('PickedColor', ColorPalette.PickedColor);
 end;
 
+procedure TMainForm.ColorPaletteDblClick(Sender: TObject);
+begin
+  with ColorDialog do
+  begin
+    Color := ColorPalette.Colors[curIndex];
+    if Execute then
+    begin
+      ColorPalette.Colors[curIndex] := Color;
+      curColor.Brush.Color := Color;
+      curColor.Brush.Style := bsSolid;
+      SetLabel('Current', Color);
+      with  BtnEditColor do
+      begin
+        Caption := 'Edit';
+        Hint := 'Edit current color';
+      end;
+    end;
+  end;
+end;
+
 procedure TMainForm.ColorPaletteMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
@@ -180,12 +206,14 @@ begin
   with ColorDialog do
   begin
     Color := curColor.Brush.color;
-    if Execute then
+    if Execute then begin
       curColor.Brush.Color := Color;
+      curColor.Brush.Style := bsSolid;
+    end;
   end;
   if curColor.Brush.Color <> ColorPalette.PickedColor then
   begin
-    BtnEditColor.caption := 'Update';
+    BtnEditColor.caption := 'Update >';
     BtnEditColor.hint := 'Update palette';
     SetLabel('New color', curColor.Brush.Color);
   end;
@@ -195,9 +223,13 @@ procedure TMainForm.FormCreate(Sender: TObject);
 begin
   Caption := 'TColorPalette Demo';
   curIndex := 0;
-  curColor.brush.color := ColorPalette.Colors[0];
+  curColor.Brush.Color := ColorPalette.Colors[0];
   SetLabel('Current', ColorPalette.Colors[curIndex]);
-  LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
+  UpdateColorCountInfo;
+
+  { ColorPalette.PickShift must contain ssRight in order to be able to select
+    colors for the context menu. Use object inspector, or use this code:  }
+  ColorPalette.PickShift := [ssLeft, ssRight];
 end;
 
 procedure TMainForm.MnuDeletePickedColorClick(Sender: TObject);
@@ -220,10 +252,14 @@ begin
   );
 end;
 
+procedure TMainForm.UpdateColorCountInfo;
+begin
+  LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
+end;
+
 procedure TMainForm.UpdatePalette;
 begin
   ColorPalette.Colors[curIndex] := curColor.Brush.Color;
-  ColorPalette.Refresh;
   SetLabel('Current', ColorPalette.Colors[curIndex]);
   with  BtnEditColor do
   begin