تبلیغات
IT , دنیای رایانه و گوشی همراه - برنامه نویسی دلفی

،:|" الهم عجل الوالیك الفرج "|:، فرا رسیدن ماه محرم و صفر ایام سوگواری را تسلیت عرض میکنیم

 
 

کانال تلگرامی ما https://telegram.me/myCreativity

کد تابع تبدیل تاریخ میلادی به شمسی در دلفی

function kabiseh(year:integer):Boolean; 
begin

if ( ((year mod 100) <> 0 ) and ((year mod 4) = 0 ) ) or ( ((year mod 100 )=0) and ((year mod 400)=0) )then 
kabiseh:=true 
else 
kabiseh:=false;

end;

function m2sh(miladidate:string):string; 
var myear,shyear,mmonth,shmonth,mday,shday:integer; 
shyear_str,shmonth_str,shday_str:string; 
daycount,deydiff,farvardindiff:integer; 
days:array[0..12] of integer; 
days_kabiseh:array[0..12] of integer; 
begin

days[0]:=0; 
days[1]:=31; 
days[2]:=59; 
days[3]:=90; 
days[4]:=120; 
days[5]:=151; 
days[6]:=181; 
days[7]:=212; 
days[8]:=243; 
days[9]:=273; 
days[10]:=304; 
days[11]:=334;

days_kabiseh[0]:=0; 
days_kabiseh[1]:=31; 
days_kabiseh[2]:=60; 
days_kabiseh[3]:=91; 
days_kabiseh[4]:=121; 
days_kabiseh[5]:=152; 
days_kabiseh[6]:=182; 
days_kabiseh[7]:=213; 
days_kabiseh[8]:=244; 
days_kabiseh[9]:=274; 
days_kabiseh[10]:=305; 
days_kabiseh[11]:=335;


myear:=StrToInt(miladidate[1]+miladidate[2]+miladidate[3]+miladidate[4]); 
mmonth:=StrToInt(miladidate[6]+miladidate[7]); 
mday:=StrToInt(miladidate[9]+miladidate[10]);

farvardindiff:=79;

if kabiseh(myear) then daycount:=days[mmonth-1]+mday else daycount:=days_kabiseh[mmonth-1]+mday;

if kabiseh(myear-1) then deydiff:=11 else deydiff:=10;

if daycount > farvardindiff then 
begin

daycount:=daycount-farvardindiff; 
if daycount<= 186 then 
begin 
if daycount mod 31 = 0 then 
begin 
shmonth:=daycount div 31; 
shday:=31; 
end 
else 
begin 
shmonth:=(daycount div 31)+1; 
shday:=daycount mod 31; 
end; 
shyear:=myear-621; 
end 
else 
begin 
daycount:=daycount-186; 
if daycount mod 31 = 0 then 
begin 
shmonth:=daycount div 30+6; 
shday:=30; 
end 
else 
begin 
shmonth:=(daycount div 30)+7; 
shday:=daycount mod 30; 
end; 
shyear:=myear - 621; 
end; 
end 
else 
begin 
daycount:=daycount+deydiff; 
if daycount mod 30 = 0 then 
begin 
shmonth:=daycount div 30+9; 
shday:=30; 
end 
else 
begin 
shmonth:=(daycount div 30)+10; 
shday:=daycount mod 30; 
end; 
shyear:=myear - 622;


end;

str(shyear,shyear_str); 
str(shmonth,shmonth_str); 
str(shday,shday_str);

if Length(shmonth_str) < 2 then shmonth_str:='0' + shmonth_str; 
if Length(shday_str) < 2 then shday_str:='0' + shday_str ;

m2sh:=shyear_str+'/'+shmonth_str+'/'+shday_str;

end;

فایل های INI در دلفی
 
فایل های .INI دارای ساختاری بر اساس فایلهای متنی هستند و برای نگهداری اطلاعات پیکر بندی برنامه های کاربردی استفاده میشوند که هم براحتی بوسیله ما قابل ویرایش هستند و هم بوسیله یک ساختار ساده در هر برنامه ساده قابل دسترسی هستند .
بدلیل اینکه ویندوز داری Registry هست کسانی که از ویندوز استفاده میکنند آشنایی کمی با فایلهای .ini دارند ولی در ویندوز هنوز هم از فایلهای .ini استفاده میشود. مثل Win.ini و System.ini . ویندوز از این فایلها برای ذخیره اطلاعات مهمی از جمله اطلاعات پیکربندی استفاده میکند که براحتی قابل پاک شدن ، ویرایش و دیدن هستند.  بسیاری از برنامه های تحت ویندوز برای ذخیره اطلاعات پیکربندی خود از Registry  استفاده میکنند در حالیکه استفاده از فایلهای .ini هم سریعتر و هم ایمن تر است . یک مثال ساده برای استفاده از فایلهای  .ini ذخیره اندازه ، حالت و موقعیت فرم برنامه شماست . بطور کلی هر چیزی که شما در رجیستری ذخیره میکنید میشود در فایلهای .ini ذخیره کرد .
 
ساختار فایلهای .ini
فایلهای .ini نوعی فایل متنی هستند که به بخشهای محدود به 64 کیلو بایت (Section) تقسیم شدند که هر بخش میتواند دارای چند کلید (Key) باشد و هر کلید میتواند دارای صفر یا چند مقدار (Value) باشد . مثال:
[SectionName]
keyname=value
;comment
keyname=value
         نام هر بخش درون کروشه قرار گرفته و در باید در خط اول هر بخش قرار داشته باشد . نام بخشها و نام کلیدها نمیتوانند کاراکتر فاصله داشته باشند. بعد از نام کلیدها علامت = قرار میگیرد که میتواند قبل و بعد از آن کاراکتر فاصله قرار بگیرد . اگر بخشهایی با نام یکسان در یک فایل یا کلیدهایی با نام یکسان در یک بخش قرار داشته باشند مقدار آخر بر بقیه مقدارهای یکسان غالب است .
