سورس دلفی

[lord_viper]

حرکت فورم بدون استفاده از کپشن

کد:

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(Form1.Handle, WM_SYSCOMMAND, $F012, 0);
end;

[lord_viper]

این تابع mouse و keyboard را غیر فعال مکند البته یک استثنا هم دارد که با زدن Ctrl+Alt+Delete همه چیز به حالت اول باز میگردد

کد:

function BlockInput(fBlockInput: Boolean): DWORD; stdcall; external 'user32.DLL';

بستن mouse و keyboard

کد:

procedure TForm1.Button1Click(Sender: TObject);
begin
  BlockInput(True);
end;

باز کردن mouse و keyboard

کد:

procedure TForm1.Button2Click(Sender: TObject);
begin
  BlockInput(False);
end;

[alidehban]

ساخت پوشه در MY COMPUTER

با این تکه کد میشه به MY COMPUTER یک آیتم اضافه کرد...
مسير پوشه ي جديد رو بکمک بخش مشخص شده در تصوير به دلخواه تغيير بديد
مسیر پيش فرض C هست!

[lord_viper]

نمایش Select Directory

کد:

uses Filectrl;

{....}

procedure TForm1.Button1Click(Sender: TObject);
var
  Dir: String;
begin
  SelectDirectory('Select a directory', '', Dir);
  ShowMessage(Dir);
end;

[lord_viper]

چک کردن وجود یک مسیر

کد:

uses FileCtrl;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if DirectoryExists('c:\windows') then
    ShowMessage('Path exists!');
end;

[lord_viper]

ارسال یک فایل به سطل بازیافت recycle bin

کد:

uses ShellAPI;

function DeleteFileWithUndo(sFileName: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  FillChar(fos, SizeOf(fos), 0);
  with fos do
  begin
    wFunc  := FO_DELETE;
    pFrom  := PChar(sFileName);
    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
  end;
  Result := (0 = ShFileOperation(fos));
end;

[lord_viper]

اضافه کردن فایل به document menu

کد:

uses ShellAPI, ShlOBJ;

procedure AddToStartDocumentsMenu(sFilePath: string);
begin
  SHAddToRecentDocs(SHARD_PATH, PChar(sFilePath));
end;

[lord_viper]

شاید برای شما هم پیش اومده باشه تا دوست داشته باشین تا از ایکونهای shell32.dll بخواهین تو برنامتون استفاده کنین کد زیر شما ایکونهای مورد نظر رو تو imageList لود میکنین و میتونین در هر کجای برنامه ازش استفاده کنین
ما از تابع LoadIcon استفاده میکنیم که مقداری از نوع هندل برمیگرداند

لود ایکون از shell32 به image

کد:

procedure TForm1.Button1Click(Sender: TObject);
var
  H: THandle;
begin
  H := LoadLibrary('shell32.dll');
  Image1.Picture.Icon.Handle := LoadIcon(H, '#10');
  FreeLibrary(H);
end;

لود ایکون از shell32 به ImageList

کد:

procedure TForm1.Button1Click(Sender: TObject);
var
icon:Ticon;
begin
icon:=TIcon.Create;
icon.Handle:=loadicon(LoadLibrary('shell32.dll'),'#8');
il1.InsertIcon(0,icon);
icon.Handle:=loadicon(LoadLibrary('shell32.dll'),'#47');
il1.InsertIcon(1,icon);
icon.Free;

لیست ایکونهای shell32

[lord_viper]

دریافت پارامتر ارسالی به برنامه

کد:

procedure TForm1.FormCreate(Sender: TObject);
var
  i:Integer;
  str:string;
begin
  str:='';
for i:=1 to ParamCount do
str:=str+QuotedStr(ParamStr(i));
Caption:=str;
end;

[lord_viper]

انتی دیباگ با استفاده از دستور دلفی این کد رو میتونین هر جای برنامه مثل OnCreate فورم بزارین

کد:

{$IFDEF DEBUG}
    ShowMessage('under debuger');
{$ENDIF}

[lord_viper]

چک کردن جنیون بودن ویندوز

کد:

function IsWindowsGenuine() : Boolean;
const
  app_guid : TGUID = '{55C92734-D682-4D71-983E-D6EC3F16059F}';
  module   : string = 'Slwga.dll';
  api      : string = 'SLIsGenuineLocal';
var
  app_id : TGUID;
  state  : Byte;
  ret    : HRESULT;
  CheckGenuine : function (var appID : TGUID ; var result : Byte ; uReserved : Pointer): HRESULT;stdcall;
begin
  CheckGenuine := GetProcAddress(LoadLibrary(PChar(module)),PChar(api));
  if @CheckGenuine <> nil then
  begin
     app_id := app_guid;
     ret := CheckGenuine(app_id,state,nil);
     if Succeeded(ret) then
     begin
       Result := (state = 0);
       SetLastError(ERROR_SUCCESS);
     end
     else
     begin
       Result := False;
       SetLastError(ERROR_ACCESS_DENIED);
     end;
  end
  else
  begin
    Result := False;
    SetLastError(ERROR_INVALID_FUNCTION);
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
if (IsWindowsGenuine()) and (GetLastError() = ERROR_SUCCESS) then
ShowMessage('windows is genuine')
else
ShowMessage('window is not genuine');
end;