Soyez le premier à donner votre avis sur cette source.
Vue 11 706 fois - Téléchargée 975 fois
unit Main; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Menus, Buttons, ExtCtrls, Printers, IniFiles, StdCtrls, ComCtrls, ToolWin, ShellApi; //sys try const wm_AppelMessage=wm_user+1; //fin sys try Type Position = Record Px : Word; Py : Word; H : Word; L : Word; Tjr : Char; Heure : String [8]; End; type TMainForm = class(TForm) MainMenu: TMainMenu; FileMenu: TMenuItem; Imprimer: TMenuItem; N1: TMenuItem; Quitter: TMenuItem; Help: TMenuItem; Aide: TMenuItem; Dummeauteur: TMenuItem; Toujoursvisible1: TMenuItem; Insrerdateetheure1: TMenuItem; Memo: TMemo; PrinterSetupDialog: TPrinterSetupDialog; N2: TMenuItem; Configurationdelimpression1: TMenuItem; Edition1: TMenuItem; Couper1: TMenuItem; Copier1: TMenuItem; Coller1: TMenuItem; Supprimer1: TMenuItem; N3: TMenuItem; Toutslectionner1: TMenuItem; Effacer1: TMenuItem; Afficher: TTimer; Rglerlheuredaffichage1: TMenuItem; MenuPop: TPopupMenu; Ouvrir1: TMenuItem; N4: TMenuItem; Quitter1: TMenuItem; procedure FormCreate(Sender: TObject); procedure ImprimerClick(Sender: TObject); procedure QuitterClick(Sender: TObject); procedure AideClick(Sender: TObject); procedure DummeauteurClick(Sender: TObject); procedure MemoChange(Sender: TObject); procedure Configurationdelimpression1Click(Sender: TObject); procedure Couper1Click(Sender: TObject); procedure Copier1Click(Sender: TObject); procedure Coller1Click(Sender: TObject); procedure Supprimer1Click(Sender: TObject); procedure Toutslectionner1Click(Sender: TObject); procedure Toujoursvisible1Click(Sender: TObject); procedure Insrerdateetheure1Click(Sender: TObject); procedure Effacer1Click(Sender: TObject); procedure FormResize(Sender: TObject); procedure Rglerlheuredaffichage1Click(Sender: TObject); procedure AfficherTimer(Sender: TObject); procedure Ouvrir1Click(Sender: TObject); procedure Quitter1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Rduire1Click(Sender: TObject); private { Private-déclarations } //sys try procedure WMAppelMessage(var msg : TMessage); message wm_AppelMessage; //fin sys try public { Public-déclarations } chemin:string; demo:boolean; Fic : File OF Position; P : Position; end; var MainForm: TMainForm; //sys try tray:TNotifyIconData; //fin sys try implementation uses F_Heure; {$R *.DFM} procedure TMainForm.FormCreate(Sender: TObject); var ini:TIniFile; max:boolean; begin {$I-} AssignFile (Fic, 'taille.cfg'); FileMode := 0; ReSet (Fic); Read (Fic, P); CloseFile (Fic); {$I+} IF IOResult = 0 Then Begin MainForm.Left := P.Px; MainForm.Top := P.Py; MainForm.Height := P.H ; MainForm.Width := P.L ; End Else Begin MainForm.Left := 0; MainForm.Top := 0; MainForm.Height := 100 ; MainForm.Width := 120 ; End; IF FileExists ('Notes.txt') Then Memo.Lines.LoadFromFile('Notes.txt'); IF P.Tjr = 'o' Then Begin Toujoursvisible1.Checked := True; MainForm.FormStyle := fsStayOnTop; End Else Begin Toujoursvisible1.Checked := False; MainForm.FormStyle := fsNormal; End; { demo:=false; chemin:=ExtractFilePath(Application.ExeName); {le chemin de l'appli} {ini:=TIniFile.Create('postit.ini'); Toujoursvisible1.Checked:=ini.ReadBool('Options','Visible',false); max:=ini.ReadBool('MainW','Maxi',false); if max then WindowState:=wsMaximized else begin Left:=ini.ReadInteger('MainW','x',Screen.Width-170); Top:=ini.ReadInteger('MainW','y',Screen.Height-120); Width:=ini.ReadInteger('MainW','w',170); Height:=ini.ReadInteger('MainW','h',120); end; ini.Free; if Toujoursvisible1.Checked then FormStyle:=fsStayOnTop else FormStyle:=fsNormal; if FileExists(chemin+'postit.txt') then memo.Lines.SaveToFile(chemin+'postit.txt'); MainForm.Memo.OnChange := MemoChange; } end; //sys try procedure TMainForm.WMAppelMessage(var msg : TMessage); Var Curs:TPoint; begin //Clique gauche de la souris... if msg.LParam=Wm_RButtonDown then begin SetForegroundWindow(Handle); GetCursorPos(Curs); //Récupère les coordonnées de la souris MenuPop.Popup(Curs.X,Curs.Y); //Ouvre le menu surgissant à l'emplacement spécfié par les coordonnees de la souris PostMessage(Handle,WM_NULL,0,0); end; end; //fin sys try procedure TMainForm.ImprimerClick(Sender: TObject); var Line:integer; PrintText:System.Text; begin Printer.Title:='Post-it'; AssignPrn(PrintText); Rewrite(PrintText); Printer.Canvas.Font:=Memo.Font; for line:=0 to memo.Lines.Count-1 do Writeln(PrintText,Memo.Lines[line]); closefile(PrintText); end; procedure TMainForm.QuitterClick(Sender: TObject); begin P.Px := MainForm.Left; P.Py := MainForm.Top; P.H := MainForm.Height; P.L := MainForm.Width; IF Toujoursvisible1.Checked = True Then P.Tjr := 'o' Else P.Tjr := 'n'; AssignFile (Fic, 'taille.cfg'); FileMode := 1; ReWrite (Fic); Write (Fic, P); CloseFile (Fic); //sys try tray.cbSize:=sizeof(tray); tray.wnd:=handle; tray.uID:=1; tray.UCallbackMessage:=wm_AppelMessage; tray.hIcon:=Application.Icon.handle; //Choix de l'icone tray.szTip:='Post-it'; //Choix du message tray.uFlags:=nif_message or nif_icon or nif_tip; Shell_NotifyIcon(Nim_ADD,@tray); //fin sys try Hide; // cacher l'application... end; procedure TMainForm.AideClick(Sender: TObject); begin Application.HelpCommand(HELP_CONTENTS, 0); end; procedure TMainForm.DummeauteurClick(Sender: TObject); begin Application.HelpFile := 'KATALOG.HLP'; Application.HelpCommand(HELP_CONTENTS, 0); Application.HelpFile := 'POSTIT.HLP'; end; procedure TMainForm.MemoChange(Sender: TObject); begin //code original //memo.Lines.SaveToFile('d:\posit'+'postit.txt'); end; procedure TMainForm.Configurationdelimpression1Click(Sender: TObject); begin PrinterSetupDialog.Execute; end; procedure TMainForm.Couper1Click(Sender: TObject); begin Memo.CutToClipboard; end; procedure TMainForm.Copier1Click(Sender: TObject); begin Memo.CopyToClipboard; end; procedure TMainForm.Coller1Click(Sender: TObject); begin Memo.PasteFromClipboard; end; procedure TMainForm.Supprimer1Click(Sender: TObject); begin Memo.ClearSelection; end; procedure TMainForm.Toutslectionner1Click(Sender: TObject); begin Memo.SelectAll; end; procedure TMainForm.Toujoursvisible1Click(Sender: TObject); var ini:TIniFile; begin IF Toujoursvisible1.Checked = True Then Begin MainForm.FormStyle := fsNormal; Toujoursvisible1.Checked := False; End Else Begin MainForm.FormStyle := fsStayOnTop; Toujoursvisible1.Checked := True; End; // Code originale { Toujoursvisible1.Checked:=not Toujoursvisible1.Checked; if Toujoursvisible1.Checked then FormStyle:=fsStayOnTop else FormStyle:=fsNormal; ini:=TIniFile.Create('postit.ini'); ini.EraseSection('Options'); ini.WriteBool('Options','Visible',Toujoursvisible1.Checked); ini.Free; } end; procedure TMainForm.Insrerdateetheure1Click(Sender: TObject); begin Memo.Lines.Add(DateTimeToStr(Now)); end; procedure TMainForm.Effacer1Click(Sender: TObject); begin Memo.SelectAll; Memo.ClearSelection; end; procedure TMainForm.FormResize(Sender: TObject); begin // Code original { ini:=TIniFile.Create('postit.ini'); ini.EraseSection('MainW'); ini.WriteInteger('MainW','x',left); ini.WriteInteger('MainW','y',top); ini.WriteInteger('MainW','w',Width); ini.WriteInteger('MainW','h',Height); if WindowState=wsMaximized then ini.WriteBool('MainW','Maxi',true) else ini.WriteBool('MainW','Maxi',false); ini.Free; } end; procedure TMainForm.Rglerlheuredaffichage1Click(Sender: TObject); begin FHeure.ShowModal; end; procedure TMainForm.AfficherTimer(Sender: TObject); Var PostitHeure : TDateTime; SysH, SysM, SysS, SysMs : Word; PosH, PosM, PosS, PosMs : Word; begin PostitHeure := StrToTime (MainForm.P.Heure); DecodeTime (Time, SysH, SysM, SysS, SysMs); DecodeTime (PostitHeure, PosH, PosM, PosS, PosMs); IF ((SysH = PosH) And (SysM = PosM)) Then MainForm.Show; end; procedure TMainForm.Ouvrir1Click(Sender: TObject); begin MainForm.Show; end; procedure TMainForm.Quitter1Click(Sender: TObject); begin P.Px := MainForm.Left; P.Py := MainForm.Top; P.H := MainForm.Height; P.L := MainForm.Width; IF Toujoursvisible1.Checked = True Then P.Tjr := 'o' Else P.Tjr := 'n'; AssignFile (Fic, 'taille.cfg'); FileMode := 1; Rewrite (Fic); Write (Fic, P); CloseFile (Fic); Memo.Lines.SaveToFile ('Notes.txt'); //sys try Close; //Ferme la fiche... Shell_NotifyIcon(Nim_DELETE,@tray); //Supprime le tray icon... //fin sys try end; procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); begin Hide; // cacher l'application... end; procedure TMainForm.Rduire1Click(Sender: TObject); begin MainForm.WindowState := wsMinimized; end; end.
19 oct. 2008 à 12:55
14 févr. 2005 à 16:21
pour que ça marche sous xp
il faut dans l'inspecteur d'objets desactiver
onChange du memo "MemoChange"
dans FormCreate(Sender: TObject) ajouter la ligne
MainForm.Memo.OnChange := MemoChange;
attention aprés l'appel a
memo.Lines.LoadFromFile(chemin+'postit.txt');
pour que l'appel a memochange ne puisse pas ce faire
au avant le chargement du fichier .txt.
et pour que ça passe mieux partout
dans memochange, changer ta ligne par
memo.Lines.SaveToFile(chemin+'postit.txt');
voila chez moi avec ces modifs ça marche en D7 sous XP
salut
9 févr. 2005 à 08:33
Est-il possible d'ajouter un timer pour programmer son apparition à l'écran à une une donnée..
Merci
Salutations
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.