Nekoliko malih Tips&Tricks kodova za Delphi

Nekoliko malih Tips&Tricks kodova za Delphi

offline
  • Đuro Glumac
  • dipl. ing. informatike
  • Pridružio: 08 Feb 2004
  • Poruke: 3640
  • Gde živiš: ApAtIn

Ipitivanje da li ste trenutno konektovani na Internet?
~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.Button1Click(Sender: TObject) ;

function FuncAvail(_dllname, _funcname: string;
var _p: pointer): boolean;
{return True if _funcname exists in _dllname}
var _lib: tHandle;
begin
Result := false;
if LoadLibrary(PChar(_dllname)) = 0 then exit;
_lib := GetModuleHandle(PChar(_dllname)) ;
if _lib <> 0 then begin
_p := GetProcAddress(_lib, PChar(_funcname)) ;
if _p <> NIL then Result := true;
end;
end;

{
Call SHELL32.DLL for Win > Win98
otherwise call URL.dll
}
{buton code:}
var
InetIsOffline : function(dwFlags: DWORD):
BOOL; stdcall;
begin
if FuncAvail('URL.DLL', 'InetIsOffline',
@InetIsOffline) then
if InetIsOffLine(0) = true
then ShowMessage('Not connected')
else ShowMessage('Connected!') ;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~

Enable/Disable the Windows 'START' button

~~~~~~~~~~
//Enable:
EnableWindow(FindWindowEx(FindWindow
('Shell_TrayWnd', nil), 0,'Button',nil),TRUE) ;
//Disable:
EnableWindow(FindWindowEx(FindWindow
('Shell_TrayWnd', nil), 0,'Button',nil),FALSE) ;

~~~~~~~~~~


Show/Hide the TaskBar in Windows
~~~~~~~~~~
//To hide the task bar use
ShowWindow(FindWindow
('Shell_TrayWnd',nil), SW_HIDE) ;

//To show the task bar use
ShowWindow(FindWindow
('Shell_TrayWnd',nil), SW_SHOWNA) ;
~~~~~~~~~~

Open & Close CD-drive from code
~~~~~~~~~~~~~~~~~~~~~~~~~
{ To OPEN the CD-ROM: }
mciSendString
('Set cdaudio door open wait', nil, 0, handle) ;

{ To CLOSE the CD-ROM: }
mciSendString
('Set cdaudio door closed wait', nil, 0, handle) ;
~~~~~~~~~~~~~~~~~~~~~~~~~

Show / Hide Desktop icons
~~~~~~~~~~~~~~~~~~~~~~~~~
procedure ShowDesktop(const YesNo : boolean) ;
var h : THandle;
begin
h := FindWindow('ProgMan', nil) ;
h := GetWindow(h, GW_CHILD) ;
if YesNo = True then
ShowWindow(h, SW_SHOW)
else
ShowWindow(h, SW_HIDE) ;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~
Hide/Show Tray icons
~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TraySHOW
var TopWindow : HWND;
begin
TopWindow:=
FindWindow('Shell_TrayWnd', nil) ;
TopWindow:=
FindWindowEx(TopWindow,0, 'ReBarWindow32', nil) ;
TopWindow:=
FindWindowEx(TopWindow,0, 'SysPager', nil) ;
ShowWindow( TopWindow,Sw_Show) ;
end;

procedure TrayHIDE
var TopWindow : HWND;
begin
TopWindow:=
FindWindow('Shell_TrayWnd', nil) ;
TopWindow:=
FindWindowEx(TopWindow,0, 'ReBarWindow32', nil) ;
TopWindow:=
FindWindowEx(TopWindow,0, 'SysPager', nil) ;
ShowWindow( TopWindow,Sw_Hide) ;
end;

~~~~~~~~~~~~~~~~~~~~~~~~~
Empty Recycle Bin
~~~~~~~~~~~~~~~~~~~~~~~~~
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, ShellApi,Controls, Forms,
Dialogs,StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject) ;
end;

var Form1: TForm1;

function SHEmptyRecycleBin
(Wnd:HWnd; LPCTSTR:PChar;
DWORD:Word):Integer; stdcall;

const
SHERB_NOCONFIRMATION = $00000001;
SHERB_NOPROGRESSUI = $00000002;
SHERB_NOSOUND = $00000004;