یک کلید میتواند دارای مقادیری از نوعهای String , Integer , Boolean باشد. دلفی از فایلهایINI در خیلی وضعیتها استفاده میکند. برای مثال فایلهای .SDK نوعی فایل هستند مانند ini ها .
 
 کلاس TiniFile
        دلفی برای ذخیره و بازیابی فایلهای ini. کلاس TiniFile را در اختیار ما قرار داده است. این کلاس در یونیت inifiles.pas  قرار گرفته است. قبل از کار کردن با فایلهای .ini لازم است یک مثال راجع به استفاده از این کلاس ببینیم.
 
uses inifiles;
...
var
  IniFile : TIniFile;
begin
  IniFile := TIniFile.Create('myapp.ini');


          این کد یه فایل .ini ایجاد میکند و این فایل را به myapp.ini  ارجاع میدهد . البته این کد فایل را درون پوشه ویندوز ایجاد میکند ولی بهتر این است که برای ذخیره کردن اطلاعاتی از برنامه فایل .ini را درون پوشه برنامه ایجاد کنید . برای این کار باید آدرس کامل فایل را بنویسید . مثال :                
IniFile := TIniFile.Create('C:\Hattel\myapp.ini');
 
          البته میتوانیم از تابع ChangeFileExt هم استفاده کنیم که در این صورت یک فایل با نام فایل برنامه و درون پوشه برنامه ایجاد میکنیم .
IniFile := TIniFile.Create(
        ChangeFileExt(Application.ExeName,'.ini'));
 
 
 خواندن از فایلهای .ini
 
         کلاس TiniFileچندین متد برای خواندن از فایلهای .ini دارند . متد  ReadString برای خواندن مقدارهای رشته ای از یک کلید استفاده میشود. متد ReadInteger, ReadFloat ومتدهای مشابه برای خواندن مقدارهای عددی استفاده میشوند . همه این متدها یک مقدار پیش فرض دارند که وقتی فایل مورد نظر یا کلید و مقدار مورد نظر موجود نباشد استفاده میشود. مثلا ReadString به این صورت بیان میشود.
 function ReadString(const Section, Ident,
 Default: String): String; override;
 Section نام بخش ، Ident نام کلید و Default نشان دهنده مقدار پیش فرض است .
 
 
نوشتن در فایلهای .ini
 
برای هر متد خواندن یک متد متناظر برای نوشتن وجود دارد . مثلا  WriteString, WriteBool, WriteInteger و غیره
فرض کنید میخواهیم برنامه ای بنویسیم که تاریخ آخرین استفاده و آخرین موقعیت فرم برنامه را ذخیره کند . پس لازم است یک فایل.ini  با دو بخش داشته باشیم . یک بخش با نام Date برای ذخیره تاریخ و یک بخش با نام Position برای ذخیره آخرین موقیت برنامه. بخش Date شامل کلید Last و بخش Position شامل کلیدهای Top, Left, width, Height .
کلید Last باید از نوع TDateTime و کلیدهای بخش Position باید از نوع عددی باشند.
 
برای نوشتن برنامه رویداد OnCreate فرم اصلی برنامه را بصورت زیر مینویسیم . (فراموش نکنید در بخش Uses یونیت TIniFiles را اضافه کنبد. )
 
procedure TForm1.FormCreate(Sender: TObject);
var
  MyIniFile  : TIniFile;
  LastDate : TDateTime;
begin
  MyIniFile := TIniFile.Create(
             ChangeFileExt(Application.ExeName,'.ini'));
 
  LastDate := MyIniFile.ReadDate('Date', 'Last', Date);
 
  ShowMessage('This program was previously used on '
                               + DateToStr(LastDate));
 
  Form1.Top := MyIniFile.ReadInteger
               ('Position','Top', Form1.Top);
  Form1.Left := MyIniFile.ReadInteger
                ('Position','Left', Form1.Left);
  Form1.Width := MyIniFile.ReadInteger
                 ('Position','Width', Form1.Width);
  Form1.Height := MyIniFile.ReadInteger
                  ('Position','Height', Form1.Height);
 
  MyIniFile.Free;
end;
            با این کد در صورتی که هنگام اجرای برنامه فایل .ini مورد نظر وجود داشته باشد آخرین تاریخ استفاده از برنامه نشان داده میشود و فرم در آخرین موقعیت قبلی قرار میگیرد.
 
          برای ذخیره شدن آخرین تاریخ و موقیت فرم ، رویداد OnClose فرم اصلی برنامه را به این صورت مینویسیم :
 



procedure TForm1.FormClose
           (Sender: TObject; var Action: TCloseAction);
var
  MyIniFile  : TIniFile;
begin
  MyIniFile := TIniFile.Create(
             ChangeFileExt(Application.ExeName,'.ini'));
 
  MyIniFile.WriteDate('Date', 'Last', Date);
 
  With MyIniFile, Form1 do
  begin
    WriteInteger('Position','Top', Top);
    WriteInteger('Position','Left', Left);
    WriteInteger('Position','Width', Width);
    WriteInteger('Position','Height', Height);
  end;
 
  MyIniFile.Free;
end;

 این کد باعث میشود در هنگام بسته شدن برنامه تاریخ و موقعیت فرم در فایل .ini ذخیره شود.
         
 
کار کردن با بخشها


چندین متد برای کار کردن با بخشها طراحی شدند. برای مثال متد EraseSection یک بخش را بطور کامل از فایل ini حذف میکند. متد های ReadSection نام کلیدهای یک بخش و متد ReadSections نام بخشهای یک فایل را در یک TStringList قرار میدهد. کلاسهای دیگری هم در یونیت Registry وجود دارند از جمله TRegIniFile برای دسترسی ساده به سیستم رجیستری ویندوز بصورت فایلهای ini که استفاده از آنها ساده است.
 
