coolbar.pas

一个综合管理的程序,包含ie属性调用,控制面版打开,解锁注册表

unit coolbar;

interface

uses


  Windows, Messages, SysUtils,ShellAPI, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ImgList, StdCtrls, ComCtrls, ToolWin, ExtCtrls;

type
  TTexteditForm = class(TForm)
    MainMenu1: TMainMenu;
    ImageList1: TImageList;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FontDialog1: TFontDialog;
    ColorDialog1: TColorDialog;
    PrintDialog1: TPrintDialog;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    filemenu: TMenuItem;
    filenew: TMenuItem;
    fileopen: TMenuItem;
    filesave: TMenuItem;
    fileprint: TMenuItem;
    fileexit: TMenuItem;
    editmenu: TMenuItem;
    editfont: TMenuItem;
    editfind: TMenuItem;
    editreplace: TMenuItem;
    filecolor: TMenuItem;
    helpmenu: TMenuItem;
    helpabout: TMenuItem;
    richedit1: TRichEdit;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    nameComboBox: TComboBoxEx;
    sizeComboBox: TComboBoxEx;
    helpToolButton: TToolButton;
    saveToolButton: TToolButton;
    findToolButton: TToolButton;
    undoToolButton: TToolButton;
    fontToolButton: TToolButton;
    openToolButton: TToolButton;
    colorToolButton: TToolButton;
    cutToolButton: TToolButton;
    replaceToolButton: TToolButton;
    wrapToolButton: TToolButton;
    copyToolButton: TToolButton;
    pasteToolButton: TToolButton;
    newToolButton: TToolButton;
    boldToolButton: TToolButton;
    italicToolButton: TToolButton;
    underlineToolButton: TToolButton;
    leftToolButton: TToolButton;
    centerToolButton: TToolButton;
    rightToolButton: TToolButton;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Splitter3: TSplitter;
    Splitter4: TSplitter;
    procedure filenewClick(Sender: TObject);
    procedure fileopenClick(Sender: TObject);
    procedure filesaveClick(Sender: TObject);
    procedure fileprintClick(Sender: TObject);

    procedure editfontClick(Sender: TObject);
    procedure editfindClick(Sender: TObject);
    procedure editreplaceClick(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure filecolorClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure nameComboBoxSelect(Sender: TObject);
    procedure sizeComboBoxSelect(Sender: TObject);
    procedure boldToolButtonClick(Sender: TObject);
    procedure italicToolButtonClick(Sender: TObject);
    procedure underlineToolButtonClick(Sender: TObject);
    procedure leftToolButtonClick(Sender: TObject);
    procedure richedit1SelectionChange(Sender: TObject);
    procedure undoToolButtonClick(Sender: TObject);
    procedure cutToolButtonClick(Sender: TObject);
    procedure wrapToolButtonClick(Sender: TObject);
    procedure copyToolButtonClick(Sender: TObject);
    procedure pasteToolButtonClick(Sender: TObject);
    
    procedure helpaboutClick(Sender: TObject);

  private

    function setSave:Bool;
  public
    { Public declarations }
  end;



var
  TexteditForm: TTexteditForm;



implementation

{$R *.dfm}

procedure TTexteditForm.filenewClick(Sender: TObject);
begin
  if setsave then
  RichEdit1.lines.Clear;
end;

procedure TTexteditForm.fileopenClick(Sender: TObject);
begin
   if setsave then
    with OpenDialog1 do
   begin
    Options := [ofHideReadOnly,ofFileMustExist];
    OptionsEx := [ofExNoPlacesBar];
    if Execute then
     if ofExtensionDifferent in Options then
       ShowMessage('打开文件类型错误!')
      else
       RichEdit1.Lines.LoadFromFile(Filename);
   end;
end;

procedure TTexteditForm.filesaveClick(Sender: TObject);
begin
   with SaveDialog1 do
  begin
   Options := [ofOverwritePrompt];
   OptionsEx := [ofExNoPlacesBar];
    if Execute then
     richedit1.Lines.SaveToFile(Filename);
  end;
end;

procedure TTexteditForm.fileprintClick(Sender: TObject);
var i: Integer;
begin

 if PrintDialog1.Execute then
   for i := 1 to PrintDialog1.Copies do
    RichEdit1.Print('默认打印文档');

end;



procedure TTexteditForm.editfontClick(Sender: TObject);
begin
   if FontDialog1.Execute then
   if RichEdit1.SelLength>0 then
   RichEdit1.SelAttributes.Assign(FontDialog1.Font);
end;

procedure TTexteditForm.editfindClick(Sender: TObject);

begin
  with FindDialog1 do
  begin
   Options := [frDown,frHideMatchCase,frHideWholeWord];
   Execute;
  end;

end;
procedure TTexteditForm.editreplaceClick(Sender: TObject);

begin
  with ReplaceDialog1 do
   begin
   Options := [frDown,frHideMatchCase,frHideWholeWord];
   Execute ;
   end;
end;

procedure TTexteditForm.ReplaceDialog1Replace(Sender: TObject);
var
  SelPos: Integer;
begin
  with TReplaceDialog(Sender) do
  begin
  { 在RichEdit中进行区分大小写的完全查找 }
    SelPos := Pos(FindText, RichEdit1.Lines.Text);
    if SelPos > 0 then
     begin
      RichEdit1.SelStart := SelPos - 1;
      RichEdit1.SelLength := Length(FindText);
      { 替换字符串 }
      RichEdit1.SelText := ReplaceText;
     end
    else
     MessageDlg(Concat('找不到 "', FindText, '"！ '), mtError, [mbOk], 0);
  end;
end;

procedure TTexteditForm.FindDialog1Find(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
begin
  with RichEdit1 do
  begin
    if SelLength <> 0 then
      StartPos := SelStart + SelLength
    else
      StartPos := 0;
    ToEnd := Length(Text) - StartPos;
    FoundAt := FindText(FindDialog1.FindText, StartPos, ToEnd, [stMatchCase]);
    if FoundAt <> -1 then
    begin
      SetFocus;
      SelStart := FoundAt;
      SelLength := Length(FindDialog1.FindText);
    end;
  end;
end;

procedure TTexteditForm.filecolorClick(Sender: TObject);
begin
   if ColorDialog1.Execute then
   Richedit1.Color := ColorDialog1.Color;
end;

procedure TTexteditForm.FormCreate(Sender: TObject);
begin
   OpenDialog1.Filter:= 'Text Files(*.txt)|*.txt|Rich Type Files(*.rtf)|*.rtf';
 SaveDialog1.Filter:= 'Text Files(*.txt)|*.txt|Rich Type Files(*.rtf)|*.rtf';
 nameComboBox.Items.AddStrings(Screen.Fonts);





end;

function TTexteditForm.setSave:Bool;
var Confirm: word;
begin
 setSave:=True;
 if RichEdit1.Modified then
  Confirm:=MessageDlg('文件还没有保存！是否保存？',mtWarning,[mbYes,mbNo,mbCancel], 0);
  if Confirm=mrCancel then
   setSave:=False;
  if Confirm=mrYes then
   if SaveDialog1.Execute then
    setSave:=True
   else
    setSave:=False;
end;
procedure TTexteditForm.nameComboBoxSelect(Sender: TObject);
begin
  if RichEdit1.SelLength>0 then
  RichEdit1.SelAttributes.Name:=nameComboBox.Items.Strings[nameComboBox.ItemIndex];
end;

procedure TTexteditForm.sizeComboBoxSelect(Sender: TObject);
begin
    if RichEdit1.SelLength>0 then
  RichEdit1.SelAttributes.Size:=StrToInt(SizeComboBox.Items.Strings[SizeComboBox.ItemIndex]);
end;

procedure TTexteditForm.boldToolButtonClick(Sender: TObject);
begin
  if boldToolButton.Down then
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style+[fsBold]
 else
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style-[fsBold];
end;

procedure TTexteditForm.italicToolButtonClick(Sender: TObject);
begin
if italicToolButton.Down then
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style+[fsItalic]
 else
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style-[fsItalic];
end;

procedure TTexteditForm.underlineToolButtonClick(Sender: TObject);
begin
 if underlineToolButton.Down then
 RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style+[fsUnderline]
 else
 RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style-[fsUnderline]
end;

procedure TTexteditForm.leftToolButtonClick(Sender: TObject);
begin
 if Sender=LeftToolButton then
  RichEdit1.Paragraph.Alignment:=taLeftJustify
 else if Sender=CenterToolButton then
  RichEdit1.Paragraph.Alignment:= taCenter
 else
  RichEdit1.Paragraph.Alignment:= taRightJustify;
end;



procedure TTexteditForm.richedit1SelectionChange(Sender: TObject);
begin
 boldToolButton.Down:=(fsBold in RichEdit1.SelAttributes.Style);
 italicToolButton.Down:=(fsItalic in RichEdit1.SelAttributes.Style);
 underlineToolButton.Down:=(fsUnderline in RichEdit1.SelAttributes.Style);
 case RichEdit1.Paragraph.Alignment of
  taLeftJustify: LeftToolButton.Down:=True;
  taCenter: CenterToolButton.Down:=True;
  taRightJustify: RightToolButton.Down:=True;
end;
end;
procedure TTexteditForm.undoToolButtonClick(Sender: TObject);
begin
 RichEdit1.Undo;
end;

procedure TTexteditForm.cutToolButtonClick(Sender: TObject);
begin
 RichEdit1.CutToClipboard;
end;

procedure TTexteditForm.wrapToolButtonClick(Sender: TObject);
begin
RichEdit1.WordWrap:= wrapToolButton.Down;
end;

procedure TTexteditForm.copyToolButtonClick(Sender: TObject);
begin
RichEdit1.CopyToClipboard;
end;

procedure TTexteditForm.pasteToolButtonClick(Sender: TObject);
begin
RichEdit1.PasteFromClipboard;
end;



procedure TTexteditForm.helpaboutClick(Sender: TObject);
 {$IFNDEF Win32}
function ShellAbout(Wnd: HWnd; App, Stuff: PChar; Icon: HIcon): Integer;
  far; external 'shell';
{$ENDIF}
begin
 ShellAbout(Application.MainForm.Handle,
             'wuhaofree coolbar',
             'Copyright(c)2004-2005 http://www.暂无网站.com',
             Application.Icon.Handle);
end;




end.