Acılır Kapanır Form

uses Printers, Buttons, ShellAPI;

private

FOldHeight : Integer;
procedure WMNCRButtonDown(var Msg : TWMNCRButtonDown);
message WM_NCRBUTTONDOWN;

procedure TForm1.FormCreate(Sender: TObject);
begin
FOldHeight := ClientHeight;
end;

procedure TForm1.WMNCRButtonDown(var Msg : TWMNCRButtonDown);
var
I : Integer;
begin
if (Msg.HitTest = HTCAPTION) then
if (ClientHeight = 0) then
begin
I := 0;
while (I < FOldHeight) do begin
I := I + 40;
if (I > FOldHeight) then
I := FOldHeight;
ClientHeight := I;
Application.ProcessMessages;
end;
end
else
begin
FOldHeight := ClientHeight;
I := ClientHeight;
//kapanma efekti icin, I degerini dogrudan "0" a esitlemek
//yerine kademeli olarak azaltabilirsiniz.

I := 0;
ClientHeight := I;
Application.ProcessMessages;
end;
end;
------------------------------------
Bilgisayarı Kapat

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls,ShellApi, XPMan, Menus;

type
TForm1 = class(TForm)
kapat: TDateTimePicker;
BitBtn1: TBitBtn;
Timer1: TTimer;
Label1: TLabel;
BitBtn2: TBitBtn;
XPManifest1: TXPManifest;
PopupMenu1: TPopupMenu;
ProgramGster1: TMenuItem;
Kapat1: TMenuItem;
Label2: TLabel;
Timer2: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Kapat1Click(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ProgramGster1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer2Timer(Sender: TObject);
private

public

end;

var
Form1: TForm1;
stray:NOTIFYICONDATA;
implementation


function cikis(flag : word): Boolean;
var veri : TOSVersionInfo;
hToken : THandle;
tp : TTokenPrivileges;
h : DWord;
begin
result := false;
veri.dwOSVersionInfoSize:=SizeOf(veri);
GetVersionEx(veri);
if veri.dwPlatformId = VER_PLATFORM_WIN32_NT then // Windows NT
begin
OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_ PRIVILEGES,hToken);
LookupPrivilegeValue(nil,'SeShutdownPrivilege',tp. Privileges[0].Luid);
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
h := 0;
AdjustTokenPrivileges(hToken,False,tp,0,PTokenPriv ileges(nil)^,h);
CloseHandle(hToken);
result := ExitWindowsEx(flag,0);
Application.Terminate;
end
else
begin
Result := ExitWindowsEx(flag,0);
Application.Terminate;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
VAR
KAL:STRING;
begin
bitbtn1.Visible:=false;
bitbtn2.Visible:=true;
if timetostr(kapat.Time)=timetostr(time) then begin
cikis(1);
end;
form1.Hint:=timetostr(kapat.Time-time]' kaldı';
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
timer1.Interval:=1000;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
timer1.Interval:=0;
bitbtn1.Visible:=true;
bitbtn2.Visible:=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
kapat.Time:=time;
ZeroMemory(0, 0);
CreateMutex(nil,FALSE,'PROGRAMADI');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
ShowMessage('Program Zaten Calışıyor. Program Kapatılacak!');
Halt(0);
end;
//SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
with stray do
begin
cbsize:=sizeof(stray);
wnd:=form1.handle;
hicon:=Application.icon.Handle;
uID:=0;
sztip:=' kaldı';
uflags:=7;
uCallBackMessage:=$200;//icon uzerine tıklama kontrolu icin
end;
Shell_NotifyIcon(0,@stray);
end;

procedure TForm1.Kapat1Click(Sender: TObject);
begin
halt(0);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var nokta:TPoint;
begin
getCursorPos(nokta);
if (x=$205) then PopupMenu1.Popup(nokta.x,nokta.y);
if (x=$203) then BEGIN
IF FORM1.ACTIVE=FALSE THEN BEGIN FORM1.Show; END
ELSE BEGIN FORM1.Hide; END;END;
end;

procedure TForm1.ProgramGster1Click(Sender: TObject);
begin
IF FORM1.ACTIVE=FALSE THEN BEGIN FORM1.Show; END
ELSE BEGIN FORM1.Hide; END;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=canone;
form1.Hide;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
label2.Caption:=timetostr(time);
end;

end.
---------------------------------------------
CD kapağını acma-kapama

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,MMSystem, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private

public

end;

var
Form1: TForm1;

implementation



procedure TForm1.Button1Click(Sender: TObject);
begin
mciSendString('set cdaudio door open',nil,0,Handle);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
mciSendString('set cdaudio door closed',nil,0,Handle);
end;

end.
----------------------
Yazılan Yazıyı sese cevirme

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
MMSystem, StdCtrls, Buttons, ComCtrls, Gauges, ExtCtrls, jpeg;

type
TForm1 = class(TForm)
ReadBtn: TBitBtn;
ExitBtn: TBitBtn;
OpenBtn: TBitBtn;
OpenDialog1: TOpenDialog;
ClearBtn: TBitBtn;
HelpBtn: TBitBtn;
Memo1: TMemo;
Timer1: TTimer;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label5: TLabel;
procedure ReadBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ExitBtnClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure OpenBtnClick(Sender: TObject);
procedure ClearBtnClick(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
private

public

end;





var
Form1: TForm1;
Ext:Boolean;
DirPath,swort:string;
stmp : Tstrings;

implementation

uses Unit2;



function Seps(As_Arg: Char): Boolean;
begin
Seps := As_Arg in
[#0..#$1F, ' ', '.', ',', '?', ':', ';', '(', ')', '/', '\'];
end;



function WordCount(CText: string): Longint;
var
Ix: Word; //burada ceşitli işlerde kullanmak uzere değişkenler tanımladım…
Work_Count: Longint;
stmp1: string;
begin
Work_Count := 0;
Ix := 1;
while Ix