delphi_textpad/main.pas

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, about, ycfg, tpscript;

type
  TfTextPad = class(TForm)
    text: TRichEdit;
    MainMenu: TMainMenu;
    extPad1: TMenuItem;
    About1: TMenuItem;
    Schrift1: TMenuItem;
    Exit1: TMenuItem;
    dSchrift: TFontDialog;
    Save1: TMenuItem;
    Open1: TMenuItem;
    N1: TMenuItem;
    Open: TOpenDialog;
    Save: TSaveDialog;
    Optionen1: TMenuItem;
    Script1: TMenuItem;
    Saveas1: TMenuItem;
    procedure Exit1Click(Sender: TObject);
    procedure Schrift1Click(Sender: TObject);
    procedure loadconfig;
    procedure saveconfig;
    function askReally:word;
    procedure About1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Save1Click(Sender: TObject);
    procedure Saveas1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure textChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    textname:string;
    scriptname:string;
    script:TScript;
  end;

var
  fTextPad: TfTextPad;

implementation

{$R *.dfm}

procedure TfTextPad.loadconfig;
var temps:TStringlist;
begin

  if fileexists(extractfilepath(Application.exename)+'textpad.ycfg') then
    begin
    temps:=TStringlist.Create;

    temps.LoadFromFile(extractfilepath(Application.exename)+'textpad.ycfg');

    text.Font.Color:=getycfgint(temps,'Color',000000);
    text.Font.Name:=getycfgstr(temps,'Font');
    text.Font.Size:=getycfgint(temps,'Fontsize',12);
    if getycfgbool(temps,'Bold') then text.Font.Style := text.Font.Style + [fsBold] else text.Font.Style := text.Font.Style - [fsBold];
    if getycfgbool(temps,'Italic') then text.Font.Style := text.Font.Style + [fsItalic] else text.Font.Style := text.Font.Style - [fsItalic];
    if getycfgbool(temps,'Underline') then text.Font.Style := text.Font.Style + [fsUnderline] else text.Font.Style := text.Font.Style - [fsUnderline];
    if getycfgbool(temps,'StrikeOut') then text.Font.Style := text.Font.Style + [fsStrikeOut] else text.Font.Style := text.Font.Style - [fsStrikeOut];

    scriptname:=extractfilepath(Application.exename)+getycfgstr(temps,'Script');

    temps.Free;
    end;

end;

procedure TfTextPad.saveconfig;
var temps:TStringlist;
begin

  if fileexists(extractfilepath(Application.exename)+'textpad.ycfg') then
    begin
    temps:=TStringlist.Create;

    temps.LoadFromFile(extractfilepath(Application.exename)+'textpad.ycfg');

    setycfgint(temps,'Color',text.font.color);
    setycfgstr(temps,'Font',text.Font.Name);
    setycfgint(temps,'Fontsize',text.Font.size);
    if Integer(fsBold in Text.Font.Style)>0 then setycfgbool(temps,'Bold',true) else setycfgbool(temps,'Bold',false);
    if Integer(fsItalic in Text.Font.Style)>0 then setycfgbool(temps,'Italic',true) else setycfgbool(temps,'Italic',false);
    if Integer(fsUnderline in Text.Font.Style)>0 then setycfgbool(temps,'Underline',true) else setycfgbool(temps,'Underline',false);
    if Integer(fsStrikeOut in Text.Font.Style)>0 then setycfgbool(temps,'StrikeOut',true) else setycfgbool(temps,'StrikeOut',false);

    temps.SaveToFile(extractfilepath(Application.exename)+'textpad.ycfg');

    temps.Free;
    end;

end;

procedure TfTextPad.Exit1Click(Sender: TObject);
begin

  Application.Terminate;

end;

procedure TfTextPad.Schrift1Click(Sender: TObject);
begin

  dSchrift.Font:=text.Font;
  if dSchrift.Execute then text.Font:=dSchrift.Font;

end;

procedure TfTextPad.About1Click(Sender: TObject);
begin

  showabout(Application);

end;

procedure TfTextPad.FormCreate(Sender: TObject);
begin

  loadconfig;

  Script:=TScript.Create;

  Script.loadscript(scriptname);

  textname:='';

  open.InitialDir:=extractfilepath(Application.exename);
  save.InitialDir:=extractfilepath(Application.exename);

  text.SelLength:=2;

end;

procedure TfTextPad.FormClose(Sender: TObject; var Action: TCloseAction);
begin

  saveconfig;

end;

function TfTextPad.askReally:word;
begin

  result:=messagedlg('Du hast nocht gespeichert - Daten Speichern?',mtwarning,[mbyes,mbno,mbAbort],0);

end;

procedure TfTextPad.Save1Click(Sender: TObject);
var temps:TStringlist;
begin

  temps:=TStringlist.Create;

  temps.Text:=text.Lines.Text;

  if textname='' then
    begin
    if save.Execute then
      begin
      textname:=save.FileName;
      temps.SaveToFile(textname);

      end;
    end else temps.SaveToFile(textname);

  text.Modified:=false;

  fTextPad.caption:='TextPad - '+extractfilename(textname);

  temps.Free;

end;

procedure TfTextPad.Saveas1Click(Sender: TObject);
var temps:TStringlist;
begin

  temps:=TStringlist.Create;

  temps.Text:=text.Lines.Text;

  if save.Execute then
    begin
    textname:=save.FileName;
    temps.SaveToFile(textname);
    end;

  text.Modified:=false;

  fTextPad.caption:='TextPad - '+extractfilename(textname);

  temps.Free;

end;

procedure TfTextPad.Open1Click(Sender: TObject);
var tempw:word;
begin

  if text.Modified then
    begin
    tempw:=askReally;

    if tempw=mryes then Save1Click(self);
    if tempw=mrabort then exit;
    end;

  if open.Execute then
    begin
    textname:=open.FileName;
    text.Lines.LoadFromFile(textname);
    end;

  text.Modified:=false;

  fTextPad.caption:='TextPad - '+extractfilename(textname);

end;

procedure TfTextPad.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var tempw:word;
begin

  if text.Modified then
    begin
    tempw:=askReally;

    if tempw=mryes then Save1Click(self);
    if tempw=mrabort then canclose:=false;
    end;

end;

procedure TfTextPad.textChange(Sender: TObject);
var temp:TPoint;
begin

  text.SelLength:=2;

  if script.changedebug then script.setRich(text);

end;

end.