Merge branch 'release-1.4'

2 files changed, 210 insertions, 29 deletions

diff --git a/examples/gui/colorwheel/colorwheel_test.lpi b/examples/gui/colorwheel/colorwheel_test.lpi
index 3ad6b196..a0be0fc2 100644
--- a/examples/gui/colorwheel/colorwheel_test.lpi
+++ b/examples/gui/colorwheel/colorwheel_test.lpi
@@ -38,7 +38,6 @@
       <Unit0>
         <Filename Value="colorwheel_test.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="colorwheel_test"/>
       </Unit0>
       <Unit1>
         <Filename Value="frm_main.pas"/>
@@ -64,8 +63,5 @@
         <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
-    <Other>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
 </CONFIG>
diff --git a/examples/gui/colorwheel/frm_main.pas b/examples/gui/colorwheel/frm_main.pas
index 3633b740..612ea6c1 100644
--- a/examples/gui/colorwheel/frm_main.pas
+++ b/examples/gui/colorwheel/frm_main.pas
@@ -8,10 +8,34 @@ uses
   SysUtils, Classes, fpg_base, fpg_main, fpg_widget,
   fpg_edit, fpg_form, fpg_label, fpg_button,
   fpg_dialogs, fpg_menu, fpg_checkbox,
-  fpg_panel, fpg_ColorWheel;
+  fpg_panel, fpg_ColorWheel, fpg_spinedit;
 
 type
 
+  TColorPickedEvent = procedure(Sender: TObject; const AMousePos: TPoint; const AColor: TfpgColor) of object;
+
+
+  TPickerButton = class(TfpgButton)
+  private
+    FContinuousResults: Boolean;
+    FOnColorPicked: TColorPickedEvent;
+    FColorPos: TPoint;
+    FColor: TfpgColor;
+    FColorPicking: Boolean;
+  private
+    procedure   DoColorPicked;
+  protected
+    procedure   HandleLMouseDown(X, Y: integer; ShiftState: TShiftState); override;
+    procedure   HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
+    procedure   HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property    ContinuousResults: Boolean read FContinuousResults write FContinuousResults;
+    property    OnColorPicked: TColorPickedEvent read FOnColorPicked write FOnColorPicked;
+  end;
+
+
   TMainForm = class(TfpgForm)
   private
     {@VFD_HEAD_BEGIN: MainForm}
@@ -28,36 +52,134 @@ type
     Label4: TfpgLabel;
     Label5: TfpgLabel;
     Label6: TfpgLabel;
-    edR: TfpgEdit;
-    edG: TfpgEdit;
-    edB: TfpgEdit;
+    edR: TfpgSpinEdit;
+    edG: TfpgSpinEdit;
+    edB: TfpgSpinEdit;
+    lblHex: TfpgLabel;
     Label7: TfpgLabel;
     Label8: TfpgLabel;
     Bevel2: TfpgBevel;
     Label9: TfpgLabel;
     chkCrossHair: TfpgCheckBox;
     chkBGColor: TfpgCheckBox;
+    btnPicker: TPickerButton;
+    chkContinuous: TfpgCheckBox;
     {@VFD_HEAD_END: MainForm}
     FViaRGB: Boolean; // to prevent recursive changes
-    procedure btnQuitClicked(Sender: TObject);
-    procedure chkCrossHairChange(Sender: TObject);
-    procedure chkBGColorChange(Sender: TObject);
-    procedure UpdateHSVComponents;
-    procedure UpdateRGBComponents;
-    procedure ColorChanged(Sender: TObject);
-    procedure RGBChanged(Sender: TObject);
+    FColorPicking: Boolean;
+    procedure   btnColorPicked(Sender: TObject; const AMousePos: TPoint; const AColor: TfpgColor);
+    procedure   chkContinuousChanged(Sender: TObject);
+    procedure   btnQuitClicked(Sender: TObject);
+    procedure   chkCrossHairChange(Sender: TObject);
+    procedure   chkBGColorChange(Sender: TObject);
+    procedure   UpdateHSVComponents;
+    procedure   UpdateRGBComponents;
+    procedure   ColorChanged(Sender: TObject);
+    procedure   RGBChanged(Sender: TObject);
   public
     constructor Create(AOwner: TComponent); override;
-    procedure AfterCreate; override;
+    procedure   AfterCreate; override;
   end;
 
 {@VFD_NEWFORM_DECL}
 
 implementation
 
-
 {@VFD_NEWFORM_IMPL}
 
