?? main.pas
字號:
{|----------------------------------------------------------------------
| Unit: Main
|
| Author: Egbert van Nes
|
| Description: Main form for DelFor
|
| Copyright (c) 2000 Egbert van Nes
| All rights reserved
| Disclaimer and licence notes: see license.txt
|
|----------------------------------------------------------------------
}
unit Main;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, ComCtrls, Delfor1;
type
TMainForm = class(TForm)
MainMenu: TMainMenu;
FileOpenItem: TMenuItem;
FileSaveItem: TMenuItem;
FileSaveAsItem: TMenuItem;
FileExitItem: TMenuItem;
WindowTileItem: TMenuItem;
WindowCascadeItem: TMenuItem;
WindowArrangeItem: TMenuItem;
HelpContentsItem: TMenuItem;
HelpAboutItem: TMenuItem;
StatusLine: TStatusBar;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
SpeedBar: TPanel;
ExitButton: TSpeedButton;
FileOpenButton: TSpeedButton;
SaveButton: TSpeedButton;
SaveAllButton: TSpeedButton;
HelpButton: TSpeedButton;
AboutButton: TSpeedButton;
CloseAll1: TMenuItem;
Format1: TMenuItem;
FormatAllItem: TMenuItem;
FormatCurrentItem: TMenuItem;
OptionsItem: TMenuItem;
FormatAllButton: TSpeedButton;
FormatCurrentButton: TSpeedButton;
SaveAllItem: TMenuItem;
Edit1: TMenuItem;
EditUndoItem: TMenuItem;
N1: TMenuItem;
EditCutItem: TMenuItem;
EditPasteItem: TMenuItem;
EditCopyItem: TMenuItem;
FindDialog1: TFindDialog;
N6: TMenuItem;
WindowMinimizeAll: TMenuItem;
EditRedoItem: TMenuItem; { &About... }
procedure FormCreate(Sender: TObject);
procedure ShowHint(Sender: TObject);
procedure FileOpen(Sender: TObject);
procedure FileSave(Sender: TObject);
procedure FileSaveAs(Sender: TObject);
procedure FileExit(Sender: TObject);
procedure WindowTile(Sender: TObject);
procedure WindowCascade(Sender: TObject);
procedure WindowArrange(Sender: TObject);
procedure HelpContents(Sender: TObject);
procedure HelpAbout(Sender: TObject);
procedure CloseAll1Click(Sender: TObject);
procedure FormatAllItemClick(Sender: TObject);
procedure FormatCurrentItemClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure SaveAllItemClick(Sender: TObject);
procedure EditUndoItemClick(Sender: TObject);
procedure EditCutItemClick(Sender: TObject);
procedure EditCopyItemClick(Sender: TObject);
procedure EditPasteItemClick(Sender: TObject);
procedure EditFindItemClick(Sender: TObject);
procedure FindDialog1Find(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure OptionsItemClick(Sender: TObject);
procedure FileReloadAllItemClick(Sender: TObject);
procedure WindowMinimizeAllClick(Sender: TObject);
procedure EditRedoItemClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
public
Formatter: TPascalParser;
ViewForm: TForm;
procedure UpdateMenu;
function GetActiveForm: TForm;
procedure PerformFileOpen(AFileName: string);
procedure Config(DoRead: Boolean);
end;
var
MainForm: TMainForm;
implementation
uses ViewWnd, Progr, About, OptDlg, Clipbrd;
{$R *.DFM}
procedure TMainForm.UpdateMenu;
var
Child: TForm;
I: Integer;
P1, P2: TPoint;
HasKids, HasChanged, FormattedAll: Boolean;
CurrentFormatted, CurrentModified, HasSelected: Boolean;
begin
HasKids := MDIChildCount > 0;
HasChanged := False;
FormattedAll := HasKids;
for I := 0 to MDIChildCount - 1 do
begin
Child := MDIChildren[I];
if Child is TViewForm then
with TViewForm(Child), Memo1 do
begin
if AllFormatted then
HasChanged := True
else
begin
if Modified then
HasChanged := True;
FormattedAll := False;
end;
end;
end;
Child := GetActiveForm;
CurrentFormatted := (Child <> nil) and (TViewForm(Child).CurrentFormatted);
if Child <> nil then
begin
P1 := TViewForm(Child).Memo1.BlockBegin;
P2 := TViewForm(Child).Memo1.BlockEnd;
end;
HasSelected := (Child <> nil) and not CompareMem(@P1, @P2, SizeOf(TPoint));
CurrentModified := (Child <> nil) and (TViewForm(Child).Memo1.Modified);
FileSaveItem.Enabled := HasKids and CurrentModified or CurrentFormatted;
FileSaveAsItem.Enabled := HasKids;
WindowTileItem.Enabled := HasKids;
WindowCascadeItem.Enabled := HasKids;
WindowArrangeItem.Enabled := HasKids;
CloseAll1.Enabled := HasKids;
FormatAllItem.Enabled := HasKids and not FormattedAll;
FormatCurrentItem.Enabled := HasKids and not CurrentFormatted;
SaveAllItem.Enabled := HasChanged;
if ViewForm <> nil then
begin
EditUndoItem.Enabled := HasKids and TViewForm(ViewForm).Memo1.CanUndo;
EditRedoItem.Enabled := HasKids and TViewForm(ViewForm).Memo1.CanRedo;
end;
EditCutItem.Enabled := HasKids and HasSelected;
EditPasteItem.Enabled := HasKids and Clipboard.HasFormat(CF_TEXT);
EditCopyItem.Enabled := HasKids and HasSelected;
WindowMinimizeAll.Enabled := HasKids;
SaveButton.Enabled := HasKids and CurrentModified or CurrentFormatted;
SaveAllButton.Enabled := HasKids;
FormatAllButton.Enabled := HasKids and not FormattedAll;
FormatCurrentButton.Enabled := HasKids and not CurrentFormatted;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnHint := ShowHint;
Application.HelpFile := ChangeFileExt(ParamStr(0), '.hlp');
Formatter := TPascalParser.Create(PChar(ExtractFilePath(ParamStr(0))));
Formatter.CfgFile := ChangeFileExt(ParamStr(0), '.cfg');
Config(True);
end;
procedure TMainForm.ShowHint(Sender: TObject);
begin
StatusLine.SimpleText := Application.Hint;
end;
function GetNextFile(var ProjFile {, inFile}: Text; var FileName: string):
Boolean;
var
Buf: array[0..300] of Char;
P, P2: PChar;
begin
repeat
Readln(ProjFile, Buf);
if (StrScan(Buf, '''') <> nil) and
(StrPos(Buf, ' in') <> nil) then
begin
P := StrScan(Buf, '''') + 1;
P2 := StrScan(P, '''');
if P2 <> nil then
begin
P2^ := #0;
FileName := string(P);
end;
Result := True;
Exit;
end
until Eof(ProjFile);
Result := False;
end;
procedure TMainForm.PerformFileOpen(AFileName: string);
var
{ViewForm: TViewForm;}
ProjFile: TextFile;
FileName, Dir: string;
begin
if FileExists(AFileName) then
begin
if ViewForm = nil then
ViewForm := TViewForm.Create(Self);
with TViewForm(ViewForm) do
begin
LoadFile(AFileName);
Show;
end;
if (CompareText(ExtractFileExt(AFileName),
'.dpr') = 0) and (MessageDlg('Ok to open all files in the project "' +
ExtractFileName(AFileName) + '" ?',
mtConfirmation, [mbYes, mbNo], 0) = ID_YES) then
begin
AssignFile(ProjFile, AFileName);
try
Dir := ExtractFileDir(ExpandFileName(AFileName));
if Dir <> '' then
Chdir(Dir);
Reset(ProjFile);
while GetNextFile(ProjFile, FileName) do
begin
if ViewForm = nil then
ViewForm := TViewForm.Create(Self);
with TViewForm(ViewForm) do
begin
LoadFile(FileName);
if Caption = '' then
Free
else
Show;
end;
end;
finally
CloseFile(ProjFile);
end;
end;
end;
end;
procedure TMainForm.FileOpen(Sender: TObject);
var
I: Integer;
begin
with OpenDialog do
if Execute then
begin
with Files do
for I := 0 to Count - 1 do
PerformFileOpen(Files.Strings[I]);
end;
UpdateMenu;
end;
procedure TMainForm.FileSave(Sender: TObject);
var
ViewForm: TForm;
begin
ViewForm := Screen.ActiveForm;
if (ViewForm <> nil) and (ViewForm is TViewForm) then
TViewForm(ViewForm).SaveTo('');
UpdateMenu;
end;
procedure TMainForm.FileSaveAs(Sender: TObject);
var
ViewForm: TForm;
begin
ViewForm := Screen.ActiveForm;
if (ViewForm <> nil) and (ViewForm is TViewForm) then
begin
SaveDialog.FileName := ViewForm.Caption;
if SaveDialog.Execute then
with TViewForm(ViewForm) do
begin
SetCurrentFileName(SaveDialog.FileName);
SaveCurrent;
end;
end;
UpdateMenu;
end;
procedure TMainForm.FileExit(Sender: TObject);
begin
Close;
end;
procedure TMainForm.WindowTile(Sender: TObject);
begin
Tile;
end;
procedure TMainForm.WindowCascade(Sender: TObject);
begin
Cascade;
end;
procedure TMainForm.WindowArrange(Sender: TObject);
begin
ArrangeIcons;
end;
procedure TMainForm.HelpContents(Sender: TObject);
begin
Application.HelpCommand(Help_Contents, 0);
end;
procedure TMainForm.HelpAbout(Sender: TObject);
begin
AboutBox.ShowModal;
end;
procedure TMainForm.CloseAll1Click(Sender: TObject);
var
I: Integer;
begin
{ Must be done backwards through the MDIChildren array }
for I := MDIChildCount - 1 downto 0 do
MDIChildren[I].Close;
UpdateMenu;
end;
procedure TMainForm.FormatAllItemClick(Sender: TObject);
var
I: Integer;
Child: TForm;
begin
ProgressDlg.Show;
Application.ProcessMessages;
for I := 0 to MDIChildCount - 1 do
begin
Child := MDIChildren[I];
if Child is TViewForm then
TViewForm(Child).FormatAll;
end;
ProgressDlg.Hide;
UpdateMenu;
end;
procedure TMainForm.FormatCurrentItemClick(Sender: TObject);
begin
ViewForm := Screen.ActiveForm;
if (ViewForm <> nil) and (ViewForm is TViewForm) then
begin
ProgressDlg.Show;
Application.ProcessMessages;
TViewForm(ViewForm).FormatCurrent;
if ProgressDlg <> nil then
ProgressDlg.Hide;
end;
UpdateMenu;
end;
procedure TMainForm.FormShow(Sender: TObject);
var
I: Integer;
Dir: string;
begin
if OptionsDlg <> nil then
OptionsDlg.HelpFile := PChar(Application.HelpFile);
if ProgressDlg <> nil then
begin
ProgressDlg.Hide;
ProgressDlg.Parent := Application.MainForm;
end;
if paramCount > 0 then
begin
for I := 1 to paramCount do
PerformFileOpen(ParamStr(I));
Dir := ExtractFileDir(ExpandFileName(ParamStr(paramCount)));
if Dir <> '' then
Chdir(Dir);
end;
UpdateMenu;
OptionsDlg.Formatter := Formatter;
end;
procedure TMainForm.SaveAllItemClick(Sender: TObject);
var
Child: TForm;
I: Integer;
Action: TCloseAction;
begin
for I := 0 to MDIChildCount - 1 do
begin
Child := MDIChildren[I];
if Child is TViewForm then
TViewForm(Child).FormClose(nil, Action);
end;
UpdateMenu;
end;
function TMainForm.GetActiveForm: TForm;
begin
Result := TForm(Screen.ActiveForm);
if (Result <> nil) and not (Result is TViewForm) then
Result := nil;
end;
procedure TMainForm.EditUndoItemClick(Sender: TObject);
begin
ViewForm := TForm(GetActiveForm);
if ViewForm <> nil then
TViewForm(ViewForm).Memo1.Undo;
end;
procedure TMainForm.EditCutItemClick(Sender: TObject);
begin
ViewForm := TForm(GetActiveForm);
if ViewForm <> nil then
with TViewForm(ViewForm).Memo1 do
CutToClipboard;
UpdateMenu;
end;
procedure TMainForm.EditCopyItemClick(Sender: TObject);
begin
ViewForm := TForm(GetActiveForm);
if ViewForm <> nil then
with TViewForm(ViewForm).Memo1 do
CopyToClipboard;
end;
procedure TMainForm.EditPasteItemClick(Sender: TObject);
begin
ViewForm := TForm(GetActiveForm);
if ViewForm <> nil then
with TViewForm(ViewForm).Memo1 do
PasteFromClipboard;
end;
procedure TMainForm.EditFindItemClick(Sender: TObject);
begin
ViewForm := TForm(GetActiveForm);
if ViewForm <> nil then
begin
with TViewForm(ViewForm) do
begin
SelStart := 0;
SelLength := 0;
end;
FindDialog1.Execute;
end;
end;
procedure TMainForm.FindDialog1Find(Sender: TObject);
var
SelPos, StartPos: Integer;
begin
if ViewForm <> nil then
with TViewForm(ViewForm), Memo1, FindDialog1 do
begin
{ Perform a global case-sensitive search for FindText in Memo1 }
StartPos := SelStart + SelLength;
if frMatchCase in Options then
SelPos := Pos(FindText, Lines.Text[StartPos])
else
SelPos := Pos({UpperCase}(FindText),
{UpperCase}(Memo1.Lines.Text[StartPos]));
if SelPos > 0 then
begin
SelStart := StartPos + SelPos - 1;
SelLength := Length(FindText);
ViewForm.SetFocus;
CloseDialog;
end
else
MessageDlg(Concat('Could not find "', FindText, '" in Memo1.'), mtError,
[mbOK], 0);
end;
UpdateMenu;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
Config(False);
Formatter.Free;
MainForm := nil;
end;
procedure TMainForm.OptionsItemClick(Sender: TObject);
begin
OptionsDlg.ShowModal;
if ViewForm <> nil then
begin
ProgressDlg.Show;
TViewForm(ViewForm).FormatFormatted;
ProgressDlg.Hide;
end;
end;
procedure TMainForm.FileReloadAllItemClick(Sender: TObject);
var
Child: TForm;
I: Integer;
begin
for I := 0 to MDIChildCount - 1 do
begin
Child := MDIChildren[I];
if Child is TViewForm then
with TViewForm(Child) do
if {Formatted or} Memo1.Modified then
LoadFile(Caption);
end;
ProgressDlg.Hide;
UpdateMenu;
end;
procedure TMainForm.WindowMinimizeAllClick(Sender: TObject);
var
I: Integer;
begin
for I := MDIChildCount - 1 downto 0 do
MDIChildren[I].WindowState := wsMinimized;
end;
procedure TMainForm.Config(DoRead: Boolean);
begin
Formatter.Config(DoRead);
end;
procedure TMainForm.EditRedoItemClick(Sender: TObject);
begin
if ViewForm <> nil then
TViewForm(ViewForm).Memo1.Redo;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
i: integer;
begin
CloseAll1Click(nil);
CanClose := True;
for i := 0 to MDIChildCount - 1 do
if TForm(MDIChildren[i]).ModalResult = mrcancel then
CanClose := False;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -