diff options
Diffstat (limited to 'examples/gui/colorwheel/frm_main.pas')
| -rw-r--r-- | examples/gui/colorwheel/frm_main.pas | 235 |
1 files changed, 210 insertions, 25 deletions
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; |