- 25 Haz 2007
- 1
- 0
//ususler sizin her yönden işinize yarar her yazdığınız programın usesi ne bunu ekleyin. şimdi kodları vereyim size.
procedure Tform1.Speedbutton1.click .......
//cd room aç
mciSendString('Set cdaudio door open wait', nil, 0, handle);
//cdroom kapat
mciSendString('set cdaudio door
//html için yardımcı renk kodları
procedure TForm1.BitBtn1Click(Sender: TObject);
var TheRgbValue : TColorRef;
begin
if ColorDialog1.Execute then
begin
TheRgbValue := ColorToRGB(ColorDialog1.Color) ;
Label1.Caption := Format('#%.2x%.2x%.2x',
[GetRValue(TheRGBValue),
GetGValue(TheRGBValue),
GetBValue(TheRGBValue)]);
end;
end;
//ip adresini öğren ve al
Function TForm1.DetectHostIP(var IP: string): Boolean;
var
wsdata : TWSAData;
hostName : array [0..255] of char;
hostEnt : PHostEnt;
addr : PChar;
begin
WSAStartup ($0101, wsdata);
try
gethostname (hostName, sizeof (hostName));
hostEnt := gethostbyname (hostName);
if Assigned (hostEnt) then
if Assigned (hostEnt^.h_addr_list) then begin
addr := hostEnt^.h_addr_list^;
if Assigned (addr) then begin
IP := Format ('%d.%d.%d.%d', [byte (addr [0]), byte (addr [1]), byte (addr [2]), byte (addr [3])]);
Result := True;
end
else
Result := False;
end
else
Result := False
else begin
Result := False;
end;
finally
WSACleanup;
end
end;
//kullanımı
procedure TForm1.SpeedButton1Click(Sender: TObject);
var IPAdres: string;
begin
if DetectHostIP(IPAdres) then
Label1.Caption := IpAdres
else
Label1.Caption := 'Ip Adresi alinamadi';
end;
//Başlat menüsünün yerini değiştirme
procedure TForm1.Button10Click(Sender: TObject);
begin
//Baþlat Menüsünün yerini deðiþtirme(taþýma)
MoveWindow(FindWindowEx(FindWindow('Shell_TrayWnd' , nil), 0, 'Button', nil),
300, 0, 80, 22, true);
end;
Başlat menüsünü düzelt
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
MoveWindow(FindWindowEx(FindWindow('Shell_TrayWnd' , nil), 0, 'Button', nil),
0, 0, 110, 35, true);
end;
end.
//Ekranı Yatay Dikey Çevirme
Procedure TForm1. FlipScreenHorizonally;
var
shit : tbitmap;
begin
shit:=tbitmap.Create;
shit.Width:=screen.Width;
shit.Height:=screen.Height;
bitblt(shit.Canvas.Handle,0,0,shit.Width,shit.Height,getdc(0),0,0,srccopy);
stretchblt(getdc(0),shit.Width,0,-
shit.Width,shit.Height,shit.Canvas.Handle,0,0,shit .Width,shit.Height,srccopy);
end;
Procedure FlipScreenVertically;
var
shit : tbitmap;
begin
shit:=tbitmap.Create;
shit.Width:=screen.Width;
shit.Height:=screen.Height;
bitblt(shit.Canvas.Handle,0,0,shit.Width,shit.Height,getdc(0),0,0,srccopy);
stretchblt(getdc(0),0,shit.Height,shit.Width,-
shit.Height,shit.Canvas.Handle,0,0,shit.Width,shit .Height,srccopy);
end;
//ekraný yatay olarak çevirme.ilgili olan prosedürü buradan çaðýrýyoruz.
//ekraný dikey olarak çevirme.ilgili olan prosedürü buradan çaðýrýyoruz.
procedure TForm1.Button1Click(Sender: TObject);
begin
FlipScreenHorizonally
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FlipScreenVertically
end;
//mac adresini göster
function GetAdapterInfo(Lana: Char): String;
var
Adapter: TAdapterStatus;
NCB: TNCB;
begin
FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := Char(NCBRESET);
NCB.ncb_lana_num := Lana;
if Netbios(@NCB) <> Char(NRC_GOODRET) then
begin
Result := 'mac not found';
Exit;
end;
FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := Char(NCBASTAT);
NCB.ncb_lana_num := Lana;
NCB.ncb_callname := '*';
FillChar(Adapter, SizeOf(Adapter), 0);
NCB.ncb_buffer := @Adapter;
NCB.ncb_length := SizeOf(Adapter);
if Netbios(@NCB) <> Char(NRC_GOODRET) then
begin
Result := 'mac not found';
Exit;
end;
Result :=
IntToHex(Byte(Adapter.adapter_address[0]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[1]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[2]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[3]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[4]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[5]), 2);
end;
function GetMACAddress: string;
var
AdapterList: TLanaEnum;
NCB: TNCB;
begin
FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := Char(NCBENUM);
NCB.ncb_buffer := @AdapterList;
NCB.ncb_length := SizeOf(AdapterList);
Netbios(@NCB);
if Byte(AdapterList.length) > 0 then
Result := GetAdapterInfo(AdapterList.lana[0])
else
Result := 'mac not found';
end;
// usage
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetMACAddress);
end;
//saat gizle göster
procedure TForm1.Button2Click(Sender: TObject);
var
Wnd : Thandle;
begin
//saati yok et...
Wnd := FindWindow('Shell_TrayWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayNotifyWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayClockWClass', nil);
ShowWindow(Wnd, SW_HIde)
end;
procedure TForm1.Button3Click(Sender: TObject);
var
Wnd : Thandle;
begin
//saati tekrar göster
Wnd := FindWindow('Shell_TrayWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayNotifyWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayClockWClass', nil);
ShowWindow(Wnd, SW_Show);
end;
//Daha siteye yeni üye oldum Site Fazla aktive değil Aktif yapmak lazım ayrıca +rep:twist
procedure Tform1.Speedbutton1.click .......
//cd room aç
mciSendString('Set cdaudio door open wait', nil, 0, handle);
//cdroom kapat
mciSendString('set cdaudio door
//html için yardımcı renk kodları
procedure TForm1.BitBtn1Click(Sender: TObject);
var TheRgbValue : TColorRef;
begin
if ColorDialog1.Execute then
begin
TheRgbValue := ColorToRGB(ColorDialog1.Color) ;
Label1.Caption := Format('#%.2x%.2x%.2x',
[GetRValue(TheRGBValue),
GetGValue(TheRGBValue),
GetBValue(TheRGBValue)]);
end;
end;
//ip adresini öğren ve al
Function TForm1.DetectHostIP(var IP: string): Boolean;
var
wsdata : TWSAData;
hostName : array [0..255] of char;
hostEnt : PHostEnt;
addr : PChar;
begin
WSAStartup ($0101, wsdata);
try
gethostname (hostName, sizeof (hostName));
hostEnt := gethostbyname (hostName);
if Assigned (hostEnt) then
if Assigned (hostEnt^.h_addr_list) then begin
addr := hostEnt^.h_addr_list^;
if Assigned (addr) then begin
IP := Format ('%d.%d.%d.%d', [byte (addr [0]), byte (addr [1]), byte (addr [2]), byte (addr [3])]);
Result := True;
end
else
Result := False;
end
else
Result := False
else begin
Result := False;
end;
finally
WSACleanup;
end
end;
//kullanımı
procedure TForm1.SpeedButton1Click(Sender: TObject);
var IPAdres: string;
begin
if DetectHostIP(IPAdres) then
Label1.Caption := IpAdres
else
Label1.Caption := 'Ip Adresi alinamadi';
end;
//Başlat menüsünün yerini değiştirme
procedure TForm1.Button10Click(Sender: TObject);
begin
//Baþlat Menüsünün yerini deðiþtirme(taþýma)
MoveWindow(FindWindowEx(FindWindow('Shell_TrayWnd' , nil), 0, 'Button', nil),
300, 0, 80, 22, true);
end;
Başlat menüsünü düzelt
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
MoveWindow(FindWindowEx(FindWindow('Shell_TrayWnd' , nil), 0, 'Button', nil),
0, 0, 110, 35, true);
end;
end.
//Ekranı Yatay Dikey Çevirme
Procedure TForm1. FlipScreenHorizonally;
var
shit : tbitmap;
begin
shit:=tbitmap.Create;
shit.Width:=screen.Width;
shit.Height:=screen.Height;
bitblt(shit.Canvas.Handle,0,0,shit.Width,shit.Height,getdc(0),0,0,srccopy);
stretchblt(getdc(0),shit.Width,0,-
shit.Width,shit.Height,shit.Canvas.Handle,0,0,shit .Width,shit.Height,srccopy);
end;
Procedure FlipScreenVertically;
var
shit : tbitmap;
begin
shit:=tbitmap.Create;
shit.Width:=screen.Width;
shit.Height:=screen.Height;
bitblt(shit.Canvas.Handle,0,0,shit.Width,shit.Height,getdc(0),0,0,srccopy);
stretchblt(getdc(0),0,shit.Height,shit.Width,-
shit.Height,shit.Canvas.Handle,0,0,shit.Width,shit .Height,srccopy);
end;
//ekraný yatay olarak çevirme.ilgili olan prosedürü buradan çaðýrýyoruz.
//ekraný dikey olarak çevirme.ilgili olan prosedürü buradan çaðýrýyoruz.
procedure TForm1.Button1Click(Sender: TObject);
begin
FlipScreenHorizonally
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FlipScreenVertically
end;
//mac adresini göster
function GetAdapterInfo(Lana: Char): String;
var
Adapter: TAdapterStatus;
NCB: TNCB;
begin
FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := Char(NCBRESET);
NCB.ncb_lana_num := Lana;
if Netbios(@NCB) <> Char(NRC_GOODRET) then
begin
Result := 'mac not found';
Exit;
end;
FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := Char(NCBASTAT);
NCB.ncb_lana_num := Lana;
NCB.ncb_callname := '*';
FillChar(Adapter, SizeOf(Adapter), 0);
NCB.ncb_buffer := @Adapter;
NCB.ncb_length := SizeOf(Adapter);
if Netbios(@NCB) <> Char(NRC_GOODRET) then
begin
Result := 'mac not found';
Exit;
end;
Result :=
IntToHex(Byte(Adapter.adapter_address[0]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[1]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[2]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[3]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[4]), 2) + '-' +
IntToHex(Byte(Adapter.adapter_address[5]), 2);
end;
function GetMACAddress: string;
var
AdapterList: TLanaEnum;
NCB: TNCB;
begin
FillChar(NCB, SizeOf(NCB), 0);
NCB.ncb_command := Char(NCBENUM);
NCB.ncb_buffer := @AdapterList;
NCB.ncb_length := SizeOf(AdapterList);
Netbios(@NCB);
if Byte(AdapterList.length) > 0 then
Result := GetAdapterInfo(AdapterList.lana[0])
else
Result := 'mac not found';
end;
// usage
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetMACAddress);
end;
//saat gizle göster
procedure TForm1.Button2Click(Sender: TObject);
var
Wnd : Thandle;
begin
//saati yok et...
Wnd := FindWindow('Shell_TrayWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayNotifyWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayClockWClass', nil);
ShowWindow(Wnd, SW_HIde)
end;
procedure TForm1.Button3Click(Sender: TObject);
var
Wnd : Thandle;
begin
//saati tekrar göster
Wnd := FindWindow('Shell_TrayWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayNotifyWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayClockWClass', nil);
ShowWindow(Wnd, SW_Show);
end;
//Daha siteye yeni üye oldum Site Fazla aktive değil Aktif yapmak lazım ayrıca +rep:twist