summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--prototypes/fpgui2/tests/edittest.dpr18
-rw-r--r--prototypes/fpgui2/tests/edittest.lpi7
-rw-r--r--src/gui/fpgui_package.lpk6
-rw-r--r--src/gui/fpgui_package.pas2
-rw-r--r--src/gui/gui_trackbar.pas311
5 files changed, 337 insertions, 7 deletions
diff --git a/prototypes/fpgui2/tests/edittest.dpr b/prototypes/fpgui2/tests/edittest.dpr
index 09165fc4..cdeed6ff 100644
--- a/prototypes/fpgui2/tests/edittest.dpr
+++ b/prototypes/fpgui2/tests/edittest.dpr
@@ -18,7 +18,8 @@ uses
gui_dialogs,
gui_listbox,
gui_checkbox,
- gui_radiobutton;
+ gui_radiobutton,
+ gui_trackbar;
type
@@ -76,6 +77,8 @@ type
radiobtn1: TfpgRadioButton;
radiobtn2: TfpgRadioButton;
radiobtn3: TfpgRadioButton;
+ trackbar1: TfpgTrackBar;
+ trackbar2: TfpgTrackBar;
procedure AfterCreate; override;
end;
@@ -397,6 +400,19 @@ begin
radiobtn2 := CreateRadioButton(self, 180, 285, 'Radio Two');
radiobtn3 := CreateRadioButton(self, 180, 305, 'Radio Three');
radiobtn1.Checked := True;
+
+ trackbar1 := TfpgTrackBar.Create(self);
+ trackbar1.Top := 230;
+ trackbar1.Left := 335;
+ trackbar1.Width := 100;
+ trackbar1.Height := 25;
+
+ trackbar2 := TfpgTrackBar.Create(self);
+ trackbar2.Top := 230;
+ trackbar2.Left := 440;
+ trackbar2.Orientation := orVertical;
+ trackbar2.Width := 25;
+ trackbar2.Height := 100;
end;
procedure MainProc;
diff --git a/prototypes/fpgui2/tests/edittest.lpi b/prototypes/fpgui2/tests/edittest.lpi
index b609d403..1ecb384f 100644
--- a/prototypes/fpgui2/tests/edittest.lpi
+++ b/prototypes/fpgui2/tests/edittest.lpi
@@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
- <PathDelim Value="\"/>
+ <PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
@@ -9,7 +9,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
- <IconPath Value=".\"/>
+ <IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>
@@ -23,7 +23,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
- <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
@@ -42,7 +42,6 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
- <PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
diff --git a/src/gui/fpgui_package.lpk b/src/gui/fpgui_package.lpk
index acc1e43b..9959cfb8 100644
--- a/src/gui/fpgui_package.lpk
+++ b/src/gui/fpgui_package.lpk
@@ -18,7 +18,7 @@
<Description Value="fpGUI - multi-handle redesign"/>
<License Value="Modified LGPL"/>
<Version Minor="5"/>
- <Files Count="13">
+ <Files Count="14">
<Item1>
<Filename Value="gui_button.pas"/>
<UnitName Value="gui_button"/>
@@ -71,6 +71,10 @@
<Filename Value="gui_radiobutton.pas"/>
<UnitName Value="gui_radiobutton"/>
</Item13>
+ <Item14>
+ <Filename Value="gui_trackbar.pas"/>
+ <UnitName Value="gui_trackbar"/>
+ </Item14>
</Files>
<RequiredPkgs Count="2">
<Item1>
diff --git a/src/gui/fpgui_package.pas b/src/gui/fpgui_package.pas
index 5903ea3e..995215e7 100644
--- a/src/gui/fpgui_package.pas
+++ b/src/gui/fpgui_package.pas
@@ -9,7 +9,7 @@ interface
uses
gui_button, gui_combobox, gui_dialogs, gui_edit, gui_form, gui_label,
gui_listbox, gui_memo, gui_popupwindow, gui_scrollbar, gui_bevel,
- gui_checkbox, gui_radiobutton;
+ gui_checkbox, gui_radiobutton, gui_trackbar;
implementation
diff --git a/src/gui/gui_trackbar.pas b/src/gui/gui_trackbar.pas
new file mode 100644
index 00000000..b97650a7
--- /dev/null
+++ b/src/gui/gui_trackbar.pas
@@ -0,0 +1,311 @@
+unit gui_trackbar;
+
+{$mode objfpc}{$H+}
+
+{
+ TODO:
+ * Tick line orientation (top, bottom, left or right)
+ * Slide the slider with the mouse button down (like a scrollbar)
+ * Slider button style (rectangle, pointer, double pointer)
+ * Tick captions
+}
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ gfxbase,
+ fpgfx,
+ gfx_widget;
+
+type
+ TTrackBarChange = procedure(Sender: TObject; APosition: integer) of object;
+
+
+ TfpgTrackBar = class(TfpgWidget)
+ private
+ FBackgroundColor: TfpgColor;
+ FMax: integer;
+ FMin: integer;
+ FOnChange: TTrackBarChange;
+ FOrientation: TOrientation;
+ FPosition: integer;
+ FSliderSize: integer;
+ procedure DoChange;
+ procedure SetBackgroundColor(const AValue: TfpgColor);
+ procedure SetMax(const AValue: integer);
+ procedure SetMin(const AValue: integer);
+ procedure SetPosition(const AValue: integer);
+ procedure SetSliderSize(const AValue: integer);
+ procedure FixMinMaxOrder;
+ procedure FixPositionLimits;
+ procedure DrawSlider(p: integer);
+ protected
+ procedure HandlePaint; override;
+ procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
+ procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property BackgroundColor: TfpgColor read FBackgroundColor write SetBackgroundColor;
+ property Min: integer read FMin write SetMin default 0;
+ property Max: integer read FMax write SetMax default 10;
+ property Position: integer read FPosition write SetPosition default 0;
+ property SliderSize: integer read FSliderSize write SetSliderSize default 11;
+ property Orientation: TOrientation read FOrientation write FOrientation default orHorizontal;
+ property OnChange: TTrackBarChange read FOnChange write FOnChange;
+ end;
+
+
+implementation
+
+{ TfpgTrackBar }
+
+procedure TfpgTrackBar.DoChange;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(self, FPosition);
+end;
+
+procedure TfpgTrackBar.SetBackgroundColor(const AValue: TfpgColor);
+begin
+ if FBackgroundColor = AValue then
+ Exit; //==>
+ FBackgroundColor := AValue;
+ RePaint;
+end;
+
+procedure TfpgTrackBar.SetMax(const AValue: integer);
+begin
+ if FMax = AValue then
+ Exit; //==>
+ FMax := AValue;
+ RePaint;
+end;
+
+procedure TfpgTrackBar.SetMin(const AValue: integer);
+begin
+ if FMin = AValue then
+ Exit; //==>
+ FMin := AValue;
+ RePaint;
+end;
+
+procedure TfpgTrackBar.SetPosition(const AValue: integer);
+begin
+ if FPosition = AValue then
+ Exit; //==>
+ FPosition := AValue;
+ RePaint;
+ // OnChange only fired on keyboard or mouse input.
+end;
+
+procedure TfpgTrackBar.SetSliderSize(const AValue: integer);
+begin
+ if FSliderSize = AValue then
+ Exit; //==>
+ if AValue > 11 then
+ begin
+ FSliderSize := AValue;
+ RePaint;
+ end;
+end;
+
+procedure TfpgTrackBar.FixMinMaxOrder;
+var
+ lmin: integer;
+ lmax: integer;
+begin
+ if FMax < FMin then
+ begin
+ lmin := FMax; // change order
+ lmax := FMin;
+ FMax := lmax; // reassign values
+ FMin := lmin;
+ end;
+end;
+
+procedure TfpgTrackBar.FixPositionLimits;
+begin
+ if FPosition < FMin then
+ FPosition := FMin;
+ if FPosition > FMax then
+ FPosition := FMax;
+end;
+
+procedure TfpgTrackBar.DrawSlider(p: integer);
+var
+ h: integer;
+begin
+ if Orientation = orHorizontal then
+ begin
+ h := Height div 2 - 1;
+ Canvas.SetColor(clHilite1);
+ Canvas.DrawLine(p - FSliderSize div 2,5, p + FSliderSize div 2, 5);
+ Canvas.DrawLine(p - FSliderSize div 2,5, p - FSliderSize div 2, h - FSliderSize div 2);
+ Canvas.DrawLine(p - FSliderSize div 2, h - FSliderSize div 2, p, h + FSliderSize div 2);
+ Canvas.SetColor(clHilite2);
+ Canvas.DrawLine(p - FSliderSize div 2 + 1,6, p + FSliderSize div 2 - 1, 6);
+ Canvas.DrawLine(p - FSliderSize div 2 + 1,6, p - FSliderSize div 2 + 1, h - FSliderSize div 2);
+ Canvas.DrawLine(p - FSliderSize div 2 + 1, h - FSliderSize div 2, p, h + FSliderSize div 2 - 1);
+ Canvas.SetColor(clShadow2);
+ Canvas.DrawLine(p + FSliderSize div 2, 6, p + FSliderSize div 2, h - FSliderSize div 2);
+ Canvas.DrawLine(p + FSliderSize div 2, h - FSliderSize div 2, p + 1, h + FSliderSize div 2 - 1);
+ Canvas.SetColor(clShadow1);
+ Canvas.DrawLine(p + FSliderSize div 2 - 1, 7, p + FSliderSize div 2 - 1, h - FSliderSize div 2);
+ Canvas.DrawLine(p + FSliderSize div 2 - 1, h - FSliderSize div 2, p + 1, h + FSliderSize div 2 - 2);
+ end
+ else
+ begin
+ h := Width div 2 - 1;
+ Canvas.SetColor(clHilite1);
+ Canvas.DrawLine(5,p - FSliderSize div 2, 5, p + FSliderSize div 2);
+ Canvas.DrawLine(5,p - FSliderSize div 2, h - FSliderSize div 2, p - FSliderSize div 2);
+ Canvas.DrawLine( h - FSliderSize div 2, p - FSliderSize div 2, h + FSliderSize div 2,p);
+ Canvas.SetColor(clHilite2);
+ Canvas.DrawLine(6,p - FSliderSize div 2 + 1, 6, p + FSliderSize div 2 - 1);
+ Canvas.DrawLine(6,p - FSliderSize div 2 + 1, h - FSliderSize div 2, p - FSliderSize div 2 + 1);
+ Canvas.DrawLine(h - FSliderSize div 2,p - FSliderSize div 2 + 1, h + FSliderSize div 2 - 1,p);
+ Canvas.SetColor(clShadow2);
+ Canvas.DrawLine( 6,p + FSliderSize div 2, h - FSliderSize div 2, p + FSliderSize div 2);
+ Canvas.DrawLine( h - FSliderSize div 2,p + FSliderSize div 2, h + FSliderSize div 2 - 1, p + 1);
+ Canvas.SetColor(clShadow1);
+ Canvas.DrawLine( 7, p + FSliderSize div 2 - 1, h - FSliderSize div 2,p + FSliderSize div 2 - 1);
+ Canvas.DrawLine( h - FSliderSize div 2, p + FSliderSize div 2 - 1, h + FSliderSize div 2 - 2, p + 1);
+ end;
+end;
+
+procedure TfpgTrackBar.HandlePaint;
+var
+ r: TRect;
+ linepos: double;
+ drawwidth: integer;
+ i: integer;
+begin
+ Canvas.BeginDraw;
+// inherited HandlePaint;
+ r := Rect(0, 0, Width-1, Height-1);
+ Canvas.Clear(FBackgroundColor);
+
+ if FFocused then
+ Canvas.SetColor(clWidgetFrame)
+ else
+ Canvas.SetColor(clInactiveWgFrame);
+ Canvas.DrawRectangle(r);
+
+ FixMinMaxOrder;
+ FixPositionLimits;
+
+ if Orientation = orHorizontal then
+ begin
+ drawwidth := Width - 5 - FSliderSize;
+ linepos := FMax - FMin;
+ if linepos <> 0 then
+ begin
+ linepos := drawwidth / linepos;
+ Canvas.SetColor(clWidgetFrame);
+ for i := 0 to (FMax - FMin) do
+ Canvas.DrawLine(round(2 + (FSliderSize div 2) + (linepos * i)), Height div 2 + FSliderSize * 2, round(2 + FSliderSize div 2 + linepos * i), Height - 5);
+ DrawSlider(round(2 + FSliderSize div 2 + linepos * position));
+ end;
+ end
+ else
+ begin
+ drawwidth := Height - 5 - FSliderSize;
+ linepos := FMax - FMin;
+ if linepos <> 0 then
+ begin
+ linepos := drawwidth / linepos;
+ Canvas.SetColor(clWidgetFrame);
+ for i := 0 to (FMax - FMin) do
+ Canvas.DrawLine(Width div 2 + FSliderSize * 2, round(2 + (FSliderSize div 2) + (linepos * i)), Width - 5, round(2 + FSliderSize div 2 + linepos * i));
+ DrawSlider(round(2 + FSliderSize div 2 + linepos * position));
+ end;
+ end; { if/else }
+
+ Canvas.EndDraw;
+end;
+
+procedure TfpgTrackBar.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
+var
+ p: integer;
+ linepos: double;
+ drawwidth: integer;
+ OldPos: integer;
+begin
+ OldPos := Position;
+ FixMinMaxOrder;
+ linepos := FMax - FMin;
+
+ if Orientation = orHorizontal then
+ begin
+ drawwidth := Width - 5 - FSliderSize;
+ linepos := drawwidth / linepos;
+ FPosition := round((x - 2 - FSliderSize div 2) / linepos) + FMin;
+ end
+ else
+ begin
+ drawwidth := Height - 5 - FSliderSize;
+ linepos := drawwidth / linepos;
+ FPosition := round((y - 2 - FSliderSize div 2) / linepos) + FMin;
+ end;
+ RePaint;
+
+ if Position <> OldPos then
+ DoChange;
+
+// inherited HandleLMouseUp(x, y, shiftstate);
+end;
+
+procedure TfpgTrackBar.HandleKeyPress(var keycode: word;
+ var shiftstate: TShiftState; var consumed: boolean);
+var
+ OldPos: integer;
+begin
+ consumed := True;
+ OldPos := FPosition;
+
+ if Orientation = orHorizontal then
+ begin
+ case keycode of
+ keyLeft: Position := Position - 1;
+ keyRight: Position := Position + 1;
+ keyPageUp: Position := FMin;
+ keyPageDown: Position := FMax;
+ else
+ consumed := False;
+ end;
+ end
+ else
+ begin
+ case keycode of
+ keyUp: Position := Position - 1;
+ keyDown: Position := Position + 1;
+ keyPageUp: Position := FMin;
+ keyPageDown: Position := FMax;
+ else
+ consumed := False;
+ end;
+ end; { if/else }
+
+ inherited HandleKeyPress(keycode, shiftstate, consumed);
+ if OldPos <> Position then
+ DoChange;
+end;
+
+constructor TfpgTrackBar.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FBackgroundColor := clWindowBackground;
+ FFocusable := True;
+ FMin := 0;
+ FMax := 10;
+ FPosition := 0;
+ FSliderSize := 11;
+ FOrientation := orHorizontal;
+ FOnChange := nil;
+end;
+
+end.
+
generated by cgit v1.2.3-70-g09d2 (git 2.48.0) at 2025-01-15 04:18:48 +0000