+function ConvertToHexa(Value: Integer): string;
+var
+  ValH,ValL: Integer;
+begin
+ValH:= Value div 16;
+ValL:= Value mod 16;
+case ValH of
+  15:
+    Result:= 'F';
+  14:
+    Result:= 'E';
+  13:
+    Result:= 'D';
+  12:
+    Result:= 'C';
+  11:
+    Result:= 'B';
+  10:
+    Result:= 'A';
+  else
+    Result:= IntToStr(ValH);
+  end;
+case ValL of
+  15:
+    Result:= Result+'F';
+  14:
+    Result:= Result+'E';
+  13:
+    Result:= Result+'D';
+  12:
+    Result:= Result+'C';
+  11:
+    Result:= Result+'B';
+  10:
+    Result:= Result+'A';
+  else
+    Result:= Result+IntToStr(ValL);
+  end;
+end;
+
+function Hexa(Red,Green,Blue: Integer): string;
+begin
+Result:= '$'+ConvertToHexa(Red)+ConvertToHexa(Green)+ConvertToHexa(Blue);
+end;
+
+{ TPickerButton }
+
+procedure TPickerButton.DoColorPicked;
+var
+  pt: TPoint;
+begin
+  pt := WindowToScreen(self, FColorPos);
+  FColor := fpgApplication.GetScreenPixelColor(pt);
+  if Assigned(FOnColorPicked) then
+    FOnColorPicked(self, FColorPos, FColor);
+end;
+
+procedure TPickerButton.HandleLMouseDown(X, Y: integer; ShiftState: TShiftState);
+begin
+  inherited HandleLMouseDown(X, Y, ShiftState);
+  MouseCursor := mcCross;
+  FColorPicking := True;
+  CaptureMouse;
+end;
+
+procedure TPickerButton.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
+begin
+  inherited HandleLMouseUp(x, y, shiftstate);
+  ReleaseMouse;
+  FColorPicking := False;
+  MouseCursor := mcDefault;
+  DoColorPicked;
+end;
+
+procedure TPickerButton.HandleMouseMove(x, y: integer; btnstate: word;
+  shiftstate: TShiftState);
+begin
+  //inherited HandleMouseMove(x, y, btnstate, shiftstate);
+  if not FColorPicking then
+    Exit;
+  FColorPos.x := x;
+  FColorPos.y := y;
+  if FContinuousResults then
+    DoColorPicked;
+end;
+
+constructor TPickerButton.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FColorPicking := False;
+  FContinuousResults := False;
+end;
+
 procedure TMainForm.ColorChanged(Sender: TObject);
 begin
   UpdateHSVComponents;
@@ -71,18 +193,30 @@ var
   c: TfpgColor;
 begin
   FViaRGB := True;  // revent recursive updates
-  rgb.Red := StrToInt(edR.Text);
-  rgb.Green := StrToInt(edG.Text);
-  rgb.Blue := StrToInt(edB.Text);
+  rgb.Red := edR.Value;
+  rgb.Green := edG.Value;
+  rgb.Blue := edB.Value;
   c := RGBTripleTofpgColor(rgb);
   ColorWheel1.SetSelectedColor(c);  // This will trigger ColorWheel and ValueBar OnChange event
   FViaRGB := False;
+  lblHex.Text:= 'Hex = '+ Hexa(rgb.Red,rgb.Green,rgb.Blue);
 end;
 
 constructor TMainForm.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FViaRGB := False;
+  FColorPicking := False;
+end;
+
+procedure TMainForm.btnColorPicked(Sender: TObject; const AMousePos: TPoint; const AColor: TfpgColor);
+begin
+  ColorWheel1.SetSelectedColor(AColor);
+end;
+
+procedure TMainForm.chkContinuousChanged(Sender: TObject);
+begin
+  btnPicker.ContinuousResults := chkContinuous.Checked;
 end;
 
 procedure TMainForm.btnQuitClicked(Sender: TObject);
@@ -127,9 +261,10 @@ var
 begin
   c := ValueBar1.SelectedColor;
   rgb := fpgColorToRGBTriple(c);
-  edR.Text := IntToStr(rgb.Red);
-  edG.Text := IntToStr(rgb.Green);
-  edB.Text := IntToStr(rgb.Blue);
+  edR.Value := rgb.Red;
+  edG.Value := rgb.Green;
+  edB.Value := rgb.Blue;
+  lblHex.Text:= 'Hex = '+ Hexa(rgb.Red,rgb.Green,rgb.Blue);
 end;
 
 procedure TMainForm.AfterCreate;
