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

📄 unitoption.pas

📁 类似于写字板,但此功能强大,可以扩展到许多地方
💻 PAS
字号:
unit UnitOption;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ComCtrls, ExtCtrls,ShellApi,Menus,Registry;

type
  TFormOption = class(TForm)
    PanelPageControl: TPanel;
    ButtonPanel: TPanel;
    PageSetting: TPageControl;
    TabInterface: TTabSheet;
    TabSystem: TTabSheet;
    TabDateTime: TTabSheet;
    ButtonOK: TButton;
    TuttonCancel: TButton;
    ButtonHelp: TButton;
    TabMacro: TTabSheet;
    TabOther: TTabSheet;
    GroupWindow: TGroupBox;
    CheckSaveSize: TCheckBox;
    CheckSavePos: TCheckBox;
    GroupView: TGroupBox;
    CheckShowAddMenu: TCheckBox;
    CheckShowTool: TCheckBox;
    CheckShowStatus: TCheckBox;
    CheckShowMenuIcon: TCheckBox;
    GroupFontColor: TGroupBox;
    CheckAutoMaxSize: TCheckBox;
    ButtonDefaultFontColor: TButton;
    GroupMacro: TGroupBox;
    HotKeyMacro: THotKey;
    GroupIink: TGroupBox;
    GroupShortCut: TGroupBox;
    Label1: TLabel;
    CheckCutToDesktop: TCheckBox;
    CheckCutMenu: TCheckBox;
    GroupUser: TGroupBox;
    EditUserName: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    EditUserCompany: TEdit;
    Label4: TLabel;
    EditUserAddress: TEdit;
    RadioDateFormat: TRadioGroup;
    RadioTimeFormat: TRadioGroup;
    RadioDayFormat: TRadioGroup;
    CheckLinkTxt: TCheckBox;
    CheckLinkHtm: TCheckBox;
    CheckLinkGb: TCheckBox;
    CheckLinkBig: TCheckBox;
    CheckLinkIni: TCheckBox;
    CheckLinkBat: TCheckBox;
    CheckLinkC: TCheckBox;
    CheckLinkOther: TCheckBox;
    CheckLinkRtf: TCheckBox;
    GroupEditor: TGroupBox;
    CheckAutoAlign: TCheckBox;
    LabelTabWidth: TLabel;
    CheckInsertLine: TCheckBox;
    Label7: TLabel;
    TrackBarReadSpeed: TTrackBar;
    CheckFreshSelection: TCheckBox;
    GroupConect: TGroupBox;
    CheckLikeMe: TCheckBox;
    LabelSendEmail: TLabel;
    LabelHomePage: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    ButtonAddMacro: TButton;
    ListMacro: TListBox;
    Label11: TLabel;
    MemoMacro: TMemo;
    ButtonDeleteMacro: TButton;
    Label12: TLabel;
    CheckShowFullPath: TCheckBox;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    ButtonFont: TButton;
    ButtonForeColor: TButton;
    ButtonBackColor: TButton;
    UpDownTabWidth: TUpDown;
    EditTabWidth: TEdit;
    Bevel1: TBevel;
    CheckCreatBak: TCheckBox;
    CheckAddToFold: TCheckBox;
    Label5: TLabel;
    GroupBoxLinkOther: TGroupBox;
    EditLinkOther: TEdit;
    Label6: TLabel;
    CheckUnHtml: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure ButtonAddMacroClick(Sender: TObject);
    procedure LabelSendEmailClick(Sender: TObject);
    procedure LabelHomePageClick(Sender: TObject);
    procedure ButtonFontClick(Sender: TObject);
    procedure ButtonForeColorClick(Sender: TObject);
    procedure ButtonBackColorClick(Sender: TObject);
    procedure LabelTabWidthClick(Sender: TObject);
    procedure ButtonOKClick(Sender: TObject);
    procedure ListMacroClick(Sender: TObject);
    procedure ButtonDeleteMacroClick(Sender: TObject);
    procedure ButtonHelpClick(Sender: TObject);
    procedure EditLinkOtherKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormOption: TFormOption;
  TempMacro:TStringList;
  Reg:TRegIniFile;
implementation

uses UNotePad;

{$R *.DFM}
function TestLinkExt(Ext:String):Boolean;
begin
  try
    Reg:=TRegIniFile.Create('');
    Reg.RootKey:=HKEY_CLASSES_ROOT;
    Result:=(Reg.ReadString(Ext+'file\shell\edit\command','','')=(Application.ExeName+' %1'));
  finally
    Reg.Free;
  end;
end;


