summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/widgettest/widgettest.pas1
-rw-r--r--gfx/gdi/gfx_gdi.pas1
-rw-r--r--gfx/gfxbase.pas3
-rw-r--r--gui/combobox.inc38
-rw-r--r--gui/form.inc14
-rw-r--r--gui/fpgui.pas44
-rw-r--r--gui/menus.inc2
-rw-r--r--gui/panel.inc1
-rw-r--r--gui/popupwindow.inc2
-rw-r--r--gui/style.inc33
-rw-r--r--gui/widget.inc13
11 files changed, 115 insertions, 37 deletions
diff --git a/examples/gui/widgettest/widgettest.pas b/examples/gui/widgettest/widgettest.pas
index 8ba3c5e2..11c2c87c 100644
--- a/examples/gui/widgettest/widgettest.pas
+++ b/examples/gui/widgettest/widgettest.pas
@@ -747,6 +747,7 @@ begin
ComboBox1.Items.Add(Format('Item 1.%d...', [i]));
ComboBox2.Items.Add(Format('Item 2.%d...', [i]));
end;
+ ComboBox2.Items.Add('A long item that should cause a horizontal scrollbar to appear.');
BetaLabel.FontColor := clBlue;
end;
diff --git a/gfx/gdi/gfx_gdi.pas b/gfx/gdi/gfx_gdi.pas
index 2d6aa61a..48519ab0 100644
--- a/gfx/gdi/gfx_gdi.pas
+++ b/gfx/gdi/gfx_gdi.pas
@@ -577,6 +577,7 @@ end;
procedure TGDICanvas.DoDrawCircle(const ARect: TRect);
begin
{$Warning DoDrawCircle needs testing. }
+ NeedPen;
Windows.Ellipse(Handle, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;
diff --git a/gfx/gfxbase.pas b/gfx/gfxbase.pas
index 31d8876f..f5f1db82 100644
--- a/gfx/gfxbase.pas
+++ b/gfx/gfxbase.pas
@@ -1355,7 +1355,8 @@ end;
procedure TFCustomApplication.AddWindow(AWindow: TFCustomWindow);
begin
- Forms.Add(AWindow);
+ if Forms.IndexOf(AWindow) = -1 then
+ Forms.Add(AWindow);
end;
procedure TFCustomApplication.RemoveWindow(AWindow: TFCustomWindow);
diff --git a/gui/combobox.inc b/gui/combobox.inc
index c76c96d9..5d225907 100644
--- a/gui/combobox.inc
+++ b/gui/combobox.inc
@@ -24,8 +24,8 @@
TComboBoxPopup = class(TPopupWindow)
private
+ FLayout: TBoxLayout;
FListBox: TListBox;
- procedure ItemSelected(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
property ListBox: TListBox read FListBox;
@@ -43,7 +43,6 @@
procedure SetItemIndex(const AValue: Integer);
protected
FButton: TGenericButton;
-// FDropDown: TCustomForm;
FDropDown: TComboBoxPopup;
lbl: TLabel;
procedure Click; override;
@@ -97,29 +96,28 @@ begin
wsEnabled in WidgetState);
end;
-
procedure TArrowButton.CalcSizes;
begin
FMinSize := Style.GetComboBoxArrowSize;
end;
-
-procedure TComboBoxPopup.ItemSelected(Sender: TObject);
-begin
- Close;
-end;
-
-
constructor TComboBoxPopup.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque];
+ BorderWidth := 1;
+ Color := clBlack;
+
+ FLayout := TBoxLayout.Create(self);
+ FLayout.Name := 'VBox';
+ FLayout.Orientation := Vertical;
+ FLayout.Spacing := 0;
+ InsertChild(FLayout);
FListBox := TListBox.Create(self);
- FListBox.Name := 'listbox';
- FListBox.Parent := self;
+ FListBox.Name := 'Listbox';
FListBox.HotTrack := True;
-// FListBox.OnClick := @ItemSelected; // Listbox needs OnSelect event
+ FLayout.InsertChild(FListBox);
end;
@@ -143,14 +141,12 @@ begin
FButton.Parent := Self;
end;
-
destructor TCustomComboBox.Destroy;
begin
FDropDown.Free;
inherited Destroy;
end;
-
procedure TCustomComboBox.Paint(Canvas: TFCanvas);
var
Pt: TPoint;
@@ -188,7 +184,6 @@ begin
end;
end;
-
procedure TCustomComboBox.CalcSizes;
begin
with Style.GetEditBoxBorders do
@@ -197,7 +192,6 @@ begin
TopLeft + BottomRight;
end;
-
procedure TCustomComboBox.Resized;
begin
with Style.GetEditBoxBorders do
@@ -205,14 +199,12 @@ begin
FButton.MinSize);
end;
-
function TCustomComboBox.DistributeEvent(Event: TEventObj): Boolean;
begin
Result := Event.SendToChild(FButton) or
inherited DistributeEvent(Event);
end;
-
procedure TCustomComboBox.ButtonClick(Sender: TObject);
begin
if Assigned(FDropDown) and FDropDown.Visible then
@@ -224,18 +216,17 @@ begin
if not Assigned(FDropDown) then
begin
FDropDown := TComboBoxPopup.Create(Self);
- FDropDown.OnDeactivate := @DropDownDeactivate;
FDropDown.OnDestroy := @DropDownDestroy;
FDropDown.ListBox.Items.Text := FItems.Text;
FDropDown.ListBox.FItemIndex := FItemIndex;
FDropDown.ListBox.OnClick := @DropDownDeactivate;
end;
- FDropDown.Show;
FDropDown.SetPosition(ClientToScreen(Point(0, Height)));
+ FDropDown.Show;
+ FDropDown.Wnd.SetMinMaxClientSize(MaxSize, MaxSize);
end;
-
procedure TCustomComboBox.DropDownDeactivate(Sender: TObject);
begin
LAYOUTTRACE('TCustomComboBox.DropDownDestroy for %s:%s', [Name, ClassName]);
@@ -244,14 +235,12 @@ begin
SetFocus;
end;
-
procedure TCustomComboBox.DropDownDestroy(Sender: TObject);
begin
LAYOUTTRACE('TCustomComboBox.DropDownDestroy for %s:%s', [Name, ClassName]);
FDropDown := nil;
end;
-
procedure TCustomComboBox.SetItemIndex(const AValue: Integer);
begin
if FItemIndex <> AValue then
@@ -269,7 +258,6 @@ begin
end;
end;
-
{ This event causes the combobox to drop open when you click anywhere in the
component, or press the spacebar key. }
procedure TCustomComboBox.Click;
diff --git a/gui/form.inc b/gui/form.inc
index 4cbd1b2e..030198e2 100644
--- a/gui/form.inc
+++ b/gui/form.inc
@@ -73,8 +73,8 @@
property BorderWidth: Integer read FBorderWidth write FBorderWidth;
property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
- property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
- property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
+ property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; // Get focus
+ property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate; // Loose focus
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@@ -91,10 +91,11 @@
TForm = class(TCustomForm)
published
- property Enabled;
property BorderWidth;
- property WindowOptions;
+ property Color;
+ property Enabled;
property Text;
+ property WindowOptions;
property OnCreate;
property OnDestroy;
property OnActivate;
@@ -190,6 +191,7 @@ end;
procedure TCustomForm.Paint(Canvas: TFCanvas);
begin
+ inherited Paint(Canvas);
Style.DrawWindowBackground(Canvas, Rect(0, 0, Width, Height));
end;
@@ -231,8 +233,8 @@ begin
else
ParentWnd := nil;
- FWnd := TFWindow.Create(ParentWnd, [woWindow]);
-// FWnd := Application.DefaultScreen.CreateWindow(ParentWnd, [woWindow]);
+ FWnd := TFWindow.Create(ParentWnd, WindowOptions);
+
if FPositionSpecified then
Wnd.SetPosition(Origin);
diff --git a/gui/fpgui.pas b/gui/fpgui.pas
index c110161a..e3e93d6d 100644
--- a/gui/fpgui.pas
+++ b/gui/fpgui.pas
@@ -41,7 +41,7 @@ uses
,Classes
,GFXBase
,fpGFX
-// ,Types { used for OffsetRect() }
+// ,Types
;
type
@@ -237,6 +237,48 @@ begin
end;
{$ENDIF}
+function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
+begin
+ if Assigned(@Rect) then
+ begin
+ with Rect do
+ begin
+ dec(Left, dx);
+ dec(Top, dy);
+ inc(Right, dx);
+ inc(Bottom, dy);
+ end;
+ Result := True;
+ end
+ else
+ Result := False;
+end;
+
+function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
+begin
+ if assigned(@Rect) then
+ begin
+ with Rect do
+ begin
+ inc(Left,dx);
+ inc(Top,dy);
+ inc(Right,dx);
+ inc(Bottom,dy);
+ end;
+ OffsetRect := True;
+ end
+ else
+ OffsetRect := False;
+end;
+
+function CenterPoint(const Rect: TRect): TPoint;
+begin
+ with Rect do
+ begin
+ Result.X := (Left+Right) div 2;
+ Result.Y := (Top+Bottom) div 2;
+ end;
+end;
{ This lets us use a single include file for both the Interface and
Implementation sections. }
diff --git a/gui/menus.inc b/gui/menus.inc
index cf835c0f..30986548 100644
--- a/gui/menus.inc
+++ b/gui/menus.inc
@@ -85,7 +85,7 @@ procedure TMenuBar.Paint(Canvas: TFCanvas);
{var
i: integer; }
begin
-// inherited Paint(Canvas);
+ inherited Paint(Canvas);
Style.DrawWindowBackground(Canvas, ClientRect);
// FLayout.Paint(Canvas);
{
diff --git a/gui/panel.inc b/gui/panel.inc
index 3bd3c1c0..0473dbe8 100644
--- a/gui/panel.inc
+++ b/gui/panel.inc
@@ -64,6 +64,7 @@ procedure TCustomPanel.Paint(Canvas: TFCanvas);
var
Pt: TPoint;
begin
+ inherited Paint(Canvas);
Style.DrawPanel(Canvas, Rect(0, 0, Width, Height), FBevelStyle);
if Text <> '' then
diff --git a/gui/popupwindow.inc b/gui/popupwindow.inc
index 935232e3..8194fd0f 100644
--- a/gui/popupwindow.inc
+++ b/gui/popupwindow.inc
@@ -35,7 +35,7 @@ constructor TPopupWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FParent := nil;
- FWindowOptions := [woBorderless, woPopup];
+ FWindowOptions := FWindowOptions + [woBorderless, woPopup];
end;
diff --git a/gui/style.inc b/gui/style.inc
index b729b04e..c71dce16 100644
--- a/gui/style.inc
+++ b/gui/style.inc
@@ -395,7 +395,7 @@ end;
procedure TDefaultStyle.DrawWindowBackground(Canvas: TFCanvas;
const ARect: TRect);
begin
- SetUIColor(Canvas, cl3DFace);
+// SetUIColor(Canvas, cl3DFace);
Canvas.FillRect(ARect);
end;
@@ -565,6 +565,7 @@ procedure TDefaultStyle.DrawRadioButton(Canvas: TFCanvas;
const ARect, LabelRect: TRect; Flags: TCheckboxFlags);
var
Index, BtnY: Integer;
+ r: TRect;
begin
{
with ARect do
@@ -582,6 +583,36 @@ begin
Point(0, 0), Point(Left, BtnY));
end;
}
+// cl3DLight, cl3DHighlight, cl3DDkShadow, cl3DShadow
+ SetUIColor(Canvas, clLtGray);
+ r.Left := ARect.Left;
+ r.Top := ARect.Top + (ARect.Bottom - ARect.Top - 13) div 2;
+ r.Right := 13;
+ r.Bottom := r.Top + 13;
+ Canvas.DrawCircle(r);
+
+ SetUIColor(Canvas, cl3DShadow);
+ InflateRect(r, -2, -2);
+ Canvas.DrawCircle(r);
+
+ SetUIColor(Canvas, cl3DDkShadow);
+ InflateRect(r, 1, 1);
+ Canvas.DrawCircle(r);
+
+ if cbIsChecked in Flags then
+ begin
+ SetUIColor(Canvas, clNavy);
+ InflateRect(r, -3, -3);
+ Canvas.DrawCircle(r);
+ InflateRect(r, -1, -1);
+ Canvas.FillRect(r);
+ InflateRect(r, 1, 1);
+ SetUIColor(Canvas, clSkyBlue);
+ InflateRect(r, -2, -2);
+ OffsetRect(r, -1, -1);
+ Canvas.FillRect(r);
+ end;
+
if cbHasFocus in Flags then
with LabelRect do
DrawFocusRect(Canvas, Rect(Left - 2, Top - 2, Right + 2, Bottom + 2));
diff --git a/gui/widget.inc b/gui/widget.inc
index d5c10449..cfd2b17c 100644
--- a/gui/widget.inc
+++ b/gui/widget.inc
@@ -166,9 +166,11 @@
TWidget = class(TComponent)
private
+ FColor: TColor;
FParent: TWidget;
FOnClick: TNotifyEvent;
// Property access
+ procedure SetColor(const AValue: TColor);
procedure SetParent(AParent: TWidget);
function GetBoundsRect: TRect;
function GetLeft: Integer;
@@ -231,6 +233,7 @@
property CanExpandHeight: Boolean read FCanExpandHeight write SetCanExpandHeight default False;
property Cursor: TFCursor read FCursor write FCursor default crDefault;
property Text: String read FText write SetText;
+ property Color: TColor read FColor write SetColor default cl3DFace;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
public
constructor Create(AOwner: TComponent); override;
@@ -452,11 +455,13 @@ end;
constructor TWidget.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
+ WidgetStyle := [];
WidgetState := [wsEnabled];
FCanExpandWidth := False;
FCanExpandHeight := False;
FEnabled := True;
FVisible := True;
+ FColor := cl3DFace;
end;
destructor TWidget.Destroy;
@@ -830,7 +835,7 @@ end;
procedure TWidget.Paint(Canvas: TFCanvas);
begin
- // Do nothing here.
+ Canvas.SetColor(Style.GetUIColor(FColor));
end;
procedure TWidget.SetParentComponent(AParent: TComponent);
@@ -1156,6 +1161,12 @@ begin
end;
end;
+procedure TWidget.SetColor(const AValue: TColor);
+begin
+ if FColor=AValue then exit;
+ FColor:=AValue;
+end;
+
function TWidget.GetBoundsRect: TRect;
begin
Result.TopLeft := Origin;
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-29 07:46:50 +0000