محدودیتها و راه حل ها


 بدلیل اینکه کلاس TIniFile از Windows API استفاده میکند یه محدودیت 64 کیلو بایتی به فایلهای ini تحمیل میشود. در صورتی که احتیاج دارید اطلاعاتی بیشتر از 64 کیلو بایت در فایل ذخیره کنید باید بجای استفاده از TIniFile از TMemIniFile استفاده کنید که در این صورت مشکل محدودیت 64 کیلو بایتی را ندارید.
   
===============================================================================

 



uses
   Commctrl;

      procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: pchar; Text: PWideChar;
BackCL, TextCL: TColor);
const
  TOOLTIPS_CLASS = 'tooltips_class32';
  TTS_ALWAYSTIP = $01;
  TTS_NOPREFIX = $02;
  TTS_BALLOON = $40;
  TTF_SUBCLASS = $0010;
  TTF_TRANSPARENT = $0100;
  TTF_CENTERTIP = $0002;
  TTM_ADDTOOL = $0400 + 50;
  TTM_SETTITLE = (WM_USER + 32);
  ICC_WIN95_CLASSES = $000000FF;
type
  TOOLINFO = packed record
    cbSize: Integer;
    uFlags: Integer;
    hwnd: THandle;
    uId: Integer;
    rect: TRect;
    hinst: THandle;
    lpszText: PWideChar;
    lParam: Integer;
  end;
var
  hWndTip: THandle;
  ti: TOOLINFO;
  hWnd: THandle;
begin
  hWnd    := Control.Handle;
  hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
    WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
    0, 0, 0, 0, hWnd, 0, HInstance, nil);
  if hWndTip <> 0 then
  begin
    SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
    ti.cbSize := SizeOf(ti);
    ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
    ti.hwnd := hWnd;
    ti.lpszText := Text;
    Windows.GetClientRect(hWnd, ti.rect);
    SendMessage(hWndTip, TTM_SETTIPBKCOLOR, BackCL, 0);
    SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, TextCL, 0);
    SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
    SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowBalloonTip(Button1, 1, 'Title',
  'Balloon tooltip,http://kingron.myetang.com; updated by Calin', clBlue, clNavy);
end;

===================================================================

procedure RenameDir(DirFrom, DirTo: string);
var
  shellinfo: TSHFileOpStruct;
begin
  with shellinfo do
  begin
    Wnd    := 0;
    wFunc  := FO_RENAME;
    pFrom  := PChar(DirFrom);
    pTo    := PChar(DirTo);
    fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or
              FOF_SILENT or FOF_NOCONFIRMATION;
  end;
  SHFileOperation(shellinfo);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  RenameDir('C:\Dir1', 'C:\Dir2');
end;

========================================================================

 

{
  Parameters:

  FileToSplit: Specify a file to split.
  SizeofFiles: Specify the size of the files you want to split to (in bytes)
  Progressbar: Specify a TProgressBar to show the splitting progress

  Result:
  SplitFile() will create files  FileName.001, FileName.002, FileName.003 and so on
  that are SizeofFiles bytes in size.
 }

function SplitFile(FileName : TFileName; SizeofFiles : Integer; ProgressBar : TProgressBar) : Boolean;
var
  i : Word;
  fs, sStream: TFileStream;
  SplitFileName: String;
begin
  ProgressBar.Position := 0;
  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    for i := 1 to Trunc(fs.Size / SizeofFiles) + 1 do
    begin
      SplitFileName := ChangeFileExt(FileName, '.'+ FormatFloat('000', i));
      sStream := TFileStream.Create(SplitFileName, fmCreate or fmShareExclusive);
      try
        if fs.Size - fs.Position < SizeofFiles then
          SizeofFiles := fs.Size - fs.Position;
        sStream.CopyFrom(fs, SizeofFiles);
        ProgressBar.Position := Round((fs.Position / fs.Size) * 100);
      finally
        sStream.Free;
      end;
    end;
  finally
    fs.Free;
  end;

end;

// Combine files / Dateien zusammenführen

{
  Parameters:

  FileName: Specify the first piece of the splitted files
  CombinedFileName: Specify the combined file name. (the output file)

  Result:
  CombineFiles() will create one large file from the pieces
 }

function CombineFiles(FileName, CombinedFileName : TFileName) : Boolean;
var
  i: integer;
  fs, sStream: TFileStream;
  filenameOrg: String;
begin
  i := 1;
  fs := TFileStream.Create(CombinedFileName, fmCreate or fmShareExclusive);
  try
    while FileExists(FileName) do
    begin
      sStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
      try
        fs.CopyFrom(sStream, 0);
      finally
        sStream.Free;
      end;
      Inc(i);
      FileName := ChangeFileExt(FileName, '.'+ FormatFloat('000', i));
    end;
  finally
    fs.Free;
  end;
end;

// Examples:

