⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ftexteditor.pas

📁 很管用的GIS控件
💻 PAS
字号:
unit fTextEditor;

{$I EZ_FLAG.PAS}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, EzCmdLine, EzColorPicker ;

type
  TfrmTextEditor = class(TForm)
    Panel1: TPanel;
    cboFontName: TComboBox;
    BtnBold: TSpeedButton;
    BtnItal: TSpeedButton;
    BtnUnder: TSpeedButton;
    Memo1: TMemo;
    CboSize: TComboBox;
    ColorBox1: TEzColorBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cboFontNameChange(Sender: TObject);
  private
    { Private declarations }
    FAction: TEzAction;
    FInUpdate: Boolean;
    procedure UpdateText;
  public
    { Public declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Enter(Action: TEzAction);

    procedure CreateText;
  end;

Var
  ParentTextEditorHWND: THandle;

implementation

{$R *.dfm}

uses
  Printers, EzSystem, EzBase, EzActionLaunch, EzEntities, EzLib, EzBaseGis;

{ TfrmTextEditor }

procedure TfrmTextEditor.CreateParams(var Params: TCreateParams);
begin
  Inherited CreateParams( Params );
  With Params Do
  Begin
    Style := Style Or ws_Overlapped;
    WndParent := ParentTextEditorHWND;
  end;
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  If (FontType and TRUETYPE_FONTTYPE) <> 0 Then
  begin
    If TStrings(Data).IndexOf( LogFont.lfFaceName ) < 0 Then
      TStrings(Data).Add( LogFont.lfFaceName );
  end;
  Result := 1;
end;

Procedure TfrmTextEditor.Enter(Action: TEzAction);

  procedure EnumFonts(DC: HDC);
  var
    LogFont: TLogFont;
  begin
    with LogFont do
    begin
      lfCharset := DEFAULT_CHARSET;
      lfFaceName := '';
      lfPitchAndFamily := 0;
    end;
    EnumFontFamiliesEx(DC, LogFont, @EnumFontsProc, Integer(CboFontName.Items), 0);
  end;

begin
  FAction:= Action;

  EnumFonts(Printer.Handle);  // change to Self.Handle for screen fonts

  //CboFontName.Items.Assign( Screen.Fonts );
  CboFontName.Sorted:=true;

  FInUpdate:= True;
  CboFontName.ItemIndex:= CboFontName.Items.IndexOf(Ez_Preferences.DefTTFontStyle.Name);
  CboSize.ItemIndex:= 5;
    //CboSize.Items.IndexOf( IntToStr( Trunc( Action.CmdLine.DrawBox.Grapher.PointsToDistY(Ez_Preferences.DefTTFontStyle.Height) ) ));
  If CboSize.ItemIndex < 0 then
    CboSize.ItemIndex:= 2;
  BtnBold.Down:= fsBold in Ez_Preferences.DefTTFontStyle.Style;
  BtnItal.Down:= fsItalic in Ez_Preferences.DefTTFontStyle.Style;
  BtnUnder.Down:= fsUnderline in Ez_Preferences.DefTTFontStyle.Style;
  ColorBox1.Selected:= Ez_Preferences.DefTTFontStyle.Color;
  FInUpdate:= False;

  CreateText;

  Show;
end;

procedure TfrmTextEditor.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  TAddTextAction( FAction ).FormEditor:= Nil;
  FAction.Finished:= True;
  Action:= caFree;
end;

procedure TfrmTextEditor.UpdateText;
var
  Style: TFontStyles;
begin
  If FInUpdate Then Exit;
  with TAddTextAction(FAction), TEzTrueTypeText( TAddTextAction( FAction ).Text ) do
  begin
    BeginUpdate;
    Fonttool.Name:=cboFontName.Text;
    Fonttool.Height:= CmdLine.ActiveDrawBox.Grapher.PointsToDistY(StrToIntDef(CboSize.Text,8));
    Style:= [];
    if BtnBold.Down then Include(Style, fsBold);
    if BtnItal.Down then Include(Style, fsItalic);
    if BtnUnder.Down then Include(Style, fsUnderline);
    Fonttool.Style:= Style;
    Fonttool.Color:= Colorbox1.Selected;
    TEzTrueTypeText( TAddTextAction( FAction ).Text ).Text:= TrimCrLf( Memo1.Text );
    EndUpdate;
    CmdLine.All_Invalidate;
  end;
end;

procedure TfrmTextEditor.cboFontNameChange(Sender: TObject);
begin
  UpdateText;
end;

procedure TfrmTextEditor.CreateText;
var
  TmpHeight: Double;
begin
  with TAddTextAction(FAction) do
    If Text = Nil Then
    Begin
      TmpHeight:= FAction.CmdLine.ActiveDrawBox.Grapher.PointsToDistY(StrToIntDef(CboSize.Text,8));
      Text:= TEzTrueTypeText.CreateEntity( Point2d(0,0), TrimCrLf(Memo1.Text), TmpHeight, 0 );
      with TEzTrueTypeText(Text).Fonttool do
      begin
        Assign( Ez_Preferences.DefTTFontStyle );
        Name:= cboFontname.Text;
        Style:= [];
        If BtnBold.Down then Style:= Style + [fsBold];
        If BtnItal.Down then Style:= Style + [fsItalic];
        If BtnUnder.Down then Style:= Style + [fsUnderline];
        Color:= ColorBox1.Selected;
        Height:= TmpHeight;
      end;
    End;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -