| Цитата | | Срочно нужен исходник простенького скрин-сэйвера на дельфи может у кого есть или ссылочку дадите??? |
насколько я знаю в ДРКБ есть статья на эту тему
а так вот взял пример из книги "Библия Дэлфи" автор М.Флёнов
| Код |
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, opengl,
ExtCtrls, AppEvnts, registry;
{$D SCRNSAVE Raver}
type
TSaverForm = class(TForm)
Timer1: TTimer;
procedure FormActivate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
BGbitmap:TBitmap;
DC : hDC;
BackgroundCanvas : TCanvas;
public
{ Public declarations }
end;
var
SaverForm: TSaverForm;
implementation
uses OptionsUnit;
{$R *.DFM}
procedure TSaverForm.FormActivate(Sender: TObject);
begin
Left:=0;
Top:=0;
end;
procedure TSaverForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
Close;
end;
procedure TSaverForm.FormDestroy(Sender: TObject);
begin
BGBitmap.Free;
end;
procedure TSaverForm.FormPaint(Sender: TObject);
begin
if Timer1.Enabled=true then
Canvas.Draw(0,0,BGBitmap);
end;
procedure TSaverForm.Timer1Timer(Sender: TObject);
const
DrawColors: array[0..7] of TColor =(clRed, clBlue, clYellow, clGreen,
clAqua, clFuchsia, clMaroon, clSilver);
begin
BGBitmap.Canvas.Pen.Color:=DrawColors[random(7)];
BGBitmap.Canvas.MoveTo(random(Screen.Width),random(Screen.Height));
BGBitmap.Canvas.LineTo(random(Screen.Width),random(Screen.Height));
Canvas.Draw(0,0,BGBitmap);
end;
procedure TSaverForm.FormShow(Sender: TObject);
var
reg:TRegIniFile;
begin
reg := TRegIniFile.Create('Software');
reg.OpenKey('DelphiBook',true);
OptionsForm.PassEdit.Text:=reg.ReadString('Screen Saver', 'Password', '');
OptionsForm.TrackBar1.Position:=reg.ReadInteger('Screen Saver', 'Timer Interval', 1000);
reg.Free;
if ParamCount>0 then
begin
if ParamStr(1)='/p' then
begin
Close;
exit;
end;
if ParamStr(1)[2]='c' then
begin
OptionsForm.ShowModal;
if OptionsForm.ModalResult=mrOK then//Если нажата кнопка ОК, то сохраняю выбранные параметры
begin
reg := TRegIniFile.Create('Software');
reg.OpenKey('DelphiBook',true);
reg.WriteString('Screen Saver', 'Password', OptionsForm.PassEdit.Text);
reg.WriteInteger('Screen Saver', 'Timer Interval', OptionsForm.TrackBar1.Position);
reg.Free;
end;
Close;
exit;
end;
end;
Timer1.Enabled:=true;
Timer1.Interval:=OptionsForm.TrackBar1.Position;
Width:=Screen.Width;
Height:=Screen.Height;
end;
procedure TSaverForm.FormCreate(Sender: TObject);
begin
Width:=0;
Height:=0;
BGbitmap:=TBitmap.Create;
BGbitmap.Width := Screen.Width;
BGbitmap.Height := Screen.Height;
DC := GetDC (0);
BackgroundCanvas := TCanvas.Create;
BackgroundCanvas.Handle := DC;
BGBitmap.Canvas.CopyRect(Rect (0, 0, Screen.Width, Screen.Height), BackgroundCanvas,
Rect (0, 0, Screen.Width, Screen.Height));
BackgroundCanvas.Free;
randomize;
end;
procedure TSaverForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var
pass:String;
begin
if ParamStr(1)<>'/s' then //Если программа не запущена, а показываеться окно настроек то можно выходить
begin
CanClose:=true;//Разрешаю выход из программы
exit;
end;
if OptionsForm.PassEdit.Text='' then//Если пароль пустой, то можно выходить
begin
CanClose:=true;//Разрешаю выход из программы
exit;
end;
CanClose:=false;//Запрещяю выход из программы
//Показываю окно ввода пароля
pass:='';
if InputQuery('Введите пароль', 'Пароль:', pass) then
if pass=OptionsForm.PassEdit.Text then//Если пароль верный
CanClose:=true;//Разрешаю выход из программы
end;
end.
|
и
| Код |
unit OptionsUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TOptionsForm = class(TForm)
Label1: TLabel;
PassEdit: TEdit;
Button1: TButton;
Button2: TButton;
Label2: TLabel;
PassEdit1: TEdit;
Label3: TLabel;
TrackBar1: TTrackBar;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
OptionsForm: TOptionsForm;
implementation
{$R *.dfm}
procedure TOptionsForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose:=false;
if PassEdit.Text=PassEdit1.Text then//Проверяю, если пароль равен подтверждению, то можно закрывать окно
CanClose:=true
else
Application.MessageBox('Пароль не соответствуют подтверждению', 'Ошибка');
end;
end.
|
помойму проще не куда) |
