diff options
author | Graeme Geldenhuys <graemeg@gmail.com> | 2014-10-19 20:31:50 +0100 |
---|---|---|
committer | Graeme Geldenhuys <graemeg@gmail.com> | 2014-10-19 20:31:50 +0100 |
commit | 11856a7d81d087d30867cf6795a7ee044556edee (patch) | |
tree | b62371b3a028973a64a75a1d6acd7f71a19a371c | |
parent | 31b6156af1158a33b10d63393ae24f804dee05bb (diff) | |
download | fpGUI-11856a7d81d087d30867cf6795a7ee044556edee.tar.xz |
colorwheel demo: now has a color picker button
* Click and hold the mouse. Then move the mouse and release. The
colorwheel will then update the color under the mouse cursor.
* Enable the "Continuous" checkbox and do the same as above. As you
move the mouse, the colorwheel will continuously update.
NOTE:
The internal functionality used is still only for X11.
-rw-r--r-- | examples/gui/colorwheel/colorwheel_test.lpi | 4 | ||||
-rw-r--r-- | examples/gui/colorwheel/frm_main.pas | 131 |
2 files changed, 122 insertions, 13 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 00fcf621..612ea6c1 100644 --- a/examples/gui/colorwheel/frm_main.pas +++ b/examples/gui/colorwheel/frm_main.pas @@ -12,6 +12,30 @@ uses 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} @@ -38,25 +62,29 @@ type 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; @@ -104,6 +132,54 @@ 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; @@ -130,6 +206,17 @@ 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); @@ -215,6 +302,7 @@ begin begin Name := 'ValueBar1'; SetPosition(304, 20, 52, 244); + Value := 1; OnChange := @ColorChanged; end; @@ -438,6 +526,31 @@ begin 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 |