implementation {$R *.DFM}

function SHEmptyRecycleBin; external
'SHELL32.DLL' name 'SHEmptyRecycleBinA';

procedure TForm1.Button1Click(Sender: TObject) ;
begin
SHEmptyRecycleBin(self.handle,'',
SHERB_NOCONFIRMATION) ;
end;
end.
~~~~~~~~~~~~~~~~~~~~~~~~~


Shut down Windows 2000 / XP / NT
~~~~~~~~~~~~~~~~~~~~~~~~~
function ShutdownNTplatform:boolean;
const
ADJUST_PRIV = TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES;
SHTDWN_PRIV = 'SeShutdownPrivilege';
PRIV_SIZE = sizeOf(TTokenPrivileges) ;
var
Len: DWORD;
TokenPriv, Dummy: TTokenPrivileges;
Token: THandle;
Text,
Machine:array [0..128] of Char;
Force,Reboot:boolean;
Error:integer;
begin
Error := 0;
if not OpenProcessToken(GetCurrentProcess(), ADJUST_PRIV, Token) then
Error := Error or 4;
{ ShowMessage('OpenProcessToken failed') ; }
if not LookupPrivilegeValue(nil, SHTDWN_PRIV,TokenPriv.Privileges[0].Luid) then
Error:=Error or 8;
{ ShowMessage('LookupPrivilegeValue failed') ; }
TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
TokenPriv.PrivilegeCount := 1; // One privilege to set
if not AdjustTokenPrivileges(Token, false, TokenPriv, PRIV_SIZE,Dummy, Len) then
Error:=Error or 16;
{ ShowMessage('AdjustTokenPrivileges failed') ; }
StrPCopy(Text,FMessage) ;
StrPCopy(Machine,FMachineName) ;
InitiateSystemShutDown (Machine,Text,FTimeOut,True,False) ;
Result := (Error = 0) ;
end;

~~~~~~~~~~~~~~~~~~~~~~~~~

From TTime and TDate to TDateTime
~~~~~~~~~~~~~~~~~~~~~~~~~
var
DateValue : TDate;
TimeValue: TTime;
OutDateTime : TDateTime;
...
// OutDateTime combines DateValue and TimeValue
OutDateTime := Int(DateValue) + Frac(TimeValue) ;

~~~~~~~~~~~~~~~~~~~~~~~~~

How to convert Seconds to Time
Here'a a simple function to convert an "amount" of seconds to HH:MM:SS string.
~~~~~~~~~~~~~~~~~~~~~~~~~
function SecToTime(Sec: Integer): string;
var
H, M, S: string;
ZH, ZM, ZS: Integer;
begin
ZH := Sec div 3600;
ZM := Sec div 60 - ZH * 60;
ZS := Sec - (ZH * 3600 + ZM * 60) ;
H := IntToStr(ZH) ;
M := IntToStr(ZM) ;
S := IntToStr(ZS) ;
Result := H + ':' + M + ':' + S;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~
Get Last Day in Month
~~~~~~~~~~~~~~~~~~~~~~~~~
function LastDayCurrMon: TDate;
var
y, m, d: word;
begin
decodedate(now, y, m, d) ;
m := m + 1;
if m > 12 then
begin
y := y + 1;
m := 1;
end;
result := encodedate(y, m, 1) - 1;
end;

{Usage:}
ShowMessage(DateToStr(LastDayCurrMon)) ;
~~~~~~~~~~~~~~~~~~~~~~~~~

Week number calculating
~~~~~~~~~~~~~~~~~~~~~~~~~
function WeekNum(const TDT:TDateTime) : Word;
var
Y,M,D:Word;
dtTmp:TDateTime;
begin
DecodeDate(TDT,Y,M,D) ;
dtTmp := EnCodeDate(Y,1,1) ;
Result :=
(Trunc(TDT-dtTmp)+(DayOfWeek(dtTmp)-1)) DIV 7;
if Result <> 0 then Result := Result - 1;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~

Nadam se da ce vam ovi sourcevi biti zanimljivi. Ako nesto nije jasno pitajte?