procedure TForm1.Button1Click(Sender: TObject);
begin
  SplitFile('C:\temp\FileToSplit.chm',1000000, ProgressBar1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CombineFiles('C:\temp\FileToSplit.001','H:\temp\FileToSplit.chm');
end;

================================================================


uses
  ShellApi;

function CopyDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_COPY;
    fFlags := FOF_FILESONLY;
    pFrom  := PChar(fromDir + #0);
    pTo    := PChar(toDir)
  end;
  Result := (0 = ShFileOperation(fos));
end;


function MoveDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_MOVE;
    fFlags := FOF_FILESONLY;
    pFrom  := PChar(fromDir + #0);
    pTo    := PChar(toDir)
  end;
  Result := (0 = ShFileOperation(fos));
end;

function DelDir(dir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_DELETE;
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
    pFrom  := PChar(dir + #0);
  end;
  Result := (0 = ShFileOperation(fos));
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  if cCopyDir('d:\download', 'e:\') = True then
    ShowMessage('Directory copied.');
end;

================================================================================

function waveOutGetNumDevs: UINT; stdcall; external 'winmm.dll' name
                       'waveOutGetNumDevs';

function SoundCardInstalled() : boolean;
begin
     (*
     waveOutGetNumDevs function will return a number of
     installed sound cards.
     // *)
     Result := (waveOutGetNumDevs > 0);
end;


=====================================================================================

procedure HideStartMenu();
begin
     MoveWindow(FindWindowEx(FindWindow('shelltray_wnd', nil), 0, nil, 'button'), 0, 100, 10, 10);
end;

=======================================================================================
 
procedure RemoveDeadIcons();
var
   TrayWindow : HWnd;
   WindowRect : TRect;
   SmallIconWidth : Integer;
   SmallIconHeight : Integer;
   CursorPos : TPoint;
   Row : Integer;
   Col : Integer;
begin
     // Get tray window handle and bounding rectangle
     TrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'TrayNotifyWnd', nil);
     if not GetWindowRect(TrayWindow,WindowRect) then
        Exit;

     // Get small icon metrics
     SmallIconWidth := GetSystemMetrics(SM_CXSMICON);
     SmallIconHeight := GetSystemMetrics(SM_CYSMICON);

     // Save current mouse position
     GetCursorPos(CursorPos);

     // Sweep the mouse cursor over each icon in the tray in
     // both dimensions
     with WindowRect do
     begin
          for Row := 0 to (Bottom - Top) DIV SmallIconHeight do
          begin
               for Col := 0 to (Right - Left) DIV SmallIconWidth do
               begin
                    SetCursorPos(Left + Col * SmallIconWidth, Top + Row * SmallIconHeight);
                    Sleep(0);
               end;
          end;
     end;

     // Restore mouse position
     SetCursorPos(CursorPos.X,CursorPos.Y);

     // Redraw tray window (to fix bug in multi-line tray area)
     RedrawWindow(TrayWindow, nil, 0, RDW_INVALIDATE OR RDW_ERASE OR RDW_UPDATENOW);
end;
================================================================================
// Power management procedure (shutdown,log off, screensaver, etc)

function PowerMng(Action : Integer; Force : Boolean) : boolean;
var
   rl: Cardinal;
   hToken: Cardinal;
   tkp: TOKEN_PRIVILEGES;
begin
   if (Win32Platform = VER_PLATFORM_WIN32_NT) then
    begin
         // Get access to windows privilege
         OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
         LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
         tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;;
         tkp.PrivilegeCount := 1;
         AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);

         // Shutdown Windows
         if (Action = 1) and (Force = False) then
         begin
               ExitWindowsEx(EWX_SHUTDOWN, 0);
         end
         else if (Action = 1) And (Force = True) then
         begin
              ExitWindowsEx(EWX_SHUTDOWN OR EWX_FORCE, 0);
         end;

         // Restart/Reboot Windows
         if (Action = 2) and (Force = false) then
         begin
              ExitWindowsEx(EWX_REBOOT, 0)
         end
         else if (Action = 2) and (Force = true) then
         begin
              ExitWindowsEx(EWX_REBOOT or EWX_FORCE, 0);
         end;

         // Log Off Windows
         if (Action = 3) and (Force=false) then
         begin
              ExitWindowsEx(EWX_LOGOFF, 0);
         end
         else if (Action = 3) and (Force = true) then
         begin
              ExitWindowsEx(EWX_LOGOFF or EWX_FORCE, 0);
         end;

         // Turn off monitor
         if (Action = 4) And (Force = true) then
         begin
              SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 2);
         end
         else if (Action = 4) and (Force = true) then // Turn ON monitor
         begin
              SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
         end;

         // Activating screensaver
         if (Action = 5) then
         begin
              DefWindowProc(Form1.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
         end;
    end;
end;
======================================================================
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  ShellApi,Controls, Forms, Dialogs,StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    procedure EmptyRecycleBin();
  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.EmptyRecycleBin();
begin
     // TForm1
     SHEmptyRecycleBin(self.handle,'',SHERB_NOCONFIRMATION);
end;
// ---------------------------------------------------------- //
end.

==========================================================================
بدست اوردن اطلاعات  CPU - شماره سریال cpu

(* -----------------------------------------------
   Retrieve various informations about the CPU
   like: brand id, factory speed, which instruction
   set supported etc.

   Author: Leslie Tailor
----------------------------------------------- *)

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  Tfrm_main = class(TForm)
    img_info: TImage;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure info(s1, s2: string);
  end;

var
  frm_main: Tfrm_main;
  gn_speed_y: Integer;
  gn_text_y: Integer;
const
  gn_speed_x: Integer = 8;
  gn_text_x: Integer  = 15;
  gl_start: Boolean   = True;

implementation

{$R *.DFM}

procedure Tfrm_main.FormShow(Sender: TObject);
var
  _eax, _ebx, _ecx, _edx: Longword;
  i: Integer;
  b: Byte;
  b1: Word;
  s, s1, s2, s3, s_all: string;
begin
  //Set the startup colour of the image
  img_info.Canvas.Brush.Color := clblue;
  img_info.Canvas.FillRect(rect(0, 0, img_info.Width, img_info.Height));


  gn_text_y := 5; //position of the 1st text

  asm                //asm call to the CPUID inst.
    mov eax,0         //sub. func call
    db $0F,$A2         //db $0F,$A2 = CPUID instruction
    mov _ebx,ebx
    mov _ecx,ecx
    mov _edx,edx
  end;

  for i := 0 to 3 do   //extract vendor id
  begin
    b := lo(_ebx);
    s := s + chr(b);
    b := lo(_ecx);
    s1:= s1 + chr(b);
    b := lo(_edx);
    s2:= s2 + chr(b);
    _ebx := _ebx shr 8;
    _ecx := _ecx shr 8;
    _edx := _edx shr 8;
  end;
  info('CPU', '');
  info('   - ' + 'Vendor ID: ', s + s2 + s1);

  asm
    mov eax,1
    db $0F,$A2
    mov _eax,eax
    mov _ebx,ebx
    mov _ecx,ecx
    mov _edx,edx
  end;
  //06B1
  //|0000| |0000 0000| |0000| |00| |00| |0110| |1011| |0001|
  b := lo(_eax) and 15;
  info('   - ' + 'Stepping ID: ', IntToStr(b));
  b := lo(_eax) shr 4;
  info('   - ' + 'Model Number: ', IntToHex(b, 1));
  b := hi(_eax) and 15;
  info('   - ' + 'Family Code: ', IntToStr(b));
  b := hi(_eax) shr 4;
  info('   - ' + 'Processor Type: ', IntToStr(b));
  //31.   28. 27.   24. 23.   20. 19.   16.
  //  0 0 0 0   0 0 0 0   0 0 0 0   0 0 0 0
  b := lo((_eax shr 16)) and 15;
  info('   - ' + 'Extended Model: ', IntToStr(b));

  b := lo((_eax shr 20));
  info('   - ' + 'Extended Family: ', IntToStr(b));

  b := lo(_ebx);
  info('   - ' + 'Brand ID: ', IntToStr(b));
  b := hi(_ebx);
  info('   - ' + 'Chunks: ', IntToStr(b));
  b := lo(_ebx shr 16);
  info('   - ' + 'Count: ', IntToStr(b));
  b := hi(_ebx shr 16);
  info('   - ' + 'APIC ID: ', IntToStr(b));

  //Bit 18 =? 1     //is serial number enabled?
  if (_edx and $40000) = $40000 then
    info('   - ' + 'Serial Number ', 'Enabled')
  else
    info('   - ' + 'Serial Number ', 'Disabled');

  s := IntToHex(_eax, 8);
  asm                  //determine the serial number
    mov eax,3
    db $0F,$A2
    mov _ecx,ecx
    mov _edx,edx
  end;
  s1 := IntToHex(_edx, 8);
  s2 := IntToHex(_ecx, 8);
  Insert('-', s, 5);
  Insert('-', s1, 5);
  Insert('-', s2, 5);
  info('   - ' + 'Serial Number: ', s + '-' + s1 + '-' + s2);

  asm
    mov eax,1
    db $0F,$A2
    mov _edx,edx
  end;
  info('', '');
  //Bit 23 =? 1
  if (_edx and $800000) = $800000 then
    info('MMX ', 'Supported')
  else
    info('MMX ', 'Not Supported');

  //Bit 24 =? 1
  if (_edx and $01000000) = $01000000 then
    info('FXSAVE & FXRSTOR Instructions ', 'Supported')
  else
    info('FXSAVE & FXRSTOR Instructions Not ', 'Supported');

  //Bit 25 =? 1
  if (_edx and $02000000) = $02000000 then
    info('SSE ', 'Supported')
  else
    info('SSE ', 'Not Supported');

  //Bit 26 =? 1
  if (_edx and $04000000) = $04000000 then
    info('SSE2 ', 'Supported')
  else
    info('SSE2 ', 'Not Supported');

  info('', '');

  asm     //execute the extended CPUID inst.
    mov eax,$80000000   //sub. func call
    db $0F,$A2
    mov _eax,eax
  end;

  if _eax > $80000000 then  //any other sub. funct avail. ?
  begin
    info('Extended CPUID: ', 'Supported');
    info('   - Largest Function Supported: ', IntToStr(_eax - $80000000));
    asm     //get brand ID
      mov eax,$80000002
      db $0F
      db $A2
      mov _eax,eax
      mov _ebx,ebx
      mov _ecx,ecx
      mov _edx,edx
    end;
    s  := '';
    s1 := '';
    s2 := '';
    s3 := '';
    for i := 0 to 3 do
    begin
      b := lo(_eax);
      s3:= s3 + chr(b);
      b := lo(_ebx);
      s := s + chr(b);
      b := lo(_ecx);
      s1 := s1 + chr(b);
      b := lo(_edx);
      s2 := s2 + chr(b);
      _eax := _eax shr 8;
      _ebx := _ebx shr 8;
      _ecx := _ecx shr 8;
      _edx := _edx shr 8;
    end;

    s_all := s3 + s + s1 + s2;

    asm
      mov eax,$80000003
      db $0F
      db $A2
      mov _eax,eax
      mov _ebx,ebx
      mov _ecx,ecx
    mov _edx,edx
    end;
    s  := '';
    s1 := '';
    s2 := '';
    s3 := '';
    for i := 0 to 3 do
    begin
      b := lo(_eax);
      s3 := s3 + chr(b);
      b := lo(_ebx);
      s := s + chr(b);
      b := lo(_ecx);
      s1 := s1 + chr(b);
      b := lo(_edx);
      s2 := s2 + chr(b);
      _eax := _eax shr 8;
      _ebx := _ebx shr 8;
      _ecx := _ecx shr 8;
      _edx := _edx shr 8;
    end;
    s_all := s_all + s3 + s + s1 + s2;

    asm
      mov eax,$80000004
      db $0F
      db $A2
      mov _eax,eax
      mov _ebx,ebx
      mov _ecx,ecx
      mov _edx,edx
    end;
    s  := '';
    s1 := '';
    s2 := '';
    s3 := '';
    for i := 0 to 3 do
    begin
      b  := lo(_eax);
      s3 := s3 + chr(b);
      b := lo(_ebx);
      s := s + chr(b);
      b := lo(_ecx);
      s1 := s1 + chr(b);
      b  := lo(_edx);
      s2 := s2 + chr(b);
      _eax := _eax shr 8;
      _ebx := _ebx shr 8;
      _ecx := _ecx shr 8;
      _edx := _edx shr 8;
    end;
    info('Brand String: ', '');
    if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
    info('', '   - ' + s_all + s3 + s + s1 + s2);
  end
  else
    info('   - Extended CPUID ', 'Not Supported.');
end;

procedure Tfrm_main.info(s1, s2: string);
begin
  if s1 <> '' then
  begin
    img_info.Canvas.Brush.Color := clblue;
    img_info.Canvas.Font.Color  := clyellow;
    img_info.Canvas.TextOut(gn_text_x, gn_text_y, s1);
  end;
  if s2 <> '' then
  begin
    img_info.Canvas.Brush.Color := clblue;
    img_info.Canvas.Font.Color  := clWhite;
    img_info.Canvas.TextOut(gn_text_x + img_info.Canvas.TextWidth(s1), gn_text_y, s2);
  end;
  Inc(gn_text_y, 13);
end;

end.

====================================================================

(* -----------------------------------------------

   This code will only work on recent ami bios
   computers
   The memory addresses that BIOS info is stored
   at will change according to different BIOS
   manufactures, different versions of BIOS and
   different computers.
----------------------------------------------- *)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    StaticText3: TStaticText;
    StaticText4: TStaticText;
    StaticText5: TStaticText;
    Edit1: TEdit;
    Label5: TLabel;
    StaticText6: TStaticText;
    StaticText7: TStaticText;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

// ------------------------------------------- //
function HexToInt (s: string): Integer;
const
     Hex : array ['A'..'F'] of Integer = (10,11,12,13,14,15);
var
   i : Integer;
begin
    Result := 0;
    s := UpperCase (s);

    for i := 1 to Length (s) do
    begin
         if s [i] < 'A' then
            Result := Result * 16 + Ord (s [i]) - 48
         else
             Result := Result * 16 + Hex [s [i]];
    end;
end;
// ------------------------------------------- //
procedure TForm1.Button1Click(Sender: TObject);
var
   Scan, Copyright, Info, Date : string;
   Data : Integer;
const
     BiosCopyright = $FE0CB; {Good address for AMI BIOS only}
     BiosInfo      = $FF478; {Good address for AMI BIOS only}
     BiosDate      = $FFFF5; {Good address for AMI BIOS only}
begin
    Data :=(HexToInt(Edit1.Text)); {Convert to Integer}
    Scan := (PChar(Ptr(Data)));    {Get info for inputted memory address}
    Copyright := string (PChar (Ptr (BiosCopyright)));{The same as a debug -d F000:E0CB}
    Info := string (PChar (Ptr (BiosInfo)));{The same as a debug -d F000:F478}
    Date := string (PChar (Ptr (BiosDate)));{The same as a debug -d F000:FFF5}

    label1.caption := Scan;
    label2.caption := Date;
    label3.caption := Info;
    label4.caption := Copyright;
    label5.caption := (IntToStr(Data));{Display memory address in decimal}
end;
// ------------------------------------------- //
end.

=======================================================================

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Free1,free2,Total1:Int64;

begin

  GetDiskFreeSpaceEx(pchar(ComboBox1.Text)  , free1 , total1 , @free2);
  Label1.Caption := 'Capacity : ' + IntToStr(Total1) + ' Byte     '+ floatToStr(Total1 div (1024*1024)) + ' MB';
  Label2.Caption := 'Free space : ' + IntToStr(Free1) + ' Byte     '+ floatToStr(Free1 div (1024*1024)) + ' MB';
  Label3.Caption := 'Used space : ' + IntToStr(Total1-Free1) + ' Byte     '+ floatToStr((Total1-Free1) div (1024*1024)) + ' MB';

end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i:Integer;
begin
  for i:=Ord('A') to Ord('Z') do
    begin
      if  GetDriveType(pchar(char(i)+':\'))=3  then
        ComboBox1.Items.Add(char(i)+':\');
      end;
  ComboBox1.Text:=ComboBox1.Items.Strings[0];
end;

end.

========================================================================

unit Unit_Form_Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

type
  TForm_Main = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    btnCaptureDesktop: TButton;
    cbHideProgramOnCapture: TCheckBox;
    cbCreateBMPFile: TCheckBox;
    procedure btnCaptureDesktopClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form_Main: TForm_Main;

implementation

uses Unit_Form_DrawingBoard;

{$R *.DFM}

procedure TForm_Main.btnCaptureDesktopClick(Sender: TObject);
var
  hdcWindowsDesktop : HDC;     //DC handle
  hdcTempBitmap     : HDC;
  hbmTempBitmap     : HBITMAP; //Bitmap handle
  HRes, VRes        : Integer;
  MyBitmap : TBitmap;
begin
  //Terms:
  //DC = display device context
  //HDC = a handle for a display device context

  //You can use one of the following methods to get and HDC to the windows desktop

  //Create a DC of the desktop window and get its handle
  //hdcWindowsDesktop := CreateDC('DISPLAY', nil, nil, nil);
  //  or
  //Get the HDC of the desktop window
  //hdcWindowsDesktop := GetDC(GetDesktopWindow);

  //I decided to use this one
  hdcWindowsDesktop := GetDC(GetDesktopWindow);
  //Create a DC for the bitmap that will be created
  hdcTempBitmap := CreateCompatibleDC(hdcWindowsDesktop);
  if hdcTempBitmap = NULL then ShowMessage('CreateCompatibleDC Failed');
  //Get the width and hight parameters of the windows desktop
  HRes := GetDeviceCaps(hdcWindowsDesktop, HORZRES);
  VRes := GetDeviceCaps(hdcWindowsDesktop, VERTRES);
  //Create the bitmap that will hold the windows desktop image
  hbmTempBitmap := CreateCompatibleBitmap(hdcWindowsDesktop, HRes, VRes);
  if hbmTempBitmap = 0 then ShowMessage('CreateCompatibleBitmap Failed');
  //Select the bitmap into the DC created for it
  if SelectObject(hdcTempBitmap, hbmTempBitmap) = NULL then ShowMessage('SelectObject Failed');
  //Now the bitmap can be accessed using the HDC, the HDC is used for the windows GDI functions

  if cbHideProgramOnCapture.Checked then
    begin
      Form_Main.Visible := False;
      Form_DrawingBoard.Visible := False;
      //Make sure the forms have enough time to hide or they will be caputred too!
      Application.ProcessMessages;
      Sleep(1000);
    end;

  //Copy the windows desktop image to the bitmap
  if not BitBlt(hdcTempBitmap, 0, 0, VRes, HRes, hdcWindowsDesktop, 0, 0, SRCCOPY) then
    ShowMessage('BitBlt Failed');

  if cbHideProgramOnCapture.Checked then
    begin
      Form_Main.Visible := True;
      Form_DrawingBoard.Visible := True;
    end;

  //Copy the image to the form canvas for visual feedback
  if not BitBlt(Form_DrawingBoard.Canvas.Handle, 0, 0, VRes, HRes, hdcTempBitmap, 0, 0, SRCCOPY) then
    ShowMessage('BitBlt Failed');

  if (cbCreateBMPFile.Checked) then
    begin
      MyBitmap := TBitmap.Create;
      MyBitmap.Handle := hbmTempBitmap;
      MyBitmap.SaveToFile('Test.bmp');
      MyBitmap.Free;
    end;

  //Delete the bitmap
  if not DeleteObject(hbmTempBitmap) then ShowMessage('DeleteObject Failed');
  //Delete the bitmap DC
  if not DeleteDC(hdcTempBitmap) then ShowMessage('DeleteDC Failed');
  //Release the desktop DC
  if ReleaseDC(GetDesktopWindow, hdcWindowsDesktop) <> 1 then ShowMessage('ReleaseDC Failed');
end;

end.
=====================================================================

program disable_xp_firewal;

{$APPTYPE GUI}

uses
  Windows, winsvc, shellapi;
 
procedure Close_Firewal;
var
  SCM, hService: LongWord;
  sStatus: TServiceStatus;
begin
  SCM      := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  hService := OpenService(SCM, PChar('SharedAccess'), SERVICE_ALL_ACCESS);

  ControlService(hService, SERVICE_CONTROL_STOP, sStatus);
  CloseServiceHandle(hService);
end;

begin
  Close_Firewal;
end. // end

=======================================================================

procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.SelectAll;
  Memo1.CopyToClipboard;
  Memo1.Clear;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo2.PasteFromClipboard;
end; //end

=======================================================================



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, Grids, DBGrids;

type
  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    Table1: TTable;
    DataSource1: TDataSource;
    procedure DBGrid1CellClick(Column: TColumn);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid1ColEnter(Sender: TObject);
    procedure DBGrid1ColExit(Sender: TObject);
  private

 FOriginalOptions : TDBGridOptions; { Private declarations }
  public
   procedure SaveBoolean;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SaveBoolean;
begin
 Self.DBGrid1.SelectedField.Dataset.Edit;
 Self.DBGrid1.SelectedField.AsBoolean := not Self.DBGrid1.SelectedField.AsBoolean;
 Self.DBGrid1.SelectedField.Dataset.Post;
end;

procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
 if Self.DBGrid1.SelectedField.DataType = ftBoolean then
  SaveBoolean();
end;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
Const
 CtrlState : array[Boolean] of Integer = (DFCS_BUTTONCHECK,
     DFCS_BUTTONCHECK or DFCS_CHECKED);
var
 CheckBoxRectangle : TRect;
begin
 if Column.Field.DataType = ftBoolean then
 begin
 Self.DBGrid1.Canvas.FillRect(Rect);
 CheckBoxRectangle.Left := Rect.Left + 2;
 CheckBoxRectangle.Right := Rect.Right - 2;
 CheckBoxRectangle.Top := Rect.Top + 2;
 CheckBoxRectangle.Bottom := Rect.Bottom - 2;
 DrawFrameControl(Self.DBGrid1.Canvas.Handle,
      CheckBoxRectangle,
      DFC_BUTTON,
      CtrlState[Column.Field.AsBoolean]);
 end;
end;
procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
 if Self.DBGrid1.SelectedField.DataType = ftBoolean then
 begin
  Self.FOriginalOptions := Self.DBGrid1.Options;
  Self.DBGrid1.Options := Self.DBGrid1.Options - [dgEditing];
 end;
end;

procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
 if Self.DBGrid1.SelectedField.DataType = ftBoolean then
  Self.DBGrid1.Options := Self.FOriginalOptions;
end;

end.


این هم مال فرم



object Form1: TForm1
  Left = 192
  Top = 114
  Width = 953
  Height = 778
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 0
    Top = 0
    Width = 945
    Height = 744
    Align = alClient
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
    OnCellClick = DBGrid1CellClick
    OnColEnter = DBGrid1ColEnter
    OnColExit = DBGrid1ColExit
    OnDrawColumnCell = DBGrid1DrawColumnCell
  end
  object Table1: TTable
    Active = True
    DatabaseName = 'DBDEMOS'
    TableName = 'reservat.db'
    Left = 128
    Top = 88
  end
  object DataSource1: TDataSource
    DataSet = Table1
    Left = 176
    Top = 80
  end
end



=======================================================================

MaskEdit3.Text := FormatDateTime('hh:mm', StrToTime(MaskEdit2.Text)-StrToTime(MaskEdit3.Text)); 

============================================================================


function FileInUse(FileName: string): Boolean;
var hFileRes: HFILE;
begin
  Result := False;
  if not FileExists(FileName) then exit;
  hFileRes := CreateFile(PChar(FileName),
                                    GENERIC_READ or GENERIC_WRITE,
                                    0,
                                    nil,
                                    OPEN_EXISTING,
                                    FILE_ATTRIBUTE_NORMAL,
                                    0);
  Result := (hFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(hFileRes);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
if FileInUse('c:\myfile.exe') then
ShowMessage('yes')
else
ShowMessage('no');
end

i==================================================================================

 هیچ می دونستید در دلفی می توان بدون داشتن هیچ کامپوننت یا ocx خاصی فرم ها را با افکت های مختلف نشون داد؟ 

 برای انجام این کار در رویداد OnCreate  فرمی که می خواهید با افکت باز بشه خط زیر را اضافه کنید :

  AnimateWindow(Form1.Handle, 300, AW_Center);

 

البته بهتره بدونید که فقط همین یه دونه افکت نیست ، پارامتر سوم پردازه بالا نوع افکت رو مشخص می کنه ، اگه رو اون کلید Ctrl+Space رو بزنید از لیستی که باز می شه می تونید افکت های دیگه رو انتخاب کنید . همچنین پارامتر دوم زمان طول کشیدن افکت رو بر حسب میلی ثانیه مشخص می کنه . پارامتر اول هم هندل (شماره منحصر به فردی که ویندوز به هر پنجره اختصاص می ده) فرمیه که می خواهید با افکت نشون داده بشه

=============================================
 

قبل از Type  اصلی برنامه خطوط زیر رو وارد کنید                                                             

   TMyHint=Class (ThinTWindow(

   Constructor Create (Aowner:TComponent);override;

   End;

 

با این کار ما یک کلاس جدیدی از Hint رو برای دلفی تعریف کردیم .

 

 

و حالا خطوط زیر را در زیر  Implementation بنویسید :

 

Constructor TMyhint.Create(Aowner:TComponent);

Begin

  inherited Create (Aowner);

  Canvas.Font.Name:=’Arial’;

  Canvas.Brush.Color:=ClBlue;

End;

 

و با این کار ساختار TMyHint را بوجود آوردیم ، یعنی خواستیم که فونت آن Arial  و رنگ آن آبی باشد.

 

سپس در انتها برای اینکه این ساختار در برنامه اعمال شود خطوط زیر در قسمت OnCreate فرم

 

اصلی برنامه کپی کنید :

Application.ShowHint:=False;

 HintWindowClass:=TMyhint;

Application.ShowHint:=True;

===============================================================================

اسکریپت زیر رو در رویداد OnPaint فرمتون کپی کنید:

 

Procedure TForm1.FormPaint(Sender: TObject);

Var

 Wnd:HWnd;

 R1,R2:HRGN;

 R:TRect;

Begin

  Wnd:=Application.MainForm.Handle;

  GetWindowRect(Wnd,R);

  R1:=CreateRectRgn(0,0,R.Right-R.Left,R.Bottom-R.Top);                             

  R2:=CreateEllipticRgn(10,30,150,120);

  CombineRgn(R1,R1,R2,RGN_DIFF);

  SetWindowRgn(Wnd,R1,true);

End;

=============================================================================

:: بدون هیچ نرم‌افزاری پوشه های ویندوز را رمز گذاری کنید +ترفند
:: امن‌ترین گوشی هوشمند کدام است؟
:: آموزش انتقال از یک اپراتور به اپراتور دیگر
:: اینترنت 3G همه جا
:: ردیاب ها چگونه موبایل شما را ردیابی می‌کنند؟
:: حذف اطلاعات شخصی از گوگل
:: آموزش حذف تلگرام
:: اموزش بازگشت به گروههای لفت داده شده تلگرام
:: تعویض اپراتور موبایل بدون تغییر شماره
:: نصب همزمان چند تلگرام روی کامپیوتر
:: دانلود تقویم ۱۳۹۵ هجری شمسی برای رایانه و تلفن همراه
:: رمزنگاری اندروید
:: چگونه از Bitlocker ویندوز جهت رمزگذاری استفاده کنیم؟
:: پاک کردن پیام ارسال شده در تلگرام
:: اموزش استفاده از اینترنت گوشی در کامپیوتر - لب تاپ
:: اینترنت رایگان و بدون سانسور
:: نسخه جدید تلگرام
:: وضعیت کاری در گوگل
:: 35سوال مصاحبه استخدامی شرکت گوگل
:: 15 تکنولوژی برتر نظامی که به زودی رونمایی می‌شوند
:: سرویس شگفت‌انگیز برای رصد تهدیدات سایبری در تمام دنیا
:: برترین جنگنده های جهان +قیمت
:: گوگل مدرک گرا نیست
:: پردازش ابری چیست و ریشه این عبارت از کجا آمده است؟
:: مقایسه فضای سایبری ایران در منطقه و جهان
:: تشکیلات مرکز محرمانه عملیات سایبری ایالات متحده امریکا همراه با تصاویر
:: دانلود فتوشاپ فشرد CS4 کم حجم 52مگ
:: اینترنت رایگان جهانی - اوترنت
:: direct X چیست؟
:: باز کردن پین کد PIN code فراموش شده تلفن


 
.:: ساختار كلی این قالب مربوط به تم دیز