Текущий архив: 2006.01.29;
Скачать: CL | DM;

Вниз

FontDialog - как отключить начертание и выбор кодировки?   Найти похожие ветки 

← →
Olsher   (2005-12-27 16:11) [0]

Как можно отключить начертание и выбор кодировки в FontDialog?
Спасибо

---

← →
Джо ©   (2005-12-27 16:35) [1]

> Olsher   (27.12.05 16:11)

В свойстве Options отключи ненужное.

---

← →
Джо ©   (2005-12-27 16:39) [2]

> [1] Джо ©   (27.12.05 16:35)
> В свойстве Options отключи ненужное.

Хотя, похоже, именно эти вещи и не отключишь таким способом, поспешил я.
В принципе, должно быть несложно написать свой диалог с нужными опциями.

---

← →
Eraser ©   (2005-12-27 16:58) [3]

> Olsher   (27.12.05 16:11)

Как вариант, перед запуском диалога запоминать нужную кодировку и начертание, а после диалога, восстанавливать те значения этих параметров, которые были до вызова диалога.

---

← →
Джо ©   (2005-12-27 17:34) [4]

> Olsher  

Вот, набросал каркас от нечего делать. При необходимости совершенно несложно добавить нужную функциональность, довести до ума и/или превратить этот класс в компонент.
Юнит с классом:

unit FntDlg;

interface
uses SysUtils, Classes, Graphics, StdCtrls, Forms;

type

 TSimpleFontDialog = class
 private
   FFont: TFont;
   FCaption: string;
   Dlg: TForm;
   BtnOK,
   BtnCancel: TButton;
   FontCombo,
   FontSizeCombo: TComboBox;
   function GetFont: TFont;
   procedure SetFont(const Value: TFont);
   procedure PopulateFontNames (AList: TStrings);
   procedure PopulateFontSizes (AList: TStrings);
   procedure OnOkBtnClick (Sender: TObject);
   function FontNameTextValid (AValue: string): Boolean;
   function FontSizeTextValid (AValue: string): Boolean;
   procedure CreateDialog;
 public
   constructor Create;
   destructor Destroy; override;
   property Font: TFont read GetFont write SetFont;
   property Caption: string read FCaption write FCaption;
   function Execute: Boolean;
 end;

implementation
uses Dialogs, Controls;

{ TSimpleFontDialog }

constructor TSimpleFontDialog.Create;
begin
 inherited Create;
 FFont := TFont.Create;
 FCaption := "Select font";
end;

destructor TSimpleFontDialog.Destroy;
begin
 FFont.Free;
 inherited;
end;

function TSimpleFontDialog.Execute: Boolean;
begin
 Dlg := TForm.Create(nil);
 try
   CreateDialog;

   Result := Dlg.ShowModal = mrOK;

   if Result then
   begin
     FFont.Name := FontCombo.Text;
     FFont.Size := StrToInt (FontSizeCombo.Text);
   end;

 finally
   Dlg.Free;
 end;
end;

procedure TSimpleFontDialog.CreateDialog;
begin
 Dlg.BorderStyle := bsDialog;
 Dlg.Position := poScreenCenter;
 Dlg.Caption := FCaption;
 Dlg.Width := 332;
 Dlg.Height := 280;

 FontCombo := TComboBox.Create(Dlg);
 with FontCombo do
 begin
   Parent := Dlg;
   Style := csSimple;
   Left := 4;
   Top := 4;
   Width := 230;
   Height := 220;
 end;
 PopulateFontNames(FontCombo.Items);
 FontCombo.Text := FFont.Name;
 FontCombo.ItemIndex :=
   FontCombo.Items.IndexOf(FFont.Name);

 FontSizeCombo := TComboBox.Create(Dlg);
 with FontSizeCombo do
 begin
   Parent := Dlg;
   Style := csSimple;
   Left := 240;
   Top := 4;
   Width := 80;
   Height := 220;
 end;
 PopulateFontSizes(FontSizeCombo.Items);
 FontSizeCombo.Text := IntToStr(FFont.Size);
 FontSizeCombo.ItemIndex :=
   FontSizeCombo.Items.IndexOf(IntToStr(FFont.Size));

 BtnOK := TButton.Create(Dlg);
 with BtnOK do
 begin
   Parent := Dlg;
   Left := 160;
   Top := 220;
   Caption := "OK";
   Default := True;
   OnClick := OnOkBtnClick;
 end;

 btnCancel := TButton.Create(Dlg);
 with btnCancel do
 begin
   Parent := Dlg;
   Left := 243;
   Top := 220;
   Caption := "Отмена";
   Cancel := True;
   ModalResult := mrCancel;
 end;
end;

function TSimpleFontDialog.FontNameTextValid(AValue: string): Boolean;
begin
 Result := Screen.Fonts.IndexOf(AValue) <> -1
end;

function TSimpleFontDialog.FontSizeTextValid(AValue: string): Boolean;
var
 Dummy: Integer;
begin
 Result := TryStrToInt(AValue, Dummy)
end;

function TSimpleFontDialog.GetFont: TFont;
begin
 Result := FFont;
end;

procedure TSimpleFontDialog.OnOkBtnClick(Sender: TObject);
begin
 if not FontNameTextValid(FontCombo.Text) then
   MessageDlg("Неверное имя шрифта",mtWarning,[MBOK],-1)
 else
   if not FontSizeTextValid (FontSizeCombo.Text) then
     MessageDlg("Размер шрифта должен быть целым числом",mtWarning,[MBOK],-1)
   else
     Dlg.ModalResult := mrOK;
end;

procedure TSimpleFontDialog.PopulateFontNames(AList: TStrings);
begin
 AList.AddStrings(Screen.Fonts);
end;

procedure TSimpleFontDialog.PopulateFontSizes(AList: TStrings);
const
 MAX_FONT_SIZE = 200;
var
 I: Integer;
begin
 for I := 4 to MAX_FONT_SIZE do
 begin
   if not Odd(I) then
     AList.Add(IntToStr(I))
 end;
end;

procedure TSimpleFontDialog.SetFont(const Value: TFont);
begin
 FFont.Assign(Value);
end;

end.

Пример использования:

uses ...,FntDlg,....;
procedure TForm1.Button1Click(Sender: TObject);
var
 FontDialog: TSimpleFontDialog;
begin
 FontDialog := TSimpleFontDialog.Create;
 try
   FontDialog.Caption := "Выберите шрифт";
   if FontDialog.Execute then
   begin
     Button1.Font.Name := FontDialog.Font.Name;
     Button1.Font.Size := FontDialog.Font.Size;
   end;
 finally
   FontDialog.Free;
 end;
end;


---

← →
Olsher   (2005-12-27 17:54) [5]

Спасибо!

---

Страницы: 1 вся ветка

Текущий архив: 2006.01.29;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.046 c