procedure LinkExt(Ext:string;DoOpen: Boolean);
var
  s:ShortString;
  sysDir: array[0..255] of Char;
begin
  GetSystemDirectory(@sysDir,255);
  try
    s:=Ext+'file';
    Reg:=TRegIniFile.Create('');
    with Reg,Application do
    begin
      RootKey:=HKEY_CLASSES_ROOT;
      WriteString('.'+Ext,'',s);
      WriteString(s,'',Title+'文件');
      if doopen then
      begin
        WriteString(s+'\shell\open','','打开(&O)');
        WriteString(s+'\shell\open\command','',ExeName+' %1');
      end;
      WriteString(s+'\DefaultIcon','',StrPas(sysDir)+'\Pifmgr.dll,16');
      WriteString(s+'\shell\edit','',Title+'编辑(&E)');
      WriteString(s+'\shell\edit\command','',ExeName+' %1');
    end
  finally
    Reg.Free;
  end;
end;


procedure TFormOption.FormCreate(Sender: TObject);
var
  I:Integer;
begin
  CheckSaveSize.Checked:=SaveSize;
  CheckSavePos.Checked :=SavePos;
  CheckAutoMaxSize.Checked:=AutoMaxSize;

  CheckShowFullPath.Checked:=ShowFullPath;
  CheckShowTool.Checked:=NotePadForm.ToolBar1.Visible;
  CheckShowStatus.Checked:=NotePadForm.StatusBar.Visible;
  CheckShowAddMenu.Checked:=ShowAddMenu;
  CheckShowMenuIcon.Checked:=ShowIcon;

  TrackBarReadSpeed.Position:=ReadSpeed div 1000;
  CheckAutoAlign.Checked:=AutoAlign;
  CheckInsertLine.Checked:=InsertLine;
  CheckFreshSelection.Checked:=FreshSelection;
  UpDownTabWidth.Position:=TabWidth;

  RadioDateFormat.ItemIndex:=DateFormat;
  RadioTimeFormat.ItemIndex:=TimeFormat;
  RadioDayFormat. ItemIndex:=DayFormat;

  EditUserName.Text:=UserName;
  EditUserCompany.Text:=UserCompany;
  EditUserAddress.Text:=UserAddress;

  TempMacro:=Tstringlist.Create;
  for i:=1 to MacroNumber do
  begin
    ListMacro.Items.Add(ShortCutToText(MacroShortCut[i]));
    TempMacro.Add(MacroString[i]);
  end;

  CheckCreatBak.Checked:=CreatBak;
  CheckAddToFold.Checked:=AddToFold;
  CheckLikeMe.Checked:=LikeMe;

  CheckLinkTxt.Checked:=TestLinkExt('txt');
  CheckLinkHtm.Checked:=TestLinkExt('htm');
  CheckLinkRtf.Checked:=TestLinkExt('rtf');
  CheckLinkGb.Checked :=TestLinkExt('gb');
  CheckLinkBig.Checked:=TestLinkExt('big');
  CheckLinkIni.Checked:=TestLinkExt('ini');
  CheckLinkBat.Checked:=TestLinkExt('bat');
  CheckLinkC.Checked  :=TestLinkExt('c');

end;

procedure TFormOption.ButtonAddMacroClick(Sender: TObject);
begin
  if (MemoMacro.Text<>'') and (HotKeyMacro.HotKey<>0) then
    if ListMacro.Items.Count>=10 then
      Application.MessageBox('对不起,宏的数目不能超过十个!',Pchar(Application.Title),MB_ICONEXCLAMATION)
    else
    begin
      ListMacro.Items.Add(ShortCutToText(HotKeyMacro.HotKey));
      TempMacro.Add(MemoMacro.Text);
      MemoMacro.Clear;
      HotKeyMacro.HotKey:=0;
    end
  else
    Application.MessageBox('请输入宏文本和快捷键',Pchar(Application.Title),MB_ICONEXCLAMATION);
end;

procedure TFormOption.LabelSendEmailClick(Sender: TObject);
begin
  ShellExecute(Handle, 'Open', 'mailto:yckxzjj@163.com', NIL, NIL, SW_SHOW);
end;

procedure TFormOption.LabelHomePageClick(Sender: TObject);
begin
  ShellExecute(Handle, 'Open', 'http://yckxzjj.vip.sina.com', NIL, NIL, SW_SHOW);
end;

procedure TFormOption.ButtonFontClick(Sender: TObject);
begin
  NotePadForm.FontDialog.Execute;
end;

procedure TFormOption.ButtonForeColorClick(Sender: TObject);
begin
  NotePadForm.ColorDialog.Execute;
