summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/fontselect/fontselect.lpi2
-rw-r--r--examples/gui/fontselect/fontselect.lpr55
-rw-r--r--src/corelib/fpgfx.pas14
-rw-r--r--src/corelib/gfxbase.pas2
-rw-r--r--src/gui/gui_dialogs.pas399
-rw-r--r--src/gui/gui_edit.pas10
-rw-r--r--src/gui/gui_listbox.pas2
7 files changed, 422 insertions, 62 deletions
diff --git a/examples/gui/fontselect/fontselect.lpi b/examples/gui/fontselect/fontselect.lpi
index 18b66abc..230ba30c 100644
--- a/examples/gui/fontselect/fontselect.lpi
+++ b/examples/gui/fontselect/fontselect.lpi
@@ -9,6 +9,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
+ <IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>
@@ -16,7 +17,6 @@
</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>
diff --git a/examples/gui/fontselect/fontselect.lpr b/examples/gui/fontselect/fontselect.lpr
index f47d996f..cc9f1ca6 100644
--- a/examples/gui/fontselect/fontselect.lpr
+++ b/examples/gui/fontselect/fontselect.lpr
@@ -10,7 +10,10 @@ uses
fpgfx,
gui_form,
gui_dialogs,
- gui_button;
+ gui_button,
+ gui_listbox,
+ gui_edit,
+ gui_label;
type
@@ -18,8 +21,12 @@ type
private
btnQuit: TfpgButton;
btnSelectFont: TfpgButton;
+ lbFontList: TfpgListBox;
+ edFontDesc: TfpgEdit;
+ lblFontList: TfpgLabel;
procedure btnQuitClick(Sender: TObject);
procedure btnSelectFontClick(Sender: TObject);
+ procedure CreateFontList;
public
constructor Create(AOwner: TComponent); override;
end;
@@ -33,17 +40,23 @@ end;
procedure TMainForm.btnSelectFontClick(Sender: TObject);
var
- frm: TfpgFontSelect;
+ fontdesc: string;
begin
- frm := TfpgFontSelect.Create(nil);
- try
- if frm.ShowModal = 1 then
- begin
- // query font selected in dialog
- end;
- finally
- frm.Free;
- end;
+ fontdesc := edFontDesc.Text;
+ if SelectFontDialog(fontdesc) then
+ edFontDesc.Text := fontdesc;
+end;
+
+procedure TMainForm.CreateFontList;
+var
+ fl: TStringList;
+ i: integer;
+begin
+ lbFontList.Items.Clear;
+ fl := fpgApplication.GetFontFaceList;
+ for i := 0 to fl.Count-1 do
+ lbFontList.Items.Add(fl.Strings[i]);
+ fl.Free;
end;
constructor TMainForm.Create(AOwner: TComponent);
@@ -51,13 +64,29 @@ begin
inherited Create(AOwner);
WindowTitle := 'Font selection test';
SetPosition(100, 100, 500, 400);
+
+ btnSelectFont := CreateButton(self, 10, 10, 110, 'Select Font...', @btnSelectFontClick);
+
+ edFontDesc := CreateEdit(self, 10, 45, Width - 20, 24);
+// edFontDesc.Text := fpgApplication.DefaultFont.FontDesc;
+ edFontDesc.Text := 'Bitstream Vera Sans-9';
+
+ lblFontList := CreateLabel(self, 10, 80, 'Font List:');
+ lbFontList := TfpgListBox.Create(self);
+ with lbFontList do
+ begin
+ SetPosition(10, 100, 232, 236);
+ Items.Clear;
+ end;
+
+ CreateFontList;
btnQuit := CreateButton(self, 415, 370, 80, 'Quit', @btnQuitClick);
btnQuit.ImageName := 'stdimg.Quit';
btnQuit.ShowImage := True;
btnQuit.Anchors := [anRight, anBottom];
-
- btnSelectFont := CreateButton(self, 10, 20, 110, 'Select Font...', @btnSelectFontClick);
+
+ btnSelectFont.TabOrder := 0;
end;
procedure MainProc;
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index 2e737fff..62a20302 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -847,16 +847,16 @@ end;
constructor TfpgStyle.Create;
begin
// Setup font aliases
- fpgSetNamedFont('Label1', 'Arial-10');
- fpgSetNamedFont('Label2', 'Arial-10:bold');
- fpgSetNamedFont('Edit1', 'Arial-10');
+ fpgSetNamedFont('Label1', FPG_DEFAULT_FONT_DESC);
+ fpgSetNamedFont('Label2', FPG_DEFAULT_FONT_DESC + ':bold');
+ fpgSetNamedFont('Edit1', FPG_DEFAULT_FONT_DESC);
fpgSetNamedFont('Edit2', 'Courier New-10');
- fpgSetNamedFont('List', 'Arial-10');
+ fpgSetNamedFont('List', FPG_DEFAULT_FONT_DESC);
fpgSetNamedFont('Grid', 'Arial-9');
fpgSetNamedFont('GridHeader', 'Arial-9:bold');
- fpgSetNamedFont('Menu', 'Arial-10');
- fpgSetNamedFont('MenuAccel', 'Arial-10:bold');
- fpgSetNamedFont('MenuDisabled', 'Arial-10:italic');
+ fpgSetNamedFont('Menu', FPG_DEFAULT_FONT_DESC);
+ fpgSetNamedFont('MenuAccel', FPG_DEFAULT_FONT_DESC + ':underline');
+ fpgSetNamedFont('MenuDisabled', FPG_DEFAULT_FONT_DESC);
{$Note Refactor this so under Windows it can detect the system colors instead.
Also under Linux (KDE and Gnome) we should be able to detect the system colors.}
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index 78ef4b66..9b4bbec7 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -58,7 +58,7 @@ const
// The special keys, based on the well-known keyboard scan codes
{$I keys.inc}
- FPG_DEFAULT_FONT_DESC = 'Arial-10';
+ FPG_DEFAULT_FONT_DESC = 'Arial,Sans-10';
UserNamedColorStart = 128;
{$I predefinedcolors.inc}
diff --git a/src/gui/gui_dialogs.pas b/src/gui/gui_dialogs.pas
index c52fd0ba..bdc9fba0 100644
--- a/src/gui/gui_dialogs.pas
+++ b/src/gui/gui_dialogs.pas
@@ -1,7 +1,13 @@
+{
+ General dialogs used by fpGUI based applications
+}
+
unit gui_dialogs;
{$mode objfpc}{$H+}
+{.$Define DEBUG}
+
interface
uses
@@ -11,7 +17,9 @@ uses
gui_form,
gui_button,
gui_label,
- gui_listbox;
+ gui_listbox,
+ gui_checkbox,
+ gui_edit;
type
@@ -36,28 +44,58 @@ type
end;
- TfpgFontSelect = class(TfpgForm)
- private
+ TfpgBaseDialog = class(TfpgForm)
+ protected
+ FSpacing: integer;
+ FDefaultButtonWidth: integer;
btnOK: TfpgButton;
btnCancel: TfpgButton;
+ procedure btnOKClick(Sender: TObject); virtual;
+ procedure btnCancelClick(Sender: TObject); virtual;
+ procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+
+ TfpgFontSelectDialog = class(TfpgBaseDialog)
+ private
+ FSampleText: string;
lblLabel1: TfpgLabel;
+ lblLabel2: TfpgLabel;
+ lblLabel3: TfpgLabel;
+ lblLabel4: TfpgLabel;
+ lblLabel5: TfpgLabel;
+ lbCollection: TfpgListBox;
lbFaces: TfpgListBox;
- procedure OnFaceChange(Sender: TObject);
- procedure btnCancelClick(Sender: TObject);
+ lbSize: TfpgListBox;
+ cbBold: TfpgCheckBox;
+ cbItalic: TfpgCheckBox;
+ cbUnderline: TfpgCheckBox;
+ cbAntiAlias: TfpgCheckBox;
+ edSample: TfpgEdit;
+ procedure OnParamChange(Sender: TObject);
procedure CreateFontList;
+ protected
+ function GetFontDesc: string;
+ procedure SetFontDesc(Desc: string);
public
constructor Create(AOwner: TComponent); override;
+ procedure SetSampleText(AText: string);
end;
procedure ShowMessage(AMessage, ATitle: string); overload;
procedure ShowMessage(AMessage: string); overload;
+function SelectFontDialog(var FontDesc: string): boolean;
+
implementation
uses
- gfxbase, gfx_utf8utils;
+ gfxbase,
+ gfx_utf8utils;
procedure ShowMessage(AMessage, ATitle: string);
@@ -79,6 +117,21 @@ begin
ShowMessage(AMessage, 'Message');
end;
+function SelectFontDialog(var FontDesc: string): boolean;
+var
+ frm: TfpgFontSelectDialog;
+begin
+ Result := False;
+ frm := TfpgFontSelectDialog.Create(nil);
+ frm.SetFontDesc(FontDesc);
+ if frm.ShowModal > 0 then
+ begin
+ FontDesc := frm.GetFontDesc;
+ Result := True;
+ end;
+ frm.Free;
+end;
+
{ TfpgMessageBox }
@@ -121,16 +174,16 @@ begin
inherited Create(AOwner);
WindowAttributes := [waAutoPos];
- FLines := TStringList.Create;
- FFont := fpgGetFont('#Label1');
- FTextY := 10;
- FLineHeight := FFont.Height + 4;
- MinWidth := 200;
+ FLines := TStringList.Create;
+ FFont := fpgGetFont('#Label1');
+ FTextY := 10;
+ FLineHeight := FFont.Height + 4;
+ MinWidth := 200;
FMaxLineWidth := 500;
FButton := TfpgButton.Create(self);
- FButton.text := 'OK'; // We must localize this
- FButton.Width := 75;
+ FButton.text := 'OK'; // We must localize this
+ FButton.Width := 75;
FButton.OnClick := @ButtonClick;
end;
@@ -233,20 +286,62 @@ begin
Height := FButton.Top + FButton.Height + FTextY;
end;
+{ TfpgBaseDialog }
-{ TfpgFontSelect }
+procedure TfpgBaseDialog.btnOKClick(Sender: TObject);
+begin
+ ModalResult := 1;
+end;
-procedure TfpgFontSelect.OnFaceChange(Sender: TObject);
+procedure TfpgBaseDialog.btnCancelClick(Sender: TObject);
begin
+ ModalResult := 0;
+ Close;
+end;
+procedure TfpgBaseDialog.HandleKeyPress(var keycode: word;
+ var shiftstate: TShiftState; var consumed: boolean);
+begin
+ if keycode = keyEscape then // Esc cancels the dialog
+ Close
+ else
+ inherited HandleKeyPress(keycode, shiftstate, consumed);
end;
-procedure TfpgFontSelect.btnCancelClick(Sender: TObject);
+constructor TfpgBaseDialog.Create(AOwner: TComponent);
begin
- Close;
+ inherited Create(AOwner);
+ {$Note We need to localize this dialog }
+ Width := 500;
+ Height := 400;
+ WindowPosition := wpScreenCenter;
+ FSpacing := 6;
+ FDefaultButtonWidth := 80;
+
+ btnCancel := CreateButton(self, Width-FDefaultButtonWidth-FSpacing, 370, FDefaultButtonWidth, 'Cancel', @btnCancelClick);
+ btnCancel.ImageName := 'stdimg.Cancel';
+ btnCancel.ShowImage := True;
+ btnCancel.Anchors := [anRight, anBottom];
+
+ btnOK := CreateButton(self, btnCancel.Left-FDefaultButtonWidth-FSpacing, 370, FDefaultButtonWidth, 'OK', @btnOKClick);
+ btnOK.ImageName := 'stdimg.OK';
+ btnOK.ShowImage := True;
+ btnOK.Anchors := [anRight, anBottom];
+end;
+
+
+{ TfpgFontSelectDialog }
+
+procedure TfpgFontSelectDialog.OnParamChange(Sender: TObject);
+var
+ fdesc: string;
+begin
+ fdesc := GetFontDesc;
+ {$IFDEF DEBUG} Writeln(fdesc); {$ENDIF}
+ edSample.FontDesc := fdesc;
end;
-procedure TfpgFontSelect.CreateFontList;
+procedure TfpgFontSelectDialog.CreateFontList;
var
fl: TStringList;
i: integer;
@@ -258,38 +353,274 @@ begin
fl.Free;
end;
-constructor TfpgFontSelect.Create(AOwner: TComponent);
+function TfpgFontSelectDialog.GetFontDesc: string;
+var
+ s: string;
+begin
+ s := lbFaces.Text + '-' + lbSize.Text;
+ if cbBold.Checked then
+ s := s + ':bold';
+
+ if cbItalic.Checked then
+ s := s + ':italic';
+
+ if cbAntiAlias.Checked then
+ s := s + ':antialias=true'
+ else
+ s := s + ':antialias=false';
+
+ if cbUnderline.Checked then
+ s := s + ':underline';
+
+ result := s;
+end;
+
+procedure TfpgFontSelectDialog.SetFontDesc(Desc: string);
+var
+ cp: integer;
+ c: char;
+ i: integer;
+ token: string;
+ prop: string;
+ propval: string;
+
+ function NextC : char;
+ begin
+ inc(cp);
+ if cp > length(desc) then
+ c := #0
+ else
+ c := desc[cp];
+ result := c;
+ end;
+
+ procedure NextToken;
+ begin
+ token := '';
+ while (c <> #0) and (c in [' ','a'..'z','A'..'Z','_','0'..'9']) do
+ begin
+ token := token + c;
+ NextC;
+ end;
+ end;
+
+begin
+ cp := 1;
+ c := desc[1];
+
+ cbBold.Checked := False;
+ cbItalic.Checked := False;
+ cbUnderline.Checked := False;
+ cbAntiAlias.Checked := True;
+
+ NextToken;
+ i := lbFaces.Items.IndexOf(token);
+ if i >= 0 then
+ lbFaces.FocusItem := i+1;
+ if c = '-' then
+ begin
+ NextC;
+ NextToken;
+ i := lbSize.Items.IndexOf(token);
+ if i >= 0 then
+ lbSize.FocusItem := i+1;
+ end;
+
+ while c = ':' do
+ begin
+ NextC;
+ NextToken;
+
+ prop := UpperCase(token);
+ propval := '';
+
+ if c = '=' then
+ begin
+ NextC;
+ NextToken;
+ propval := UpperCase(token);
+ end;
+
+ // Do NOT localize these!
+ if prop = 'BOLD' then
+ begin
+ cbBold.Checked := True;
+ end
+ else if prop = 'ITALIC' then
+ begin
+ cbItalic.Checked := True;
+ end
+ else if prop = 'ANTIALIAS' then
+ begin
+ if propval = 'FALSE' then
+ cbAntialias.Checked := False;
+ end
+ else if prop = 'UNDERLINE' then
+ begin
+ cbUnderline.Checked := True;
+ end;
+
+ end;
+
+ OnParamChange(self);
+end;
+
+constructor TfpgFontSelectDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$Note We need to localize this dialog }
WindowTitle := 'Select Font...';
- Width := 500;
- Height := 400;
- WindowPosition := wpScreenCenter;
-
+ Width := 600;
+ MinWidth := Width;
+ MinHeight := Height;
+ FSampleText := 'The quick brown fox jumps over the lazy dog';
+
+ btnCancel.Left := Width - FDefaultButtonWidth - FSpacing;
+ btnOK.Left := btnCancel.Left - FDefaultButtonWidth - FSpacing;
+
+ lblLabel5 := TfpgLabel.Create(self);
+ with lblLabel5 do
+ begin
+ SetPosition(8, 8, 73, 16);
+ Text := 'Collection:';
+ end;
+
+ {$Note This need to be implemented at some stage. }
+ lbCollection := TfpgListBox.Create(self);
+ with lbCollection do
+ begin
+ SetPosition(8, 28, 145, 236);
+ Items.Add('All Fonts');
+ // These should be stored in <users config path>/fpgui directory
+ Items.Add('Recently Used');
+ Items.Add('Favourites');
+ // From here onwards, these should be created automatically.
+ Items.Add('Fixed Width');
+ Items.Add('Sans');
+ Items.Add('Serif');
+// OnChange := @OnParamChange;
+ FocusItem := 1;
+ Enabled := False;
+ end;
+
lblLabel1 := TfpgLabel.Create(self);
with lblLabel1 do
begin
- SetPosition(8,8,73,16);
- Text := 'Font face:';
+ SetPosition(161, 8, 73, 16);
+ Text := 'Font:';
end;
lbFaces := TfpgListBox.Create(self);
with lbFaces do
begin
- SetPosition(8,28,232,236);
- Items.Add('Faces');
- OnChange := @OnFaceChange;
+ SetPosition(161, 28, 232, 236);
+ Items.Add(' ');
+ OnChange := @OnParamChange;
+ end;
+
+ lblLabel3 := TfpgLabel.Create(self);
+ with lblLabel3 do
+ begin
+ SetPosition(401, 8, 54, 16);
+ Text := 'Size:';
+ end;
+
+ lbSize := TfpgListBox.Create(self);
+ with lbSize do
+ begin
+ SetPosition(401, 28, 52, 236);
+ { We need to improve this! }
+ Items.Add('6');
+ Items.Add('7');
+ Items.Add('8');
+ Items.Add('9');
+ Items.Add('10');
+ Items.Add('11');
+ Items.Add('12');
+ Items.Add('13');
+ Items.Add('14');
+ Items.Add('15');
+ Items.Add('16');
+ Items.Add('18');
+ Items.Add('20');
+ Items.Add('24');
+ Items.Add('28');
+ Items.Add('32');
+ Items.Add('48');
+ Items.Add('64');
+ Items.Add('72');
+ OnChange := @OnParamChange;
+ FocusItem := 5;
+ end;
+
+ lblLabel2 := TfpgLabel.Create(self);
+ with lblLabel2 do
+ begin
+ SetPosition(461, 8, 54, 16);
+ Text := 'Typeface:';
+ end;
+
+ cbBold := TfpgCheckBox.Create(self);
+ with cbBold do
+ begin
+ SetPosition(461, 32, 87, 20);
+ Text := 'Bold';
+ OnChange := @OnParamChange;
+ end;
+
+ cbItalic := TfpgCheckBox.Create(self);
+ with cbItalic do
+ begin
+ SetPosition(461, 56, 87, 20);
+ Text := 'Italic';
+ OnChange := @OnParamChange;
+ end;
+
+ cbUnderline := TfpgCheckBox.Create(self);
+ with cbUnderline do
+ begin
+ SetPosition(461, 80, 87, 20);
+ Text := 'Underline';
+ OnChange := @OnParamChange;
+ end;
+
+ cbAntiAlias := TfpgCheckBox.Create(self);
+ with cbAntiAlias do
+ begin
+ SetPosition(461, 124, 99, 20);
+ Text := 'Anti aliasing';
+ OnChange := @OnParamChange;
+ Checked := True;
+ end;
+
+ lblLabel4 := TfpgLabel.Create(self);
+ with lblLabel4 do
+ begin
+ SetPosition(8, 268, 55, 16);
+ Text := 'Sample:';
+ end;
+
+ edSample := TfpgEdit.Create(self);
+ with edSample do
+ begin
+ SetPosition(8, 288, 584, 65);
+ Text := FSampleText;
+ Anchors := [anLeft, anTop, anRight, anBottom];
end;
-
- btnCancel := CreateButton(self, 415, 370, 80, 'Cancel', @btnCancelClick);
- btnCancel.ImageName := 'stdimg.Cancel';
- btnCancel.ShowImage := True;
- btnCancel.Anchors := [anRight, anBottom];
-
CreateFontList;
end;
+procedure TfpgFontSelectDialog.SetSampleText(AText: string);
+begin
+ if FSampleText = AText then
+ Exit; //==>
+ if AText = '' then
+ Exit; //==>
+
+ FSampleText := AText;
+ edSample.Text := FSampleText;
+end;
+
end.
diff --git a/src/gui/gui_edit.pas b/src/gui/gui_edit.pas
index 989ef45b..a421b9c6 100644
--- a/src/gui/gui_edit.pas
+++ b/src/gui/gui_edit.pas
@@ -27,8 +27,8 @@ type
FMouseDragPos: integer;
FFont: TfpgFont;
FDrawOffset: integer;
- function GetFontName: string;
- procedure SetFontName(const AValue: string);
+ function GetFontDesc: string;
+ procedure SetFontDesc(const AValue: string);
procedure SetText(const AValue: string);
procedure DeleteSelection;
procedure DoCopy;
@@ -51,7 +51,7 @@ type
OnChange: TNotifyEvent;
published
property Text: string read FText write SetText;
- property FontName: string read GetFontName write SetFontName;
+ property FontDesc: string read GetFontDesc write SetFontDesc;
end;
function CreateEdit(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgEdit;
@@ -118,12 +118,12 @@ begin
RePaint;
end;
-function TfpgEdit.GetFontName: string;
+function TfpgEdit.GetFontDesc: string;
begin
Result := FFont.FontDesc;
end;
-procedure TfpgEdit.SetFontName(const AValue: string);
+procedure TfpgEdit.SetFontDesc(const AValue: string);
begin
FFont.Free;
FFont := fpgGetFont(AValue);
diff --git a/src/gui/gui_listbox.pas b/src/gui/gui_listbox.pas
index ad05fbc8..26f52d9e 100644
--- a/src/gui/gui_listbox.pas
+++ b/src/gui/gui_listbox.pas
@@ -579,7 +579,7 @@ end;
procedure TfpgTextListBox.DrawItem(num: integer; rect: TfpgRect; flags: integer);
begin
- Canvas.DrawString(rect.left+2, rect.top+1, FItems.Strings[num-1]);
+ fpgStyle.DrawString(Canvas, rect.left+2, rect.top+1, FItems.Strings[num-1], Enabled);
end;
constructor TfpgTextListBox.Create(AOwner: TComponent);
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-27 13:04:00 +0000