تمامی مسائل و مباحث در مورد دلفی

چگونه دکمه Caps Lock را روشن و خاموش کنیم
ابتدا باید فانکشن را به این صورت تعریف کنید:

کد:

---


procedure SetCapsLockKey( vcode: Integer; down: Boolean );
begin
if Odd(GetAsyncKeyState( vcode )) <> down then
begin
        keybd_event( vcode, MapVirtualkey( vcode, 0 ),
                                KEYEVENTF_EXTENDEDKEY, 0);
        keybd_event( vcode, MapVirtualkey( vcode, 0 ),
                                KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
end;
end;

---

سپس به این صورت از آن استفاده کنید:

کد:

---

SetCapsLockKey( VK_CAPITAL, True );

---

توجه:
فانکشن های 'keybd_event', 'MapVirtualkey' , 'GetAsyncKeyState از فانشکن های API ویندوز هستند ...

یکی از DLL های ویندوز به نام Winmm.dll دارای فانکشنی به نام waveOutGetNumDevs است که با استفاده از آن می توانید چک کنید کارت صدا در سیستم نصب شده است یا نه ...
ابتدا باید به این صورت تابع را تعریف کنید :

کد:

---

function IsSoundcardInstalled: longint; stdcall;
                external 'winmm.dll'
                name 'waveOutGetNumDevs';

---

و بدین صورت از آن استفاده کنید:

کد:

---

if IsSoundcardInstalled > 0 then
  ShowMessage('Soundcard is there...');

---

چگونه می توان از جابجایی فرم جلوگیری کرد ...

کد:

---

type
TyourForm = class(TForm)
private
        { Private declarations }
        procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
end;
 
procedure TyourForm.WMNCHitTest(var Message: TWMNCHitTest);
begin
inherited;
 
with Message do
if Result = HTCAPTION then
        Result := HTNOWHERE;
end;

---

چگونه می توان RecycleBin را خالی کرد ...
با استفاده از این کد می توانید سطل زباله ویندوز را خالی کنید ...

کد:

---

Procedure EmptyRecycleBin ;
Const
        SHERB_NOCONFIRMATION = $00000001 ;
        SHERB_NOPROGRESSUI = $00000002 ;
        SHERB_NOSOUND                = $00000004 ;
Type
TSHEmptyRecycleBin = function (Wnd : HWND;
                                                                pszRootPath : PChar;
                                                                dwFlags : DWORD
                                        ) : HRESULT; stdcall ;
Var
SHEmptyRecycleBin : TSHEmptyRecycleBin;
LibHandle                : THandle;
Begin { EmptyRecycleBin }
LibHandle := LoadLibrary(PChar('Shell32.dll')) ;
if LibHandle <> 0 then
        @SHEmptyRecycleBin := GetProcAddress(LibHandle, 'SHEmptyRecycleBinA')
else
begin
        MessageDlg('Failed to load Shell32.dll.', mtError, [mbOK], 0);
        Exit;
end;
 
 
if @SHEmptyRecycleBin <> nil then
        SHEmptyRecycleBin(Application.Handle,
                                        nil,
                                        SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI or SHERB_NOSOUND);
FreeLibrary(LibHandle);
@SHEmptyRecycleBin := nil ;
end;

---

فرمت کردن یک دریاو در win32

کد:

---

const SHFMT_DRV_A = 0;
const SHFMT_DRV_B = 1;
const SHFMT_ID_DEFAULT = $FFFF;
const SHFMT_OPT_QUICKFORMAT = 0;
const SHFMT_OPT_FULLFORMAT = 1;
const SHFMT_OPT_SYSONLY = 2;
const SHFMT_ERROR = -1;
const SHFMT_CANCEL = -2;
const SHFMT_NOFORMAT = -3;
function SHFormatDrive(hWnd : HWND;
                                        Drive : Word;
                                        fmtID : Word;
                                        Options : Word) : Longint
stdcall; external 'Shell32.dll' name 'SHFormatDrive';
procedure TForm1.Button1Click(Sender: TObject);
var
FmtRes : longint;
begin
try
        FmtRes:= ShFormatDrive(Handle,
                                                SHFMT_DRV_A,
                                                SHFMT_ID_DEFAULT,
                                                SHFMT_OPT_QUICKFORMAT);
        case FmtRes of
        SHFMT_ERROR : ShowMessage('Error formatting the drive');
        SHFMT_CANCEL :
        ShowMessage('User canceled formatting the drive');
        SHFMT_NOFORMAT : ShowMessage('No Format')
        else
        ShowMessage('Disk has been formatted');
        end;
except
end;
end;

---

کد:

---

bmp: TBitmap;
begin
  bmp := TBitmap.Create;
  bmp.Height := Form1.Height;
  bmp.Width := Form1.Width;
  DCWindow := GetWindowDC(Form1.Handle);
  BitBlt(bmp.Canvas.Handle, 0, 0, Form1.Width, Form1.Height,
        DCWindow, 0, 0, SRCCOPY);
  bmp.SaveToFile('C:\ScreenShot.bmp');
  ReleaseDC(DCWindow, DCWindow);
  bmp.Free;
end;

---

Drop Dawn کردن آیتم های لیست باکس ...

کد:

---

var // form level
  StartingPoint : TPoint;

implementation

...

procedure TForm1.FormCreate(Sender: TObject) ;
begin
  ListBox1.DragMode := dmAutomatic;
end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer) ;
var
  DropPosition, StartPosition: Integer;
  DropPoint: TPoint;
begin
  DropPoint.X := X;
  DropPoint.Y := Y;
  with Source as TListBox do
  begin
    StartPosition := ItemAtPos(StartingPoint,True) ;
    DropPosition := ItemAtPos(DropPoint,True) ;

    Items.Move(StartPosition, DropPosition) ;
  end;
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean) ;
begin
  Accept := Source = ListBox1;
end;

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) ;
begin
  StartingPoint.X := X;
  StartingPoint.Y := Y;
end;

---

نمایش صفحه مشخصات یک فایل ( Properties ) ...
یک Open Dialog و یک دکمه بر روی فرم بزارید ...

با کد زیر ، بعد از باز شدن فایل به وسیله Open Dialog و زدن دکمه پنجره خصوصیات فایل نشون داده می شه :

کد:

---

uses
  shellapi;

procedure PropertiesDialog(FileName: string);
var
  sei: TShellExecuteInfo;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := SizeOf(sei);
  sei.lpFile := PChar(FileName);
  sei.lpVerb := 'properties';
  sei.fMask  := SEE_MASK_INVOKEIDLIST;
  ShellExecuteEx(@sei);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  if Opendialog1.Execute then
    PropertiesDialog(Opendialog1.FileName);
end;

---

تابع زیر مشخص می کنه که سیستم متصل به انترنت هست یا نه

کد:

---

Compilers Delphi
Category Internet
Uses
        Windows,
        WinInet;

Function ConnectedToInternet:Boolean;
Var Flags : DWORD;
Begin
        Flags :=INTERNET_CONNECTION_MODEM or INTERNET_CONNECTION_LAN or INTERNET_CONNECTION_PROXY;
        Result:=InternetGetConnectedState(@Flags, 0);
End;

---

به دست اوردن نام کاربری

کد:

---

Uses
Windows,
SysUtils;

function GetUserName : String;
var
Name : PChar;
Size : DWORD;
begin
Size := SizeOf(ShortString);
GetMem(Name, Size);
try
GetUserName(Name, Size);
Result := Trim(StrPas(Name));
finally
FreeMem(Name, Size);
end;
end;

---