end;

procedure TFormOption.ButtonBackColorClick(Sender: TObject);
begin
  NotePadForm.ColorDialog.Execute;
end;

procedure TFormOption.LabelTabWidthClick(Sender: TObject);
begin
  LabelTabWidth.Caption:='Tab键的宽度:'+IntToStr(TabWidth+1)+'个字符';
end;

procedure TFormOption.ButtonOKClick(Sender: TObject);
var
  I:Integer;
begin
  SaveSize:=CheckSaveSize.Checked;
  SavePos:=CheckSavePos.Checked ;
  AutoMaxSize:=CheckAutoMaxSize.Checked;
  ShowFullPath:=CheckShowFullPath.Checked;
  with NotePadForm do
  begin
    ToolBar2.Visible:=CheckShowTool.Checked;
    ToolBar1.Visible:=CheckShowTool.Checked;
    StatusBar.Visible:=CheckShowStatus.Checked;
    ShowAddMenu:=CheckShowAddMenu.Checked;
    if (ShowAddMenu xor MenuFileShowAddMenu.Checked)=True then
      MenuFileShowAddMenuClick(Sender);
    ShowIcon:=CheckShowMenuIcon.Checked;
    if ShowIcon=True then MainMenu.Images:=NotePadForm.ImageList
    else MainMenu.Images:=NIL;
  end;

  ReadSpeed:=TrackBarReadSpeed.Position*1000;
  AutoAlign:=CheckAutoAlign.Checked;
  InsertLine:=CheckInsertLine.Checked;
  FreshSelection:=CheckFreshSelection.Checked;
  TabWidth:=UpDownTabWidth.Position;


  DateFormat:=RadioDateFormat.ItemIndex;
  TimeFormat:=RadioTimeFormat.ItemIndex;
  DayFormat :=RadioDayFormat. ItemIndex;

  UserName   :=EditUserName.Text;
  UserCompany:=EditUserCompany.Text;
  UserAddress:=EditUserAddress.Text;

  MacroNumber:=ListMacro.Items.Count;
  for i:=1 to MacroNumber do
  begin
    MacroShortCut[i]:=TextToShortCut(ListMacro.Items[i-1]);
    MacroString[i]:=tempmacro[i-1];
  end;

  CreatBak:=CheckCreatBak.Checked;
  AddToFold:=CheckAddToFold.Checked;
  LikeMe:=CheckLikeMe.Checked;
  tempmacro.Free;
  NotePadForm.FormResize(Sender);

    if CheckLinkTxt.Checked then
    begin
      LinkExt('txt',True);
      LinkExt('text',True);
    end;
    if CheckLinkHtm.Checked then
    begin
      LinkExt('htm',False);
      LinkExt('html',False);
    end;
    if CheckLinkRtf.Checked then
      LinkExt('rtf',False);
    if CheckLinkGb.Checked then
      LinkExt('gb',True);
    if CheckLinkBig.Checked then
      LinkExt('big',True);
    if CheckLinkIni.Checked then
      LinkExt('ini',True);
    if CheckLinkBat.Checked then
      LinkExt('bat',False);
    if CheckLinkC.Checked then
    begin
      LinkExt('c',False);
      LinkExt('cpp',False);
      LinkExt('h',False);
      LinkExt('hpp',False);
    end;
    if CheckLinkOther.Checked then
    begin
      LinkExt('pas',False);
      LinkExt('java',False);
      LinkExt('bas',False);
      LinkExt('asm',False);
    end;
    with EditLinkOther do
    if Text<>'' then
      LinkExt(Text,False);
end;

procedure TFormOption.ListMacroClick(Sender: TObject);
begin
  with ListMacro do
  begin
    MemoMacro.Text:=tempmacro[ItemIndex];
    HotKeyMacro.HotKey:=TextToShortCut(Items[ItemIndex]);
  end;
end;

procedure TFormOption.ButtonDeleteMacroClick(Sender: TObject);
var
  I:Integer;
begin
  with ListMacro do
  begin
    i:=ItemIndex;
    Items.Delete(i);
  end;
  tempmacro.Delete(i);
  MemoMacro.Clear;
  HotKeyMacro.HotKey:=0;
end;


procedure TFormOption.ButtonHelpClick(Sender: TObject);
begin
  Application.HelpJump('环境配置');
end;

procedure TFormOption.EditLinkOtherKeyPress(Sender: TObject;
  var Key: Char);
begin
  if Key in ['*',' ','.'] then
  begin
    Beep;
    Key:=Chr(0);
  end;
end;

end.

⌨️ 快捷键说明

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