Registruj se da bi učestvovao u diskusiji. Registrovanim korisnicima se NE prikazuju reklame unutar poruka.
offline
  • Max  Male
  • Super građanin
  • Marko Milic
  • MWEB - Project manager & Front-end developer /Saobracajni inzenjer
  • Pridružio: 02 Nov 2003
  • Poruke: 1363
  • Gde živiš: Beograd - Jagodina

Dobra ovo fora za enable-disable start buton. Malo bih moga da se igram, dao si mi dobre ideje.



offline
  • Strog  Male
  • Stručni saradnik
    Web programiranje
  • Bojan Kopanja
  • Web & Mobile developer @ ZeusSoftware
  • Pridružio: 26 Jul 2003
  • Poruke: 2597
  • Gde živiš: Stara Pazova

Fino, fino NuLLCoDe, ovde ima stvarno korisnih stvarčica, mada sam za večinu već znao ( ovo za Start btton mi do sada nije trebalo pa nisam ni znao, ali kao što Max reče, nove ideje za prankove su rođene Wink ).

offline
  • Max  Male
  • Super građanin
  • Marko Milic
  • MWEB - Project manager & Front-end developer /Saobracajni inzenjer
  • Pridružio: 02 Nov 2003
  • Poruke: 1363
  • Gde živiš: Beograd - Jagodina

Posto mi na faxu daju internet na kasicicu dao si mi dobar predlog sta da radim u slobodno vreme Smile

offline
  • Đuro Glumac
  • dipl. ing. informatike
  • Pridružio: 08 Feb 2004
  • Poruke: 3640
  • Gde živiš: ApAtIn

I ja imam problema sa mojima na faxu. Moracu da smislim nesto Twisted Evil
Napravili su usera "Student" koji ne moze nista da radi...jedva su dozvolili da mogu i start menu da otvorim Smile

offline
  • Pridružio: 26 Mar 2005
  • Poruke: 57
  • Gde živiš: pAnČeVo

Onaj OPEN/CLOSE CD-ROM bas nesto i nece da mi radi!

Da tu ne treba jos nesto? Stalno mi javlja Da mciSendString nije deklarisan.

offline
  • Srđan Tot
  • Am I evil? I am man, yes I am.
  • Pridružio: 12 Jul 2005
  • Poruke: 2483
  • Gde živiš: Ljubljana

Dodaj MMSystem u uses listu.

Dopuna: 22 Mar 2006 0:36

Da malo osvezimo ovu temu Smile

Svrljao sam malo netom i naidjem na ovaj sajt: http://www.delphitricks.com/index.php

Ima prilicno korisnih stvari.

offline
  • Pridružio: 08 Jan 2007
  • Poruke: 279
  • Gde živiš: Srbija

Moj favorit:
http://www.swissdelphicenter.ch/en/datenbanken.php?sort=&start=25

Ko je trenutno na forumu
 

Ukupno su 965 korisnika na forumu :: 75 registrovanih, 14 sakrivenih i 876 gosta   ::   [ Administrator ] [ Supermoderator ] [ Moderator ] :: Detaljnije

Najviše korisnika na forumu ikad bilo je 3466 - dana 01 Jun 2021 17:07

Korisnici koji su trenutno na forumu:
Korisnici trenutno na forumu: A.R.Chafee.Jr., airsuba, aljosa7, Andrija357, armor, Ben Roj, bojank, Boter, brundo65, Bubili, Bubimir, Buda Baba, burevesnik, cavatina, darkangel, Dorcolac, dragoljub11987, Drug pukovnik, Ehinacea, FileFinder, Fog of War, Frunze, gomago, goran.vvv, Griffon vulture, hyla, Istman, Joja, krlebgd77, kulus, kunktator, ladro, ljuba, Mahovljani, manda87, Marko Marković, maskirovka, mercedesamg, Mimikrija, miodrag, Mixelotti, Mlav, nemkea71, nobutado, novator, oldtimer, operniki, opt1, Parker, pedja2506, pein, proka89, proleter373, RobinHood12, Rocker, Rogan33, Shinobi, Snorks, sombrero, ss10, stagezin, Stoilkovic, strn, t84dar, Tenk, time, upitnik, Van, VJ, Vlada1389, vladom6, Wisdomseeker, wizzardone, YU-UKI, zillbg