diff options
| -rw-r--r-- | examples/gui/fontselect/fontselect.lpi | 53 | ||||
| -rw-r--r-- | examples/gui/fontselect/fontselect.lpr | 76 | ||||
| -rw-r--r-- | src/gui/gui_dialogs.pas | 79 |
3 files changed, 207 insertions, 1 deletions
diff --git a/examples/gui/fontselect/fontselect.lpi b/examples/gui/fontselect/fontselect.lpi new file mode 100644 index 00000000..18b66abc --- /dev/null +++ b/examples/gui/fontselect/fontselect.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="fontselect.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="fontselect"/> + </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/fontselect/fontselect.lpr b/examples/gui/fontselect/fontselect.lpr new file mode 100644 index 00000000..f47d996f --- /dev/null +++ b/examples/gui/fontselect/fontselect.lpr @@ -0,0 +1,76 @@ +program fontselect; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, + fpgfx, + gui_form, + gui_dialogs, + gui_button; + + +type + TMainForm = class(TfpgForm) + private + btnQuit: TfpgButton; + btnSelectFont: TfpgButton; + procedure btnQuitClick(Sender: TObject); + procedure btnSelectFontClick(Sender: TObject); + public + constructor Create(AOwner: TComponent); override; + end; + +{ TMainForm } + +procedure TMainForm.btnQuitClick(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.btnSelectFontClick(Sender: TObject); +var + frm: TfpgFontSelect; +begin + frm := TfpgFontSelect.Create(nil); + try + if frm.ShowModal = 1 then + begin + // query font selected in dialog + end; + finally + frm.Free; + end; +end; + +constructor TMainForm.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + WindowTitle := 'Font selection test'; + SetPosition(100, 100, 500, 400); + + 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); +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/gui_dialogs.pas b/src/gui/gui_dialogs.pas index 93144e05..c52fd0ba 100644 --- a/src/gui/gui_dialogs.pas +++ b/src/gui/gui_dialogs.pas @@ -5,7 +5,13 @@ unit gui_dialogs; interface uses - Classes, SysUtils, fpgfx, gui_form, gui_button, gui_label; + Classes, + SysUtils, + fpgfx, + gui_form, + gui_button, + gui_label, + gui_listbox; type @@ -28,6 +34,20 @@ type destructor Destroy; override; procedure SetMessage(AMessage: string); end; + + + TfpgFontSelect = class(TfpgForm) + private + btnOK: TfpgButton; + btnCancel: TfpgButton; + lblLabel1: TfpgLabel; + lbFaces: TfpgListBox; + procedure OnFaceChange(Sender: TObject); + procedure btnCancelClick(Sender: TObject); + procedure CreateFontList; + public + constructor Create(AOwner: TComponent); override; + end; procedure ShowMessage(AMessage, ATitle: string); overload; @@ -214,5 +234,62 @@ begin end; +{ TfpgFontSelect } + +procedure TfpgFontSelect.OnFaceChange(Sender: TObject); +begin + +end; + +procedure TfpgFontSelect.btnCancelClick(Sender: TObject); +begin + Close; +end; + +procedure TfpgFontSelect.CreateFontList; +var + fl: TStringList; + i: integer; +begin + lbFaces.Items.Clear; + fl := fpgApplication.GetFontFaceList; + for i := 0 to fl.Count-1 do + lbFaces.Items.Add(fl.Strings[i]); + fl.Free; +end; + +constructor TfpgFontSelect.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + {$Note We need to localize this dialog } + WindowTitle := 'Select Font...'; + Width := 500; + Height := 400; + WindowPosition := wpScreenCenter; + + lblLabel1 := TfpgLabel.Create(self); + with lblLabel1 do + begin + SetPosition(8,8,73,16); + Text := 'Font face:'; + end; + + lbFaces := TfpgListBox.Create(self); + with lbFaces do + begin + SetPosition(8,28,232,236); + Items.Add('Faces'); + OnChange := @OnFaceChange; + end; + + + btnCancel := CreateButton(self, 415, 370, 80, 'Cancel', @btnCancelClick); + btnCancel.ImageName := 'stdimg.Cancel'; + btnCancel.ShowImage := True; + btnCancel.Anchors := [anRight, anBottom]; + + CreateFontList; +end; + end. |