@@ -138,6 +273,7 @@ begin
   Name := 'MainForm';
   SetPosition(349, 242, 537, 411);
   WindowTitle := 'ColorWheel test app';
+  Hint := '';
   WindowPosition := wpUser;
 
   Button1 := TfpgButton.Create(self);
@@ -166,6 +302,7 @@ begin
   begin
     Name := 'ValueBar1';
     SetPosition(304, 20, 52, 244);
+    Value := 1;
     OnChange  := @ColorChanged;
   end;
 
@@ -174,6 +311,7 @@ begin
   begin
     Name := 'Bevel1';
     SetPosition(20, 288, 76, 56);
+    Hint := '';
   end;
 
   Label1 := TfpgLabel.Create(self);
@@ -275,39 +413,55 @@ begin
     Text := 'Blue';
   end;
 
-  edR := TfpgEdit.Create(self);
+  edR := TfpgSpinEdit.Create(self);
   with edR do
   begin
     Name := 'edR';
     SetPosition(296, 280, 44, 26);
     TabOrder := 13;
-    Text := '255';
+    MinValue := 0;
+    MaxValue := 255;
+    Value := 255;
     FontDesc := '#Edit1';
     OnExit  := @RGBChanged;
   end;
 
-  edG := TfpgEdit.Create(self);
+  edG := TfpgSpinEdit.Create(self);
   with edG do
   begin
     Name := 'edG';
     SetPosition(296, 308, 44, 26);
     TabOrder := 14;
-    Text := '255';
+    MinValue := 0;
+    MaxValue := 255;
+    Value := 255;
     FontDesc := '#Edit1';
     OnExit := @RGBChanged;
   end;
 
-  edB := TfpgEdit.Create(self);
+  edB := TfpgSpinEdit.Create(self);
   with edB do
   begin
     Name := 'edB';
     SetPosition(296, 336, 44, 26);
     TabOrder := 15;
-    Text := '255';
+    MinValue := 0;
+    MaxValue := 255;
+    Value := 255;
     FontDesc := '#Edit1';
     OnExit := @RGBChanged;
   end;
 
+  lblHex := TfpgLabel.Create(self);
+  with lblHex do
+  begin
+    Name := 'lblHex';
+    SetPosition(380, 316, 120, 16);
+    FontDesc := '#Label2';
+    Hint := '';
+    Text := 'Hex = ';
+  end;
+
   Label7 := TfpgLabel.Create(self);
   with Label7 do
   begin
@@ -333,6 +487,7 @@ begin
   begin
     Name := 'Bevel2';
     SetPosition(388, 8, 2, 260);
+    Hint := '';
     Style := bsLowered;
   end;
 
@@ -353,6 +508,7 @@ begin
     Name := 'chkCrossHair';
     SetPosition(396, 32, 128, 20);
     FontDesc := '#Label1';
+    Hint := '';
     TabOrder := 20;
     Text := 'Large CrossHair';
     OnChange  := @chkCrossHairChange;
@@ -364,11 +520,37 @@ begin
     Name := 'chkBGColor';
     SetPosition(396, 56, 132, 20);
     FontDesc := '#Label1';
+    Hint := '';
     TabOrder := 21;
     Text := 'New BG Color';
     OnChange  := @chkBGColorChange;
   end;
 
+  btnPicker := TPickerButton.Create(self);
+  with btnPicker do
+  begin
+    Name := 'btnPicker';
+    SetPosition(116, 372, 80, 23);
+    Text := 'Picker';
+    FontDesc := '#Label1';
+    Hint := '';
+    ImageName := '';
+    TabOrder := 24;
+    OnColorPicked := @btnColorPicked;
+  end;
+
+  chkContinuous := TfpgCheckBox.Create(self);
+  with chkContinuous do
+  begin
+    Name := 'chkContinous';
+    SetPosition(205, 375, 90, 19);
+    FontDesc := '#Label1';
+    Hint := '';
+    TabOrder := 25;
+    Text := 'Continous';
+    OnChange := @chkContinuousChanged;
+  end;
+
   {@VFD_BODY_END: MainForm}
 
   // link the two components
@@ -376,6 +558,9 @@ begin
 //  ColorWheel1.BackgroundColor := clFuchsia;
 //  ValueBar1.BackgroundColor := clFuchsia;
 //  ColorWheel1.CursorSize := 400;
+  UpdateHSVComponents;
+  if not FViaRGB then
+    UpdateRGBComponents;
 end;