ايران ويج

ايران ويج > برنامه نویسی > دلفی > سورس دلفی
نسخه‌ی کامل: سورس دلفی
شما در حال مشاهده‌ی نسخه‌ی متنی این صفحه می‌باشید. مشاهده‌ی نسخه‌ی کامل با قالب بندی مناسب.
صفحه‌ها: 1 2 3 4 5

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

[تصویر: tip34-291x300.png]

کد:
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

[تصویر: shell32_icons.jpg]

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;
صفحه‌ها: 1 2 3 4 5
ايران ويج > برنامه نویسی > دلفی > سورس دلفی