EXE: http://files.cnblogs.com/xe2011/FamousWord-Release-2013-12-22-113350.rar
PASCAL: http://files.cnblogs.com/xe2011/FamousWord-Pascal-2013-12-22-113350.rar
DELPHI XE5
【2013年12月21日 19:10:12】
【2013-12-20 23:01:37】
【2013-12-20 18:01:37】
1 unit Unit2; 2 3 interface 4 5 uses 6 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 7 System.Classes, Vcl.Graphics, 8 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Samples.Spin, 9 System.IniFiles, Vcl.ExtCtrls, Vcl.Menus, Vcl.ImgList, Vcl.ComCtrls, 10 Vcl.Buttons, ShellAPI, Vcl.AppEvnts, Vcl.ToolWin; 11 12 function CreateSingleObject(FileName: string): Boolean; 13 procedure SelectLine(Memo1: TMemo; ln: Integer); 14 procedure ScrollToLine(Memo1: TMemo; ln: Integer); 15 function Rnd(MaxValue: Integer): Integer; 16 17 type 18 TForm2 = class(TForm) 19 btn_Cancel: TButton; 20 btn_OK: TButton; 21 FontDialog1: TFontDialog; 22 Timer1: TTimer; 23 TrayIcon1: TTrayIcon; 24 PopupMenu1: TPopupMenu; 25 mni_TopMost: TMenuItem; 26 mni_CheckUpdate: TMenuItem; 27 N1: TMenuItem; 28 mni_Options: TMenuItem; 29 N2: TMenuItem; 30 mni_Close: TMenuItem; 31 GroupBox1: TGroupBox; 32 Label1: TLabel; 33 GroupBox2: TGroupBox; 34 Label2: TLabel; 35 Label3: TLabel; 36 SpinEdit1: TSpinEdit; 37 Memo1: TMemo; 38 ComboBox1: TComboBox; 39 Label5: TLabel; 40 Label4: TLabel; 41 Bevel1: TBevel; 42 ApplicationEvents1: TApplicationEvents; 43 CheckBox1: TCheckBox; 44 ImageList1: TImageList; 45 PopupMenu2: TPopupMenu; 46 N6: TMenuItem; 47 mni_InsertNum: TMenuItem; 48 mni_String: TMenuItem; 49 N3: TMenuItem; 50 L1: TMenuItem; 51 N4: TMenuItem; 52 N5: TMenuItem; 53 S1: TMenuItem; 54 B1: TMenuItem; 55 chk_BackTransparent: TCheckBox; 56 chk_Rnd: TCheckBox; 57 ToolBar1: TToolBar; 58 btn_New: TToolButton; 59 btn_Del: TToolButton; 60 btn_Save: TToolButton; 61 btn_CMD: TToolButton; 62 btn_Merge: TToolButton; 63 ToolButton1: TToolButton; 64 rnd1: TMenuItem; 65 procedure FormCreate(Sender: TObject); 66 procedure btn_OKClick(Sender: TObject); 67 procedure FormClose(Sender: TObject; var Action: TCloseAction); 68 procedure Timer1Timer(Sender: TObject); 69 procedure SpinEdit1Change(Sender: TObject); 70 procedure Memo1Change(Sender: TObject); 71 procedure Label1Click(Sender: TObject); 72 procedure ComboBox1Select(Sender: TObject); 73 procedure mni_CloseClick(Sender: TObject); 74 procedure mni_OptionsClick(Sender: TObject); 75 procedure btn_CancelClick(Sender: TObject); 76 procedure TrayIcon1Click(Sender: TObject); 77 procedure FormShow(Sender: TObject); 78 procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean); 79 procedure Label5Click(Sender: TObject); 80 procedure mni_CheckUpdateClick(Sender: TObject); 81 procedure ComboBox1DropDown(Sender: TObject); 82 procedure NoBankClick(Sender: TObject); 83 procedure NoSpaceClick(Sender: TObject); 84 procedure mni_noNumClick(Sender: TObject); 85 procedure mni_NoLetterClick(Sender: TObject); 86 procedure mni_InsertNumClick(Sender: TObject); 87 procedure mni_StringClick(Sender: TObject); 88 procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 89 procedure Memo1KeyPress(Sender: TObject; var Key: Char); 90 procedure Label4Click(Sender: TObject); 91 procedure B1Click(Sender: TObject); 92 procedure S1Click(Sender: TObject); 93 procedure N4Click(Sender: TObject); 94 procedure L1Click(Sender: TObject); 95 procedure btn_NewClick(Sender: TObject); 96 procedure btn_DelClick(Sender: TObject); 97 procedure btn_SaveClick(Sender: TObject); 98 procedure btn_MergeClick(Sender: TObject); 99 procedure btn_SaveMouseLeave(Sender: TObject); 100 procedure Memo1MouseEnter(Sender: TObject); 101 procedure Memo1DblClick(Sender: TObject); 102 procedure rnd1Click(Sender: TObject); 103 private 104 { Private declarations } 105 procedure WriteConfig(); 106 procedure ReadConfig(); 107 function GenerateText(): string; 108 procedure UpdataTimer1Enabled; 109 procedure function1; 110 procedure function2; 111 procedure Label4function; 112 procedure UpdataFileList; 113 public 114 { Public declarations } 115 116 end; 117 118 var 119 Form2: TForm2; 120 iniFileName: string; 121 INIFILE: TIniFile; 122 CurrentPosition: Integer; 123 path: string; 124 FileName: string; // all.txt 125 126 implementation 127 128 {$R *.dfm} 129 130 uses 131 Inifunctions, FileFunctions, Unit1, StringFunctions; 132 133 var 134 Form1: TForm1; 135 136 procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction); 137 begin 138 WriteConfig(); 139 WriteformState('MainForm', iniFileName, Form1); 140 INIFILE.Free; 141 end; 142 143 procedure TForm2.FormCreate(Sender: TObject); 144 var 145 FFile: TStringList; 146 begin 147 // -------------------创建Data文件夹--------------------------------------------- 148 path := ExtractFilePath(Application.ExeName) + 'Data'; 149 if (not DirectoryExists(path)) 150 then 151 CreateDir(path); 152 153 // ------------------创建all.txt这个文件----------------------------------------- 154 FileName := path + '' + 'all.txt'; 155 if (not FileExists(FileName)) 156 then 157 begin 158 FFile := TStringList.Create; 159 FFile.SaveToFile(FileName); 160 end; 161 162 // ------------------------------------------------------------------------------ 163 // iniFileName = C:abcabc.exe.ini 164 iniFileName := Application.ExeName + '.ini'; 165 INIFILE := TIniFile.Create(iniFileName); 166 167 ReadConfig(); 168 if (CurrentPosition < 0) 169 then 170 CurrentPosition := 0; 171 172 Timer1.Interval := SpinEdit1.Value * 1000; 173 Label4.Caption := Format(' %d/%d', [CurrentPosition + 1, 174 Memo1.Lines.Count + 1]); 175 176 // -----------------------合并所有文件到all.txt里面------------------------------ 177 if CheckBox1.Checked 178 then 179 begin 180 Hide; 181 CreateSingleObject('CombineFile.exe'); 182 BringToFront; 183 end; 184 185 // ------------获取DATA目录下的.TXT文件然后放到ComboboxItems里面----------------- 186 UpdataFileList; 187 188 // ComboBox1.ItemIndex :=0; 189 if FileExists(path + '' + ComboBox1.Text) 190 then 191 Memo1.Lines.LoadFromFile(path + '' + ComboBox1.Text); 192 193 // ------------------------------------------------------------------------------ 194 Label5.Hint := '打开文件夹 "' + path + '"'; 195 ComboBox1.Hint := path + '' + ComboBox1.Text; 196 // ------------------------------------------------------------------------------ 197 Application.ShowMainForm := False; 198 Application.MainFormOnTaskbar := False; 199 Application.ShowHint := true; 200 // Application.HintPause := 10000; 201 // ------------------------------------------------------------------------------ 202 // TrayIcon1 203 TrayIcon1.Hint := Label1.Caption + ' ' + Label4.Caption; 204 205 // ------------------------------------------------------------------------------ 206 // Form1 207 Form1 := TForm1.Create(Self); 208 Form1.Width := Screen.Width; 209 Form1.Label1.Font := Label1.Font; 210 Form1.Label1.Caption := ' ' + Label1.Caption + ' '; 211 Form1.AutoSize := true; 212 Form1.BorderStyle := bsNone; 213 214 Form1.TransparentColor := true; 215 Form1.Color := clGrayText; 216 Form1.TransparentColorValue := Form1.Color; 217 218 ReadformState('MainForm', iniFileName, Form1); 219 Form1.Show; 220 ShowScrollBar(Memo1.Handle, SB_HORZ, False); 221 // ------------------------------------------------------------------------------ 222 223 end; 224 225 procedure TForm2.UpdataFileList; 226 begin 227 ComboBox1.Items.Clear; 228 ComboBox1.Items := Searchfile(path); 229 end; 230 231 procedure TForm2.function1; 232 begin 233 if CurrentPosition = 0 234 then 235 begin 236 SelectLine(Memo1, 1); 237 ScrollToLine(Memo1, 1); 238 end 239 else 240 begin 241 SelectLine(Memo1, CurrentPosition); 242 ScrollToLine(Memo1, CurrentPosition); 243 SendMessage(Memo1.Handle, WM_HSCROLL, SB_LEFT, 0); 244 end; 245 end; 246 247 procedure TForm2.function2; 248 begin 249 Visible := not Visible; 250 SetForegroundWindow(Self.Handle); 251 end; 252 253 procedure TForm2.Label4function; 254 begin 255 Label4.Caption := Format(' %d/%d', [CurrentPosition, Memo1.Lines.Count]); 256 end; 257 258 procedure TForm2.FormShow(Sender: TObject); 259 begin 260 ShowWindow(Application.Handle, SW_HIDE); 261 end; 262 263 procedure TForm2.WriteConfig(); 264 begin 265 // 间隔 266 INIFILE.WriteInteger('SpinEdit', 'Value', Self.SpinEdit1.Value); 267 // 字体属性 268 INIFILE.WriteString('Label', 'FontName', Self.Label1.Font.Name); 269 INIFILE.WriteInteger('Label', 'FontSize', Self.Label1.Font.Size); 270 INIFILE.WriteString('Label', 'FontColor', 271 ColorToString(Self.Label1.Font.Color)); 272 // INIFILE.WriteString('Label','FontStyle',Self.Label1.Font.Style); 273 274 // 到达哪里了 275 INIFILE.WriteInteger('ReadPosition', 'Position', CurrentPosition); 276 277 // Label1 278 INIFILE.WriteString('ReadPosition', 'Text', Self.Label1.Caption); 279 INIFILE.WriteString('ReadPosition', 'Combobox1.Text', Self.ComboBox1.Text); 280 281 INIFILE.WriteBool('MainForm', 'TopMost', mni_TopMost.Checked); 282 INIFILE.WriteBool('MainForm', 'AutoMerge', CheckBox1.Checked); 283 284 INIFILE.WriteBool('MainForm', 'BackTransparent', chk_BackTransparent.Checked); 285 INIFILE.WriteBool('MainForm', 'Rnd', chk_Rnd.Checked); 286 287 end; 288 289 procedure TForm2.ReadConfig(); 290 var 291 Color: string; 292 begin 293 // 间隔 294 Self.SpinEdit1.Value := INIFILE.ReadInteger('SpinEdit', 'Value', 295 Self.SpinEdit1.Value); 296 // 字体属性 297 Self.Label1.Font.Name := INIFILE.ReadString('Label', 'FontName', 298 Self.Label1.Font.Name); 299 Self.Label1.Font.Size := INIFILE.ReadInteger('Label', 'FontSize', 300 Self.Label1.Font.Size); 301 302 Color := INIFILE.ReadString('Label', 'FontColor', 303 ColorToString(Self.Label1.Font.Color)); 304 Self.Label1.Font.Color := StringToColor(Color); 305 // INIFILE.WriteString('Label','FontStyle',Self.Label1.Font.Style); 306 307 // 到达哪里了 308 CurrentPosition := INIFILE.ReadInteger('ReadPosition', 'Position', 0); 309 310 // Label1 311 Self.Label1.Caption := ' ' + INIFILE.ReadString('ReadPosition', 'Text', 312 Self.Label1.Caption); 313 314 Self.ComboBox1.Text := INIFILE.ReadString('ReadPosition', 'Combobox1.Text', 315 'all.txt'); 316 317 mni_TopMost.Checked := INIFILE.ReadBool('MainForm', 'TopMost', 318 mni_TopMost.Checked); 319 320 CheckBox1.Checked := INIFILE.ReadBool('MainForm', 'AutoMerge', 321 CheckBox1.Checked); 322 323 chk_BackTransparent.Checked := INIFILE.ReadBool('MainForm', 'BackTransparent', 324 chk_BackTransparent.Checked); 325 326 chk_Rnd.Checked := INIFILE.ReadBool('MainForm', 'Rnd', chk_Rnd.Checked); 327 end; 328 329 procedure TForm2.rnd1Click(Sender: TObject); 330 begin 331 CurrentPosition := Rnd(Memo1.Lines.Count); 332 // Form1 333 Form1.Label1.Caption := Label1.Caption; 334 Label1.Caption := ' ' + GenerateText + ' '; 335 end; 336 337 procedure TForm2.S1Click(Sender: TObject); 338 begin 339 StrFunction.ClearBlankSpace(Memo1); 340 end; 341 342 procedure TForm2.SpinEdit1Change(Sender: TObject); 343 begin 344 Timer1.Interval := SpinEdit1.Value * 1000; 345 end; 346 347 function TForm2.GenerateText(): string; 348 begin 349 Result := Memo1.Lines[CurrentPosition]; 350 if (CurrentPosition > Memo1.Lines.Count - 1) 351 then 352 begin 353 CurrentPosition := 0; 354 Inc(CurrentPosition); 355 Result := Memo1.Lines[0]; 356 end 357 else 358 begin 359 Inc(CurrentPosition); 360 end; 361 end; 362 363 procedure TForm2.L1Click(Sender: TObject); 364 begin 365 StrFunction.ClearLetter(Memo1); 366 end; 367 368 procedure TForm2.Label1Click(Sender: TObject); 369 begin 370 FontDialog1.Font := Label1.Font; 371 if FontDialog1.Execute 372 then 373 begin 374 FormStyle:=fsNormal; 375 Label1.Font := FontDialog1.Font; 376 Form1.Label1.Font := Label1.Font; 377 Form1.Height := Label1.Height; 378 end; 379 FormStyle:=fsStayOnTop; 380 381 end; 382 383 procedure TForm2.Label4Click(Sender: TObject); 384 begin 385 function1; 386 end; 387 388 procedure TForm2.Label5Click(Sender: TObject); 389 var 390 path: string; 391 begin 392 path := ExtractFilePath(Application.ExeName) + 'Data'; 393 if (not DirectoryExists(path)) 394 then 395 CreateDir(path); 396 ShellExecute(Handle, 'open', 'Explorer.exe', PChar(path), 0, SW_SHOWNORMAL); 397 end; 398 399 procedure TForm2.Memo1Change(Sender: TObject); 400 begin 401 Label4.Caption := Format(' %d/%d', [CurrentPosition + 1, 402 Memo1.Lines.Count + 1]); 403 // btn_Save.Enabled := Memo1.Modified = True; 404 end; 405 406 procedure TForm2.Memo1DblClick(Sender: TObject); 407 begin 408 SelectLine(Memo1, Memo1.CaretPos.Y + 1); 409 end; 410 411 procedure TForm2.Memo1KeyDown(Sender: TObject; var Key: Word; 412 Shift: TShiftState); 413 begin 414 if (Shift = [ssCtrl]) and (Key = $41) 415 then 416 Memo1.SelectAll; 417 end; 418 419 procedure TForm2.Memo1KeyPress(Sender: TObject; var Key: Char); 420 begin 421 if (Key = #1) 422 then // #1 = A 423 Key := #0; 424 end; 425 426 procedure TForm2.Memo1MouseEnter(Sender: TObject); 427 begin 428 Memo1.Hint := Memo1.Lines[CurrentPosition - 1]; 429 end; 430 431 procedure TForm2.mni_CheckUpdateClick(Sender: TObject); 432 begin 433 ShellExecute(Handle, 'open', 'iexplore.exe', 434 'http://www.cnblogs.com/xe2011/p/3482805.html', 0, SW_SHOWNORMAL); 435 end; 436 437 procedure TForm2.mni_CloseClick(Sender: TObject); 438 begin 439 Close(); 440 end; 441 442 procedure TForm2.mni_InsertNumClick(Sender: TObject); 443 begin 444 StrFunction.InsertNumber(Memo1); 445 end; 446 447 procedure TForm2.mni_OptionsClick(Sender: TObject); 448 begin 449 function1; 450 function2; 451 end; 452 453 procedure TForm2.mni_StringClick(Sender: TObject); 454 var 455 str: string; 456 begin 457 str := InputBox('提示', '放在每行的最右边的字符串', ''); 458 if str <> '' 459 then 460 StrFunction.InsertString(Memo1, str); 461 end; 462 463 procedure TForm2.mni_noNumClick(Sender: TObject); 464 begin 465 StrFunction.ClearNum(Memo1); 466 end; 467 468 procedure TForm2.mni_NoLetterClick(Sender: TObject); 469 begin 470 StrFunction.ClearLetter(Memo1); 471 end; 472 473 procedure TForm2.N4Click(Sender: TObject); 474 begin 475 StrFunction.ClearNum(Memo1); 476 end; 477 478 procedure TForm2.NoBankClick(Sender: TObject); 479 begin 480 StrFunction.ClearBlankLine(Memo1); 481 end; 482 483 procedure TForm2.NoSpaceClick(Sender: TObject); 484 begin 485 StrFunction.ClearBlankSpace(Memo1); 486 end; 487 488 procedure TForm2.Timer1Timer(Sender: TObject); 489 begin 490 // 随机 491 if chk_Rnd.Checked = true 492 then 493 begin 494 CurrentPosition := Rnd(Memo1.Lines.Count); 495 end; 496 497 // Form1 498 Form1.Label1.Caption := Label1.Caption; 499 Label1.Caption := ' ' + GenerateText + ' '; 500 Label4function; 501 function1; 502 503 end; 504 505 procedure TForm2.btn_NewClick(Sender: TObject); 506 var 507 FileName: string; 508 begin 509 FileName := path + '' + ComboBox1.Text; 510 Memo1.Text := ''; 511 CreateAEmptyFile(FileName); 512 ComboBox1.Items.Add(ComboBox1.Text); 513 end; 514 515 procedure TForm2.btn_DelClick(Sender: TObject); 516 var 517 FileName: string; 518 begin 519 520 if Application.MessageBox(PChar('删除文件:"' + ComboBox1.Text + '"'), '提示', 521 MB_YESNO + MB_ICONQUESTION + MB_TOPMOST) = IDYES 522 then 523 begin 524 FileName := path + '' + ComboBox1.Text; 525 if FileExists(FileName) 526 then 527 begin 528 DeleteFile(FileName); 529 ComboBox1.DeleteSelected; 530 ComboBox1.ItemIndex := 0; 531 ComboBox1Select(Sender); 532 end 533 else 534 Application.MessageBox('删除失败', '提示', MB_OK + MB_ICONERROR); 535 end; 536 537 end; 538 539 procedure TForm2.btn_SaveClick(Sender: TObject); 540 var 541 FileName: string; 542 begin 543 FileName := path + '' + ComboBox1.Text; 544 if FileExists(FileName) 545 then 546 begin 547 Memo1.Lines.SaveToFile(FileName); 548 btn_Save.Enabled := False; 549 550 end 551 else 552 Application.MessageBox('保存失败', '提示', MB_OK + MB_ICONINFORMATION); 553 554 end; 555 556 procedure TForm2.btn_SaveMouseLeave(Sender: TObject); 557 begin 558 btn_Save.Enabled := true; 559 end; 560 561 procedure TForm2.btn_MergeClick(Sender: TObject); 562 begin 563 // 合并所有文件到all.txt里面 564 Hide; 565 CreateSingleObject('CombineFile.exe'); 566 Show; 567 BringToFront; 568 end; 569 570 procedure TForm2.TrayIcon1Click(Sender: TObject); 571 begin 572 function1; 573 function2; 574 end; 575 576 procedure TForm2.btn_OKClick(Sender: TObject); 577 begin 578 Hide; 579 WriteConfig(); 580 end; 581 582 procedure TForm2.ApplicationEvents1Message(var Msg: tagMSG; 583 var Handled: Boolean); 584 585 begin 586 if (Self.Visible = False) and (mni_TopMost.Checked = true) 587 then 588 begin 589 Form1.FormStyle := fsStayOnTop; 590 Form1.BringToFront; 591 end; 592 Form1.Visible := not Self.Visible; 593 594 if chk_BackTransparent.Checked 595 then 596 begin 597 Form1.Color := clGrayText; 598 Form1.AlphaBlend := true; 599 end 600 else 601 // 背景不透明 602 begin 603 Form1.Color := clBtnFace; 604 Form1.AlphaBlend := true; 605 end; 606 607 Application.ShowHint := true; 608 TrayIcon1.Hint := Label1.Caption + ' ' + Label4.Caption; 609 Timer1.Enabled := not Visible; 610 end; 611 612 procedure TForm2.B1Click(Sender: TObject); 613 begin 614 StrFunction.ClearBlankLine(Memo1); 615 end; 616 617 procedure TForm2.btn_CancelClick(Sender: TObject); 618 begin 619 Hide; 620 UpdataTimer1Enabled; 621 end; 622 623 procedure TForm2.ComboBox1DropDown(Sender: TObject); 624 begin 625 UpdataFileList; 626 end; 627 628 procedure TForm2.ComboBox1Select(Sender: TObject); 629 var 630 FileName: string; 631 begin 632 FileName := path + '' + ComboBox1.Text; 633 if FileExists(FileName) 634 then 635 begin 636 Memo1.Lines.LoadFromFile(FileName); 637 CurrentPosition := 0; 638 Label4function; 639 end; 640 function1; 641 ComboBox1.Hint := path + '' + ComboBox1.Text; 642 643 end; 644 645 procedure TForm2.UpdataTimer1Enabled; 646 begin 647 Timer1.Enabled := not Visible; 648 end; 649 650 function CreateSingleObject(FileName: string): Boolean; 651 var 652 s: TStartupinfo; 653 p: TProcessInformation; 654 begin 655 Result := False; 656 FillChar(s, Sizeof(TStartupinfo), 0); 657 s.cb := Sizeof(TStartupinfo); 658 if CreateProcess(PChar(FileName), nil, nil, nil, False, Normal_Priority_Class, 659 nil, nil, s, p) 660 then 661 begin 662 WaitforSingleObject(p.hProcess, INFINITE); 663 CloseHandle(p.hProcess); 664 Result := true; 665 end; 666 end; 667 668 // 转到指定行并选中这行的文本 669 procedure SelectLine(Memo1: TMemo; ln: Integer); 670 begin 671 Memo1.SelStart := SendMessage(Memo1.Handle, EM_LINEINDEX, ln - 1, 0); 672 Memo1.SelLength := Length(Memo1.Lines[ln - 1]); 673 end; 674 675 // 将滚动条定位到指定行 676 procedure ScrollToLine(Memo1: TMemo; ln: Integer); 677 begin 678 SendMessage(Memo1.Handle, EM_LINESCROLL, 0, -Memo1.Lines.Count); 679 SendMessage(Memo1.Handle, EM_LINESCROLL, 0, ln - 1); 680 end; 681 682 // 产生一个整数范围内的随机数 683 function Rnd(MaxValue: Integer): Integer; 684 var 685 rndResult: Integer; 686 begin 687 Randomize; 688 rndResult := Random(20) + 1; 689 Result := rndResult; 690 end; 691 692 end.