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:\abc\abc.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.
View Code
posted @ 2013-12-19 20:17 XE2011 阅读(854) 评论(0) 编辑收藏举报
会员力量，点亮园子希望
刷新页面返回顶部
Testudo

每天要进步一点点。

桌面名人名言

公告
