summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/bevel/beveltest.lpi53
-rw-r--r--examples/gui/bevel/beveltest.lpr110
-rw-r--r--src/gui/fpgui_package.lpk8
-rw-r--r--src/gui/fpgui_package.pas2
-rw-r--r--src/gui/gui_bevel.pas126
-rw-r--r--src/gui/gui_label.pas1
6 files changed, 297 insertions, 3 deletions
diff --git a/examples/gui/bevel/beveltest.lpi b/examples/gui/bevel/beveltest.lpi
new file mode 100644
index 00000000..a99498ff
--- /dev/null
+++ b/examples/gui/bevel/beveltest.lpi
@@ -0,0 +1,53 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="/"/>
+ <Version Value="5"/>
+ <General>
+ <Flags>
+ <SaveOnlyProjectUnits Value="True"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <TargetFileExt Value=""/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IgnoreBinaries Value="False"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="fpgui_package"/>
+ <MinVersion Minor="5" Valid="True"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="1">
+ <Unit0>
+ <Filename Value="beveltest.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="beveltest"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/bevel/beveltest.lpr b/examples/gui/bevel/beveltest.lpr
new file mode 100644
index 00000000..e339825e
--- /dev/null
+++ b/examples/gui/bevel/beveltest.lpr
@@ -0,0 +1,110 @@
+program beveltest;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes,
+ typinfo,
+ fpgfx,
+ gui_form,
+ gui_button,
+ gui_bevel,
+ gui_label;
+
+type
+ TMainForm = class(TfpgForm)
+ private
+ bevel: TfpgBevel;
+ btnQuit: TfpgButton;
+ btnStyles: TfpgButton;
+ btnShapes: TfpgButton;
+ lblTitle: TfpgLabel;
+ lblStyle: TfpgLabel;
+ lblShape: TfpgLabel;
+ lblNext: TfpgLabel;
+ procedure btnQuitClick(Sender: TObject);
+ procedure btnStylesClick(Sender: TObject);
+ procedure btnShapesClick(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+{ TMainForm }
+
+procedure TMainForm.btnQuitClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TMainForm.btnStylesClick(Sender: TObject);
+begin
+ if Bevel.Style = bsRaised then
+ begin
+ Bevel.Style := bsLowered;
+ lblStyle.Text := 'Bevel is bsLowered';
+ btnStyles.Text := 'bsRaised';
+ end
+ else
+ begin
+ Bevel.Style := bsRaised;
+ lblStyle.Text := 'Bevel is bsRaised';
+ btnStyles.Text := 'bsLowered';
+ end;
+end;
+
+procedure TMainForm.btnShapesClick(Sender: TObject);
+var
+ next: TBevelShape;
+begin
+ if Bevel.Shape = High(TBevelShape) then
+ Bevel.Shape := Low(TBevelShape)
+ else
+ Bevel.Shape := TBevelShape(Ord(Bevel.Shape) + 1);
+ lblShape.Text := 'Shape is ' + GetEnumName(TypeInfo(TBevelShape), Ord(Bevel.Shape));
+
+ if Bevel.Shape = High(TBevelShape) then
+ next := Low(TBevelShape)
+ else
+ next := TBevelShape(Ord(Bevel.Shape) + 1);
+ btnShapes.Text := GetEnumName(TypeInfo(TBevelShape), Ord(next));
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ WindowTitle := 'Bevel test';
+ SetPosition(100, 100, 300, 250);
+
+ lblTitle := CreateLabel(self, 6, 6, 'Click buttons to change properties');
+ bevel := CreateBevel(self, 20, 30, 150, 150, bsBox, bsRaised);
+
+ btnQuit := CreateButton(self, 210, 220, 80, 'Quit', @btnQuitClick);
+ btnQuit.ImageName := 'stdimg.quit';
+ btnQuit.ShowImage := True;
+
+ lblNext := CreateLabel(self, 200, 80, 'Next value is...');
+ btnShapes := CreateButton(self, 200, 100, 90, 'bsFrame', @btnShapesClick);
+ btnStyles := CreateButton(self, 200, 130, 90, 'bsLowered', @btnStylesClick);
+
+ lblShape := CreateLabel(self, 6, 190, 'Shape is bsBox');
+ lblStyle := CreateLabel(self, 6, 210, 'Style is bsRaised');
+end;
+
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+ frm := TMainForm.Create(nil);
+ frm.Show;
+ fpgApplication.Run;
+end;
+
+begin
+ MainProc;
+end.
+
diff --git a/src/gui/fpgui_package.lpk b/src/gui/fpgui_package.lpk
index ea9896d3..5ad6031a 100644
--- a/src/gui/fpgui_package.lpk
+++ b/src/gui/fpgui_package.lpk
@@ -6,7 +6,7 @@
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
- <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
+ <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
@@ -18,7 +18,7 @@
<Description Value="fpGUI - multi-handle redesign"/>
<License Value="Modified LGPL"/>
<Version Minor="5"/>
- <Files Count="10">
+ <Files Count="11">
<Item1>
<Filename Value="gui_button.pas"/>
<UnitName Value="gui_button"/>
@@ -59,6 +59,10 @@
<Filename Value="gui_scrollbar.pas"/>
<UnitName Value="gui_scrollbar"/>
</Item10>
+ <Item11>
+ <Filename Value="gui_bevel.pas"/>
+ <UnitName Value="gui_bevel"/>
+ </Item11>
</Files>
<RequiredPkgs Count="2">
<Item1>
diff --git a/src/gui/fpgui_package.pas b/src/gui/fpgui_package.pas
index dcdc16ba..a6b53cdc 100644
--- a/src/gui/fpgui_package.pas
+++ b/src/gui/fpgui_package.pas
@@ -8,7 +8,7 @@ interface
uses
gui_button, gui_combobox, gui_dialogs, gui_edit, gui_form, gui_label,
- gui_listbox, gui_memo, gui_popupwindow, gui_scrollbar;
+ gui_listbox, gui_memo, gui_popupwindow, gui_scrollbar, gui_bevel;
implementation
diff --git a/src/gui/gui_bevel.pas b/src/gui/gui_bevel.pas
new file mode 100644
index 00000000..d531fde0
--- /dev/null
+++ b/src/gui/gui_bevel.pas
@@ -0,0 +1,126 @@
+unit gui_bevel;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ fpgfx,
+ gfxbase,
+ gfx_widget;
+
+type
+
+ TBevelShape = (bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine, bsRightLine, bsSpacer);
+
+ TBevelStyle = (bsLowered, bsRaised);
+
+
+ TfpgBevel = class(TfpgWidget)
+ private
+ FBevelShape: TBevelShape;
+ FBevelStyle: TBevelStyle;
+ procedure SetBevelShape(const AValue: TBevelShape);
+ procedure SetBevelStyle(const AValue: TBevelStyle);
+ protected
+ procedure HandlePaint; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property Shape: TBevelShape read FBevelShape write SetBevelShape default bsBox;
+ property Style: TBevelStyle read FBevelStyle write SetBevelStyle default bsRaised;
+ end;
+
+
+function CreateBevel(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord;
+ AShape: TBevelShape; AStyle: TBevelStyle): TfpgBevel;
+
+
+implementation
+
+
+function CreateBevel(AOwner: TComponent; ALeft, ATop, AWidth,
+ AHeight: TfpgCoord; AShape: TBevelShape; AStyle: TBevelStyle): TfpgBevel;
+begin
+ Result := TfpgBevel.Create(AOwner);
+ Result.Left := ALeft;
+ Result.Top := ATop;
+ Result.Width := AWidth;
+ Result.Height := AHeight;
+ Result.Shape := AShape;
+ Result.Style := AStyle;
+end;
+
+{ TfpgBevel }
+
+procedure TfpgBevel.SetBevelShape(const AValue: TBevelShape);
+begin
+ if FBevelShape = AValue then
+ Exit; //==>
+ FBevelShape := AValue;
+ Repaint;
+end;
+
+procedure TfpgBevel.SetBevelStyle(const AValue: TBevelStyle);
+begin
+ if FBevelStyle = AValue then
+ Exit; //==>
+ FBevelStyle := AValue;
+ Repaint;
+end;
+
+procedure TfpgBevel.HandlePaint;
+begin
+ Canvas.BeginDraw;
+ inherited HandlePaint;
+ Canvas.Clear(clWindowBackground);
+
+ Canvas.SetLineStyle(2, lsSolid);
+ Canvas.SetColor(clWindowBackground);
+ Canvas.DrawRectangle(1, 1, Width - 1, Height - 1);
+ Canvas.SetLineStyle(1, lsSolid);
+
+ if Style = bsRaised then
+ Canvas.SetColor(clHilite2)
+ else
+ Canvas.SetColor(clShadow2);
+
+ if Shape in [bsBox, bsFrame, bsTopLine] then
+ Canvas.DrawLine(0, 0, Width - 1, 0);
+ if Shape in [bsBox, bsFrame, bsLeftLine] then
+ Canvas.DrawLine(0, 1, 0, Height - 1);
+ if Shape in [bsFrame, bsRightLine] then
+ Canvas.DrawLine(Width - 2, 1, Width - 2, Height - 1);
+ if Shape in [bsFrame, bsBottomLine] then
+ Canvas.DrawLine(1, Height - 2, Width - 1, Height - 2);
+
+ if Style = bsRaised then
+ Canvas.SetColor(clShadow2)
+ else
+ Canvas.SetColor(clHilite2);
+
+ if Shape in [bsFrame, bsTopLine] then
+ Canvas.DrawLine(1, 1, Width - 2, 1);
+ if Shape in [bsFrame, bsLeftLine] then
+ Canvas.DrawLine(1, 2, 1, Height - 2);
+ if Shape in [bsBox, bsFrame, bsRightLine] then
+ Canvas.DrawLine(Width - 1, 0, Width - 1, Height - 1);
+ if Shape in [bsBox, bsFrame, bsBottomLine] then
+ Canvas.DrawLine(0, Height - 1, Width, Height - 1);
+
+ Canvas.EndDraw;
+end;
+
+constructor TfpgBevel.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FBevelShape := bsBox;
+ FBevelStyle := bsRaised;
+ FWidth := 80;
+ FHeight := 80;
+end;
+
+end.
+
diff --git a/src/gui/gui_label.pas b/src/gui/gui_label.pas
index 9e51b780..ea635be0 100644
--- a/src/gui/gui_label.pas
+++ b/src/gui/gui_label.pas
@@ -115,6 +115,7 @@ procedure TfpgLabel.ResizeLabel;
begin
Width := FFont.TextWidth(FText);
Height := FFont.Height;
+ UpdateWindowPosition;
end;
constructor TfpgLabel.Create(AOwner: TComponent);
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-29 09:06:57 +0000