Ekran Koruyucu

[selam]

Delphide Ekran Koruyucu Nasıl Yazacağım Yawwww

[FXERKAN]

galiba bu örnek senin işini görür. (kod benim değil )

Kod: Tümünü seç

Codec By GeNiUS !
genius@turkiye.com

Bir ekran koruyucusu nasıl olur. İşte örneği:
·        Proje dosyasına, projenin ekran koruyucu olacağına dair bir bilgi satırı eklenmelidir.
{$D SCRSAVE <Ekran koruyucu adı}>
·        Ana formdaki kenarlıklar, ve ikonlar tamamen kaldırılmalıdır.
·        Form aktif hale gelirken, Left ve Top değerleri "0" a eşitlenmelidir.
·        Form.Windowstate=WsMaximized olmalıdır.
·        Formun yaratılması esnasında, Application.Onmessage olay yordamına, Ekran koruyucunun devreden çıkmasını sağlayacak yordam atanmalıdır.
·        Program parametrelerine "/c" eklenmelidir. (Run | Parameters menüsünden)
·        Program derlendikten sonra uzantısı "SCR" olarak değiştirilmeli ve Windows dizinine kopyalanmalıdır.
Scrn.PAS
unit Scrn;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls;

type
  TScrnFrm = class(TForm)
    tmrTick: TTimer;
    procedure tmrTickTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    procedure DrawSphere(x, y, size : integer; color : TColor);
    procedure DeactivateScrnSaver(var Msg : TMsg; var Handled : boolean);
  public
    { Public declarations }
  end;

var
  ScrnFrm: TScrnFrm;

implementation

{$R *.DFM}

var
  crs : TPoint;  {Fare imlecinin orjinal yeri.}

function Min(a, b : integer) : integer;
begin
  if b < a then
    Result := b
  else
    Result := a;
end; {Min}

procedure TScrnFrm.DrawSphere(x, y, size : integer; color : TColor);
var
  i, dw    : integer;
  cx, cy   : integer;
  xy1, xy2 : integer;
  r, g, b  : byte;
begin
  with Canvas do begin
    {Fırça ve kalem şekilleri.}
    Pen.Style := psClear;
    Brush.Style := bsSolid;
    Brush.Color := color;
    {Renk karışımları.}
    r := GetRValue(color);
    g := GetGValue(color);
    b := GetBValue(color);
    {Topların çizimi.}
    dw := size div 16;
    for i := 0 to 15 do begin
      xy1 := (i * dw) div 2;
      xy2 := size - xy1;
      Brush.Color := RGB(Min(r + (i * 8), 255), Min(g + (i * 8), 255),
                         Min(b + (i * 8), 255));
      Ellipse(x + xy1, y + xy1, x + xy2, y + xy2);
    end;
  end;
end; {TScrnFrm.DrawSphere}

procedure TScrnFrm.DeactivateScrnSaver(var Msg : TMsg; var Handled : boolean);
var
  done : boolean;
begin
  if Msg.message = WM_MOUSEMOVE then
    done := (Abs(LOWORD(Msg.lParam) - crs.x) > 5) or
            (Abs(HIWORD(Msg.lParam) - crs.y) > 5)
  else
    done := (Msg.message = WM_KEYDOWN)     or (Msg.message = WM_KEYUP)       or
            (Msg.message = WM_SYSKEYDOWN)  or (Msg.message = WM_SYSKEYUP)    or
            (Msg.message = WM_ACTIVATE)    or (Msg.message = WM_NCACTIVATE)  or
            (Msg.message = WM_ACTIVATEAPP) or (Msg.message = WM_LBUTTONDOWN) or
            (Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_MBUTTONDOWN);
  if done then
    Close;
end; {TScrnFrm.DeactivateScrnSaver}

procedure TScrnFrm.tmrTickTimer(Sender: TObject);
const
  sphcount : integer = 0;
var
  x, y    : integer;
  size    : integer;
  r, g, b : byte;
  color   : TColor;
begin
  Inc(sphcount);
  x := Random(ClientWidth);
  y := Random(ClientHeight);
  size := 25;
  x := x - size div 2;
  y := y - size div 2;
  r := Random($80);
  g := Random($80);
  b := Random($80);
  DrawSphere(x, y, size, RGB(r, g, b));
end; {TScrnFrm.tmrTickTimer}

procedure TScrnFrm.FormShow(Sender: TObject);
begin
  GetCursorPos(crs);
  tmrTick.Interval      := 100;
  tmrTick.Enabled       := true;
  Application.OnMessage := DeactivateScrnSaver;
  ShowCursor(false);
end; {TScrnFrm.FormShow}

procedure TScrnFrm.FormHide(Sender: TObject);
begin
  Application.OnMessage := nil;
  tmrTick.Enabled       := false;
  ShowCursor(true);
end; {TScrnFrm.FormHide}

procedure TScrnFrm.FormActivate(Sender: TObject);
begin
  WindowState := wsMaximized;
end; {TScrnFrm.FormActivate}

end.
Spheres.DPR
program Spheres;

uses
  Forms,
  SysUtils,
  Scrn in 'SCRN.PAS' {ScrnFrm};

{$R *.RES}
{$D SCRNSAVE Spheres Ekran koruyucu}

begin
  {Sadece birkez çalışmalı.}
  if hPrevInst = 0 then
  begin
    if (ParamCount > 0) and (UpperCase(ParamStr(1)) = '/S') then
    begin
        Application.CreateForm(TScrnFrm, ScrnFrm);
        application.initialize;
        Application.Run;
   end else application.Terminate;
end;
end.