unit1.pas

Java实例入门

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, ActnMan, ComCtrls, StdCtrls, StdActns, ToolWin,
  ActnCtrls, ActnMenus, ImgList, About, CustomizeDlg, ExtActns;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    StatusBar1: TStatusBar;
    ActionManager1: TActionManager;
    FileNew: TAction;
    FileSave: TAction;
    HelpIndex: TAction;
    HelpAbout: TAction;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    HelpContents1: THelpContents;
    FileOpen1: TFileOpen;
    FileSaveAs1: TFileSaveAs;
    FileExit1: TFileExit;
    ImageList1: TImageList;
    ActionMainMenuBar1: TActionMainMenuBar;
    ActionToolBar1: TActionToolBar;
    CustomizeDlg1: TCustomizeDlg;
    FilePrintSetup1: TFilePrintSetup;
    EditSelectAll1: TEditSelectAll;
    EditUndo1: TEditUndo;
    EditDelete1: TEditDelete;
    RichEditBold1: TRichEditBold;
    RichEditItalic1: TRichEditItalic;
    RichEditUnderline1: TRichEditUnderline;
    RichEditBullets1: TRichEditBullets;
    RichEditAlignLeft1: TRichEditAlignLeft;
    RichEditAlignRight1: TRichEditAlignRight;
    RichEditAlignCenter1: TRichEditAlignCenter;
    SearchFind1: TSearchFind;
    SearchFindNext1: TSearchFindNext;
    SearchReplace1: TSearchReplace;
    FontEdit1: TFontEdit;
    Seperator: TAction;
    ToolBar2: TToolBar;
    FontName: TComboBox;
    ToolButton3: TToolButton;
    FontSize: TEdit;
    UpDown1: TUpDown;
    ToolButton5: TToolButton;
    BoldButton: TToolButton;
    ItalicButton: TToolButton;
    UnderlineButton: TToolButton;
    ToolButton6: TToolButton;
    LeftButton: TToolButton;
    CenterButton: TToolButton;
    RightButton: TToolButton;
    ToolButton10: TToolButton;
    BulletsButton: TToolButton;
    procedure FileNewExecute(Sender: TObject);
    procedure FileOpen1Accept(Sender: TObject);
    procedure FileSaveExecute(Sender: TObject);
    procedure HelpContents1Execute(Sender: TObject);
    procedure HelpIndexExecute(Sender: TObject);
    procedure HelpAboutExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ShowHint(Sender: TObject);
    procedure FontNameChange(Sender: TObject);
    procedure FontSizeChange(Sender: TObject);
    procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    
  private
    { Private declarations }
  public
    { Public declarations }
    FileName: String;
    procedure GetFontNames;
    function CurrText: TTextAttributes;
    procedure ShowCurPos;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
//此函数用于列举系统安装的所有字体
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;

procedure TForm1.GetFontNames;
//此过程用于列举所有字体名称，并将字体加载到FontName下拉框中
var
  DC: HDC;
begin
  DC := GetDC(0);
  EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
  ReleaseDC(0, DC);
  FontName.Sorted := True;
end;

function TForm1.CurrText: TTextAttributes;
//此函数用于判断当前选择的文本属性
begin
  if RichEdit1.SelLength > 0
  then Result := RichEdit1.SelAttributes
  else Result := RichEdit1.DefAttributes;
end;

procedure TForm1.ShowCurPos;
//此过程用于显示当前编辑位置出的行，列值及字数
var
  LPos,CPos,LineLength:Integer;
begin
  LPos:= SendMessage(RichEdit1.Handle, EM_LINEFROMCHAR,
    RichEdit1.SelStart, 0);
  CPos:= SendMessage(RichEdit1.Handle, EM_LINEINDEX, LPos, 0);
  LineLength:=SendMessage(RichEdit1.Handle, EM_LINELENGTH, LPos, 0);
  CPos:=RichEdit1.SelStart-CPos;
  LPos:=LPos+1;
  CPos:=CPos+1;
  StatusBar1.SimpleText := '行：'+IntToStr(LPos) + '    列：'+IntToStr(CPos)
                            + '     此行字数：'+IntToStr(LineLength);
end;


procedure TForm1.FileNewExecute(Sender: TObject);
begin
  RichEdit1.Clear;                       //清空文本编辑区域
  FileName := '未命名文件.txt';          //设置文件名为未命名文件
  StatusBar1.Panels[0].Text := FileName;  //在状态条上显示文件名
end;

procedure TForm1.FileOpen1Accept(Sender: TObject);
begin
  RichEdit1.Lines.LoadFromFile(FileOpen1.Dialog.FileName);
  FileName := FileOpen1.Dialog.FileName;
  Form1.Caption := FileName;
  StatusBar1.Panels[0].Text := FileName;
end;

procedure TForm1.FileSaveExecute(Sender: TObject);
begin
  if(FileName = '未命名文件.txt') then
    FileSaveAs1.Execute
  else
    RichEdit1.Lines.SaveToFile(FileName);
end;

procedure TForm1.HelpContents1Execute(Sender: TObject);
const
  HELP_TAB = 15;
  CONTENTS_ACTIVE = -3;
begin
  Application.HelpCommand(HELP_TAB, CONTENTS_ACTIVE);
end;

procedure TForm1.HelpIndexExecute(Sender: TObject);
const
  HELP_TAB = 15;
  INDEX_ACTIVE = -2;
begin
  Application.HelpCommand(HELP_TAB, INDEX_ACTIVE);
end;

procedure TForm1.HelpAboutExecute(Sender: TObject);
begin
  with TAboutBox.Create(Self) do
  try
    ShowModal;
  finally
    Free;
  end;
end;

procedure TForm1.ShowHint(Sender: TObject);
//此过程用于显示在状态栏提示信息
begin
  if Length(Application.Hint) > 0 then
  begin
    StatusBar1.SimplePanel := True;
    StatusBar1.SimpleText := Application.Hint;
  end
  else StatusBar1.SimpleText := '欢迎使用本软件！';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnHint := ShowHint;
  Application.HelpFile := ExtractFilePath(Application.ExeName) + 'TextEditor.hlp';
  GetFontNames;
end;

procedure TForm1.FontNameChange(Sender: TObject);
begin
  CurrText.Name := FontName.Items[FontName.ItemIndex];
end;

procedure TForm1.FontSizeChange(Sender: TObject);
begin
  CurrText.Size := StrToInt(FontSize.Text);
end;

procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  ShowCurPos;
end;

procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ShowCurPos;
end;



end.