تبليغاتX
انجمن تخصصی دلفی ایران

انجمن تخصصی دلفی ایران

کپی فايل همراه با نمايش درصد پيشرفت

procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
  
FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer;
  FileLength: longint;
begin
  
AssignFile(FromF, Source);
  reset(FromF);
  AssignFile(ToF, Destination);
  rewrite(ToF);
  FileLength := FileSize(FromF);
  with Progressbar1 
do
  begin
    
Min := 0;
    Max := FileLength;
    while FileLength > 0 
do
    begin
      
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      Position := Position + NumRead;
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  
CopyFileWithProgressBar1('c:\Windows\Welcome.exe', 'c:\temp\Welcome.exe');
end;

{ 2. }

{***************************************}

// To show the estimated time to copy a file:

procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
  
FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer;
  FileLength: longint;
  t1, t2: DWORD;
  maxi: integer;
begin
  
AssignFile(FromF, Source);
  reset(FromF);
  AssignFile(ToF, Destination);
  rewrite(ToF);
  FileLength := FileSize(FromF);
  with Progressbar1 
do
  begin
    
Min  := 0;
    Max  := FileLength;
    t1   := TimeGetTime;
    maxi := Max div 4096;
    while FileLength > 0 
do
    begin
      
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      t2  := TimeGetTime;
      Min := Min + 1;
      
// Show the time in Label1
      
label1.Caption := FormatFloat('0.00', ((t2 - t1) / min * maxi - t2 + t1) / 100);
      Application.ProcessMessages;
      Position := Position + NumRead;
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end;

{ 3. }
{***************************************}
// To show the estimated time to copy a file, using a callback function:

type
  
TCallBack = procedure(Position, Size: Longint); 
{ export; }

procedure FastFileCopy(const InFileName, OutFileName: string;
  CallBack: TCallBack);


implementation

procedure 
FastFileCopyCallBack(Position, Size: Longint);
begin
  
Form1.ProgressBar1.Max := Size;
  Form1.ProgressBar1.Position := Position;
end;

procedure FastFileCopy(const InFileName, OutFileName: string;
  CallBack: TCallBack);
const
  
BufSize = 3 * 4 * 4096; 
{ 48Kbytes gives me the best results }
type
  
PBuffer = ^TBuffer;
  TBuffer = array[1..BufSize] of Byte;
var
  
Size: DWORD;
  Buffer: PBuffer;
  infile, outfile: file;
  SizeDone, SizeFile: LongInt;
begin
  if 
(InFileName <> OutFileName) 
then
  begin
    
buffer := nil;
    Assign(infile, InFileName);
    Reset(infile, 1);
    
try
      
SizeFile := FileSize(infile);
      Assign(outfile, OutFileName);
      Rewrite(outfile, 1);
      
try
        
SizeDone := 0;
        New(Buffer);
        
repeat
          
BlockRead(infile, Buffer^, BufSize, Size);
          Inc(SizeDone, Size);
          CallBack(SizeDone, SizeFile);
          BlockWrite(outfile, Buffer^, Size)
        until Size < BufSize;
        FileSetDate(TFileRec(outfile).Handle,
        FileGetDate(TFileRec(infile).Handle));
      
finally
        if 
Buffer <> 
nil then
          
Dispose(Buffer);
        CloseFile(outfile)
      end;
    
finally
      
CloseFile(infile);
    end;
  
end
  else
    raise 
EInOutError.Create('File cannot be copied onto itself')
end
{FastFileCopy}




procedure TForm1.Button1Click(Sender: TObject);
begin
  
FastFileCopy('c:\daten.txt', 'c:\test\daten2.txt', @FastFileCopyCallBack);
end;

{ 4. }
{***************************************}


function CopyFileWithProgressBar2(TotalFileSize,
  TotalBytesTransferred,
  StreamSize,
  StreamBytesTransferred: LARGE_INTEGER;
  dwStreamNumber,
  dwCallbackReason: DWORD;
  hSourceFile,
  hDestinationFile: THandle;
  lpData: Pointer): DWORD; stdcall;
begin
  
// just set size at the beginning
  
if dwCallbackReason = CALLBACK_STREAM_SWITCH 
then
    
TProgressBar(lpData).Max := TotalFileSize.QuadPart;

  TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart;
  Application.ProcessMessages;
  Result := PROGRESS_CONTINUE;
end;

function TForm1.CopyWithProgress(sSource, sDest: string): Boolean;
begin
  
// set this FCancelled to true, if you want to cancel the copy operation
  
FCancelled := False;
  Result     := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2,
    ProgressBar1, @FCancelled, 0);
end;

end;

+ نوشته شده در  چهارشنبه بیست و یکم دی 1384ساعت 22:49  توسط مهدی فدایی  | 

فروم سایت تاسیس شد

سلام به همه ی دلفی کار های عزیز

فروم سایت هم تاسیس شد.

ورود به فروم

از همه ی دوستان خواهش میکنم در سروسامون گرفتن فروم منو یاری کنن

مرسی

+ نوشته شده در  چهارشنبه بیست و یکم دی 1384ساعت 15:0  توسط مهدی فدایی  | 

استفاده از DLL در دلفی

ایجاد یک DLL
با استفاده از منو فایل گزینه New Items را انتخاب کنید و آیتم DLL Wizard را انتخاب نمایید. حال به فایل ایجاد شده، یک فرم با استفاده از روش بالا اضافه نمایید. دقت نمایید که Application را بجای فرم انتخاب ننمایید. حال اگر فرض کنیم که نام فرم شما Demo باشد و بانام UDemo.pas آنرا ذخیره کرده باشید. باید در فایل DLL بصورت زیر کد نویسی نمایید:

library demodll;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
   SysUtils,
   Classes,
   UDemo in 'UDemo.pas' {Demo};

{$R *.res}
procedure ShowdemoForm;stdcall;
begin
   Demo :=Tdemo.Create(nil);
   demo.Show;
end;

function ShowdemoFormModal:integer;stdcall;
begin
   demo :=Tdemo.Create(nil);
   Result := demo.ShowModal;
end;

Exports
   ShowDemoForm,
   ShowdemoFormModal;
begin
end.


دقت کنید که نام DLL فوق DemoDll می باشد و با نام DemoDll.dpr ذخیره گردیده است.

حال بر روی فرم موجود تمام دکمه‌ها و آبجکت‌های مورد نظرتان را اضافه و کد نویسی کنید (اختیاری). در پایان در منو Project گذینه Build DemoDll را انتخاب کرده و اجرا نمایید. فایلی با نام DemoDll.dll ایجاد می گردد که برای استفاده آماده است.


استفاده از یک DLL بصورت دینامیکی
برای استفاده از یک DLL ‌بصورت دینامیکی، ابتدا نام توابعی را که در فایل DLL شما موجود است بصورت زیر تعریف نمایید:

unit UMain;

interface

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

type
TShowdemoFormModal= Function :integer;
.
.
.


دقت کنید که نام برنامه انتخابی پیش فرض Main و با نام UMain.pas ذخیره گشته است. حال برای لود کردن DLL یادشده، یک دکمه بر روی فرم قرارداده آنرا بصورت زیر کد نویسی کنید:

var
hndDLLHandle:THandle;
ShowdemoFormModal:TShowdemoFormModal;

procedure TFMain.Button1Click(Sender: TObject);
begin
   try
      hndDLLHandle:=LoadLibrary('Demodll.dll');

      if hndDLLHandle <> 0 then begin
         @ShowdemoFormModal:=getProcAddress(hndDLLHandle,'ShowdemoFormModal');

         if addr(ShowdemoFormModal) <> nil then begin
            ShowdemoFormModal;
         end
         else
            showmessage ('function not exists ...');
         end
      else
         showMessage('Dll Not Found!');
      finally
         freelibrary(hndDLLHandle);
      end;
end;

فرم شما آماده اجراست. در پایان متذکر می شوم که استفاده ار روش دینامیکی در لود کردن DLL ها باعث پایین آمدن سرعت نمایش فرم‌ها و در عوض بالارفتن سرعت برنامه خواهد شد.
+ نوشته شده در  سه شنبه بیستم دی 1384ساعت 8:41  توسط مهدی فدایی  | 

مدیریت حافظه در دلفی

تخصیص خودکار حافظه
وقتی شما از نوع‌های پایه (Integer ،real ،word و…) برای ایجاد متغییرهای خود استفاده می کنید، هیچ نگرانی درباره تخصیص حافظه آن وجود ندارد چون دلفی خودش آنرا تخصیص حافظه می کند و سپس آزاد میکند.

type
   TDay = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
var
   Name  : String;                          {256 Bytes}
   X, Y  : Integer;                           {4 + 4 = 8 Bytes}
   List  : array [0..10] of Double;     {8 * 11 = 88 Bytes}
   Today : TDay;                            {1 Byte}


دراین نمونه پس از پایان برنامه، تمام حافظه تخصیص داده شده فراخوانی و آزاد می شود.


تخصیص حافظه دینامیکی
در این حالت برنامه نویس احتیاج دارد تا انباره حافظه را شخصا" تخصیص و آزاد کند.

نوع Pointer
اشاره‌گرها در دلفی می‌توانند شکل‌های مختلفی را در برگیرد. نخست، نوع اشاره‌گری که یک آدرس حافظه را برای نوع ویژه‌ای از داده، همانند صحیح، رشته و غیره نگه میدارد (Typed Pointer).

var
   Number : ^Integer;
   Name   : ^String;


دوم، اشاره‌گرهای بدون نوع. اشاره‌گرهای بدون نوع (Untyped Pointers) خیلی به نوع معمولی خود شبیه هستند. اما محدودیت‌هایی مثل اینکه باید به نوع خاصی اشاره (Point) کند را ندارد.

var
   Something : Pointer;


حال اشاره‌گر بدون نوع ما می تواند به هر نوعی از داده اشاره کند. برای تخصیص حافظه آن، از کمپلکس بیش از یک بیت استفاده میکنیم. برای مثال برنامه زیر کامپایل می شود ولی در زمان اجرا حافظه‌ای تخصیص نمیشود.

begin
   New(Something);
   Dispose(Something);
end;


برای تخصیص حافظه کامپایلر باید بداند که نوع داده ما برای تخصیص حافظه چیست:

type
   IntPtr = ^Integer;

var
   Something : Pointer;
begin
   Something := New(IntPtr);
   Integer(Something^) := 10;
   Dispose(Something);
end;



تخصیص بلاکی از حافظه
ما می‌توانیم از اشاره به بلاک‌هایی از تخصیص حافظه در سیستم استفاده کنیم. این کار را با رویه‌های GetMem و FreeMem برای تخصیص و آزاد سازی حافظه استفاده میکنیم.

var
   Something : Pointer
begin
   GetMem(Something, 100);
   FreeMem(Something, 100);
end;



اشاره به حافظه از قبل تخصیص داده شده
هر دو نوع اشاره‌گرها می توانند به هر جایی از حافظه اشاره بکنند. این بدان معناست که آنها می‌توانند اشاره به فضای اشغال شده با داده‌هایی که در حال حاضر موجودند داشته باشند. این نمونه اشاره‌گر احتیاجی به تخصیص حافظه ندارد.

var
   Something : Pointer;
   MyString  : PChar;        // type PChar = ^Char;
                              
begin
   GetMem(Something, 100);
   MyString := Something;
   StrCopy(Something, 'Hello World'); 
   FreeMem(Something, 100);
end;



حافظه Heap
Heap شامل قسمتی از حافظه موجود در یک برنامه است که آنرا حافظه پویا می نامیم. Heap بخشی است که در آن تخصیص و تعریف حافظه به صورت تصادفی (Random) اتفاق می‌افتد. این به آن معناست که اگر شما سه بلاک از حافظه را به طور متوالی تخصیص دهید، می توانید بعد از هر دستور آنرا از بین ببرید. مدیر Heap جزئیات را برای شما نگهداری می کند. بنابراین شما به سادگی می توانید یک حافظه جدید را با GetMem و یا بوسیله صدا زدن constructor هنگام ساختن یک شی درخواست کنید و دلفی به شما یک بلاک جدید را برخواهد گرداند. Heap یکی از سه فضای موجود در برنامه کاربردی را استفاده کرده و دوتای دیگر به صورت فضای یکپارچه (Global) و پشته قرار می گیرند.


حافظه Stack
Stack شامل قسمتی از یک بخش از حافظه موجود یک برنامه است که دینامیکی است اما برای تخصیص و آزادسازی فرامین مخصوص دارد. تخصیص Stack به صورت LIFO می باشد. این بدان معناست که آخرین حافظه شیء شما تخصیص داه خواهد شد و سپس حذف می شود. حافظه پشته در روتین‌های نوعی استفاده می‌شود. وقتی شما یک روتین را صدا میزنید، پارامترهایش و روتین نوع آن در پشته ریخته می شود. همچنین پارامترهایی که در یک روتین تعریف میشوند، در پشته ذخیره میشوند و وقتی روتین خاتمه پیدا می کند تمام آنها به طور خودکار از بین می رود.

+ نوشته شده در  سه شنبه بیستم دی 1384ساعت 8:39  توسط مهدی فدایی  | 

آرایه ها در دلفی

دلفی به ما امکان می دهد آرایه‌هایی از هر نوع متغییری را ایجاد کنیم. برای تعریف آرایه به صورت زیر عمل میکنیم:

var
   array[indexType1, ..., indexTypen] of baseType;


در این تعریف برای نامگذاری آرایه، از قانون نامگذاری متغییرها استفاده میکنیم و مقدار اولیه را نیز درون یک جفت کروشه قرار می دهیم.

نکته: شما می توانید به جای استفاده از کروشه [] از ترکیب پرانتز نقطه استفاده کنید:

d(.i.):= 3 + i; // Equivalent d[i]:= 3 + i;


نکته: وقتی که شما یک آرایه را تعریف می کنید احتیاجی ندارید که به آن مقدار کمترین یا بیشترین بدهید:

var
   A : array [Boolean] of integer;
begin
   A[True] := 50;
   A[False] := 100;
end;


نکته: توابع Low و High کران‌های پایین وبالای یک متغییر آرایه‌ای یا نوعی یا ترتیبی را بر میگردانند:

for I := 0 to High(X) do S := S + X[I];


آرایه‌های ثابت:
آرایه های ثابت می توانند توسط ساختار ثابت نوع دلفی تعریف شود. نوع ثابت که همیشه با عبارت Const تعریف می شود، نه تنها مانع تغییر مقدار پارامتر می شود، بلکه کدهای بهینه بیشتری برای رشته‌ها و رکوردهای رد شده به توابع تولید می کند. ما هنگامی از این نوع استفاده می کنیم که نخواهیم مقدار رد شده به یک تابع تغییر کند.

type
   TDay = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);

const
   DayNames : array [TDay] of String[9] = ('Sunday', 'Monday', 'Tuesday',
                                           'Wednesday', 'Thursday', 
                                           'Friday', 'Saturday');
var
   Today : TDay;

begin
   Today := TDay(DayOfWeek(Date) - 1);
   ShowMessage('Today is ' + DayNames[Today] + '!');
end;



آرایه‌های دینامیکی:
آرایه‌های دینامیکی، آرایه‌های تحلیلی پویایی هستند که ابعاد آنها موقع کامپایل شدن شناخته شده نیست. برای اعلان آنها کافی است یک آرایه بدون بعد تعریف کنید:

var MyFlexibleArray: array of Real;


قبل از به کار گیری آرایه‌های دینامیکی، ابتدا باید از رویه SetLength برای تخصیص حافظه آرایه استفاده کرد:

SetLength (MyFlexibleArray, 2);


نکته: آرایه‌های دینامیکی همیشه مبتنی بر صفر می باشند.

نکته: شما می‌توانید آرایه‌های دینامیکی را قبل از رسیدن به ترک قلمرو از حافظه خارج کنید:

MyFlexibleArray := nil;


نکته: مقدار حافظه‌ای که در اختیار آرایه قرار میگیرد، به طول آرایه ونوع عناصر آن بستگی دارد. به عنوان مثال اگر آرایه‌ای از نوع صحیح به طول 10 داشته باشیم 4*10 بایت حافظه به آن اختصاص می‌یابد.


فشرده‌سازی آرایه‌ها:
در دلفی شما هنگامی که ساختار خود را تعیین کردید می‌توانید با استفاده از کلمه کلیدی packed اطلاعات ذخیره شده خود را متراکم کنید:

type TNumbers = packed array[1..100] of Real;


نکته: استفاده از packed سرعت دسترسی به اطلاعات را کند میکند. در مورد آرایه‌ای از کاراکترها این مورد سازگارتر می‌باشد.


آرایه‌های چند بعدی دینامیکی:
برای تعریف آرایه‌های چند بعدی دینامیکی، تنها کافی است ...array of را در ساختار خود تکرار کنید. به طور مثال:

type
   TMessageGrid = array of array of string;

var
   Msgs: TMessageGrid;


این تعریف یک آرایه دو بعدی از رشته‌ها می باشد. سپس باید به آرایه خود فضا نسبت داد:

SetLength(Msgs, I, J);



شما می‌توانید آرایه‌های چند بعدی دینامیکی خود را به صورت غیر مستطیلی (Not Rectangular) ایجاد کنید. ابتدا رویه SetLength را صدا زده و پارامتر بعد اول را بدهید:

var
   Ints: array of array of Integer;

SetLength(Ints, 10);


ما 10 سطر به آرایه خود اختصاص دادیم. از این پس، شما می توانید ستونهای خود را در هر زمان (با اندازه‌های مختلف) تخصیص دهید:

SetLength(Ints[2], 5);



 

+ نوشته شده در  سه شنبه بیستم دی 1384ساعت 8:27  توسط مهدی فدایی  | 

ساختار رکوردها در دلفی

یک ساختار تعریف شده در پاسکال موضوعی تحت عنوان record می‌باشد. رکوردها را می‌توان یک نوع داده که خود شامل چندین نوع داده دیگر است در نظر گرفت. برای تعریف رکوردها بصورت زیر عمل می‌کنیم:

type recordTypeName = record
   fieldList1: type1;
   ...
   fieldListn: typen;
end


پس از اینکه نوع رکورد ایجاد شد، باید متغییرهایی از نوع این رکورد تعریف واز آنها استفاده کرد. برای تعریف متغییر نوع رکورد به صورت زیر عمل می‌شود:

type
   TDateRec = record
   Year: Integer;
   Month: (Jan, Feb, Mar, Apr, May, Jun, 
               Jul, Aug, Sep, Oct, Nov, Dec);
   Day: 1..31;
end;

var
   Record1, Record2: TDateRec;


هنگام کار با یک رکورد برای دستیابی به میدان‌های آن، از نماد نقطه استفاده میکنیم:

Record1.Year := 1904;
Record1.Month := Jun;
Record1.Day := 16;


همچنین می‌توان یک رکورد را در یک رکورد دیگر کپی کرد بدون اینکه با خطائی مواجه شویم. شما همچنین می‌توانید متغییرهای از نوع رکوردهای خود را به صورت مستقیم تعریف کنید:

var S: record
   Name: string;
   Age: Integer;
end;



رکوردهای با طول متغییر
نوع رکورد را می‌توان طوری تعریف کرد که طول بخشی از آن ثابت و طول بخش دیگری بر اساس شرایط فیلدها متغییر باشد. در زیر یک مثال و در ادامه آن جدولی از حافظه‌ای که اشغال می‌شود آورده شده است.

type
   TPartType = (ptComputer, ptMonitor, ptComponent);
   TPart = record
      PartNumber : String[15];
      Description : String[30];
      Price : Double;

      case PartType : TPartType of
         ptComputer: (CPU : String[10]; Speed : String[10]; HardDrive : String[10]);
         ptMonitor: (VideoType : String[10]; Size : String[5]; DotPitch : String[5]);
         ptComponent: (Internal : Boolean; Specs : String[29]);
end;


این تعریف به کامپایلر می گویید که تنها یکی از متغییرهای مجموعه case را برای استفاده در هر رکوردی انتخاب کند. این یک راهکار بسیار خوب برای استفاده از حافظه می باشد؛ زیرا حافظه یکسانی برای هر مجموعه‌ای از متغییرها در نظر گرفته می‌شود.

بایت نام متغییر نام متغییر نام متغییر
0 PartNumber
15 Description
45 Price
53 PartType
54 CPU VideoType Internal
55 Specs
64 Speed Size
69 DotPitch
74 HardDrive


دسترسی به یک بایت
بعضی مواقع، هنگامیکه با یک API خارجی کار می‌کنید، احتیاج دارید که اطلاعاتی از نوع Word یا Longint را به نوع‌های دلخواه بشکنید. به عنوان مثال TMSF را بصورت زیر در نظر بگیرید:

Most Significant Byte Least Significant Byte
Unused Frames Seconds Minute

ساختار TMSFRec رو بصورت زیر تعریف می‌کنیم:

type
   TMSFRec = record
      Minutes : Byte;
      Seconds : Byte;
      Frames : Byte;
      Dummy : Byte;
end;

در این حالت ما می‌توانیم به راحتی به هر یک از بایت‌های نوع Longint دسترسی داشته باشیم:

begin
   MinuteLbl.Caption := IntToStr(TMSFRec(Position).Minutes);
   SecondLbl.Caption := IntToStr(TMSFRec(Position).Seconds);
   FrameLbl.Caption := IntToStr(TMSFRec(Position).Frames);
end;

در مثال قبل، Position متغییری از نوع Longint می‌باشد.

+ نوشته شده در  سه شنبه بیستم دی 1384ساعت 8:26  توسط مهدی فدایی  | 

به دست آوردن شماره سریال مادر برد

با سلام
حتما بعضی اوقات شده که شما بخواهید برای برنامه هاتون یک قفل نرم افزاری طراحی کنید تا از کپی شدن آن جلوگیری کنید و یا هر محدودیت دیگری که می خواهید روی آن قرار دهید. یکی از راه حلهای آن اینست که از شماره هایی که در کامپیوتر کاربر تغییر نمیکنند استفاده کنید مثل شماره سریال مادربرد.
حال در جواب من باید عرض کنم که مادر برد ها بنا به نوع ساخت و مدلهای متفاوت و مارکهای گوناگون شماره سریال خاصی ندارند!!!!!!!!
یعنی شما نمی توانید شماره سریال مادر برد را در اختیار داشته باشید.
ولی نگران نباشید یک راه حل دیگری هم هست هر مادربردی دارای یک چیپ هست به نام BIOS (Basic Input/Output System) که همه آنها دارای یک استاندارد خاصی هستند و در همه مادر بردها یکسان هستند و جالب اینکه یک شماره سریال هم دارند که منحصر بفرد هست.
تا اونجایی که من میدونم معمولا این اطلاعات در 8kb اول حافظه BIOS قرار دارد حالا با کد زیر می تونید 256kb اول رو بخونید و تبدیل به Text کنید و از اون استفاده کنید.

function GetBiosInfoAsText: string;
var
p, q: pchar;
begin
q := nil;
p := PChar(Ptr($FE000));
repeat
if q <> nil then begin
if not (p^ in [#10, #13, #32..#126, #169, #184]) then begin
if (p^ = #0) and (p - q >= 8) then begin
Result := Result + TrimRight(String(q)) + #13#10;
end;
q := nil;
end;
end else
if p^ in [#33..#126, #169, #184] then
q := p;
inc(p);
until p > PChar(Ptr($FFFFF));
Result := TrimRight(Result);
end;

+ نوشته شده در  یکشنبه چهارم دی 1384ساعت 8:32  توسط مهدی فدایی  | 

فایل های 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 کیلو بایتی را ندارید.

+ نوشته شده در  یکشنبه چهارم دی 1384ساعت 8:17  توسط مهدی فدایی  | 

مثال برای GDI

با سلام.

 

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

 

در مقاله قبل مختصری راجع به GDI در دلفی صحبت شد. قبل از اینکه GDI را در سطح پیشرفته آن دنبال کنیم، در این مقاله برای درک بهتر GDI ، دو مثال در این زمینه عنوان میکنم.

 

مثال اول: ایجاد گرادینت (Gradient) روی فرم

 

یک پروژه جدید ایجاد نمایید و رویداد OnPaint فرم برنامه را بصورت زیر بنویسید:

 

procedure TForm1.FormPaint
            (Sender: TObject);
var
   Row, Ht: Word ;
begin
   Ht := (ClientHeight + 255) div 256 ;
   for Row := 0 to 255 do
      with Canvas do begin
         Brush.Color := RGB(0, 0, Row) ;
         FillRect(Rect(0, Row * Ht,
              ClientWidth, (Row + 1) * Ht)) ;
      end ;
end;

 

 

مثال دوم: ایجاد یک جورچین از تصویر صفحه نمایش

 

برای شروع یک پروژه جدید ایجاد نمایید سپس یک کامپوننت Image روی فرم قرار دهیم. این کامپوننت را میتوانید در برگ نشان Additional از پنل کامپوننتها پیدا کنید. حالا نوبت به تعریف متغییرها و آبجکتهای مورد نیاز است. در قسمت Var بالای implementation ، بصورت زیر متغییر ها را تعریف میکنیم:

 

Var

  ...

  DesktopPic:TBitmap;

  OrginalPic:TBitmap;

  WidthPic:Integer;

  HeightPic:Integer;

  BlackRect:TRect;

 

Implementation

...

 

            رویداد OnCreate را برای فرم بصورت زیر بنویسید:

 

procedure TForm1.FormCreate
          (Sender: TObject);

var i,j:Integer;

    XC,YC:Integer;

    RandomInt:Integer;

    ORect,PRect:TRect;

    TempPic:TBitmap;

begin

  Form1.BorderStyle := bsNone;

  Form1.Width := Screen.Width;

  Form1.Height := Screen.Height;

  Form1.Position := poScreenCenter;

  Form1.FormStyle := fsStayOnTop;

  Image1.Align := alClient;

  DesktopPic := TBitmap.Create;

  with DesktopPic do begin

    Width := Screen.Width;

    Height := Screen.Height;

  end;

  BitBlt(DesktopPic.Canvas.Handle,0,0,
         Screen.Width,Screen.Height,
         GetDC(0),0,0,SRCCOPY);

  image1.Picture.Bitmap:=DesktopPic ;

  WidthPic := Screen.Width div 8 ;

  HeightPic := Screen.Height div 8 ;

  for i:=0 to 8 do begin

    Image1.Canvas.MoveTo
           (i*WidthPic,0);

    image1.Canvas.LineTo
           (i*WidthPic,Screen.Height);

  end;

  for j:=0 to 8 do begin

    Image1.Canvas.MoveTo
           (0,j*HeightPic);

    Image1.Canvas.LineTo
           (Screen.Width,j*HeightPic);

  end;

  Randomize;

  TempPic:=TBitmap.Create;

  TempPic.Width := WidthPic;

  TempPic.Height := HeightPic;

  for i:=1 to 2000 do begin

    XC := Random(8);

    YC := Random(8);

    ORect := Rect(XC*WidthPic,YC*HeightPic,
            (XC+1)*WidthPic,(YC+1)*HeightPic);

    BitBlt(TempPic.Canvas.Handle,0,0,
           WidthPic,HeightPic,
           Image1.Canvas.Handle,
           XC*WidthPic,YC*HeightPic,
           SRCCOPY);

    RandomInt:=Random(4);

    case RandomInt of

    0: begin  //change with top

      PRect := Rect(XC*WidthPic,
                   (YC-1)*HeightPic,

                   (XC+1)*WidthPic,
                   YC*HeightPic);

      Image1.Canvas.CopyRect
             (ORect,Image1.Canvas,PRect);

      Image1.Canvas.Draw

          (PRect.Left,PRect.Top,TempPic) end;

    1: begin  //change with left

      PRect := Rect((XC-1)*WidthPic,
               YC*HeightPic,

               XC*WidthPic,
               (YC+1)*HeightPic);

      Image1.Canvas.CopyRect
             (ORect,Image1.Canvas,PRect);

      Image1.Canvas.Draw
          (PRect.Left,PRect.Top,TempPic) end;

    2: begin  //change with right

      PRect := Rect((XC+1)*WidthPic,
               YC*HeightPic,

               (XC+2)*WidthPic,
               (YC+1)*HeightPic);

      Image1.Canvas.CopyRect
             (ORect,Image1.Canvas,PRect);

      Image1.Canvas.Draw
          (PRect.Left,PRect.Top,TempPic) end;

    3: begin  //change with bottom

      PRect := Rect(XC*WidthPic,
               (YC+1)*HeightPic,

               (XC+1)*WidthPic,
               (YC+2)*HeightPic);

      Image1.Canvas.CopyRect
             (ORect,Image1.Canvas,PRect);

      Image1.Canvas.Draw
          (PRect.Left,PRect.Top,TempPic) end;

    end;  // end of case

  end; // end of for

  TempPic.Free;

  XC := Random(8);

  YC := Random(8);

  BlackRect := Rect(XC*WidthPic,
                  YC*HeightPic,

                  (XC+1)*WidthPic,
                  (YC+1)*HeightPic);

  Image1.Canvas.Brush.Color:=clBlack;

  Image1.Canvas.Brush.Style:=bsSolid;

  Image1.Canvas.FillRect(BlackRect);

end;

 

            اکنون رویداد OnClick آبجکت Image1 را بصورت زیر مینویسیم:

 

procedure TForm1.Image1Click
          (Sender: TObject);

var ClickPonit:TPoint;

    XC,YC:Integer;

    ORect,PRect:TRect;

    TempPic:TBitmap;

begin

  ClickPonit.X:=0;

  ClickPonit.Y:=0;

  GetCursorPos(ClickPonit);

  XC := (ClickPonit.X) div WidthPic;

  YC := (ClickPonit.Y) div HeightPic;

  ORect := Rect(XC*WidthPic,
                YC*HeightPic,

                (XC+1)*WidthPic,
                (YC+1)*HeightPic);

  TempPic:=TBitmap.Create;

  TempPic.Width := WidthPic;

  TempPic.Height := HeightPic;

  BitBlt(TempPic.Canvas.Handle,0,0,
         WidthPic,HeightPic,

         Image1.Canvas.Handle,
         XC*WidthPic,YC*HeightPic,
         SRCCOPY);

    // left of BlackRect

  if

   (ClickPonit.X>BlackRect.Left-WidthPic)

  and

   (ClickPonit.X

  then begin

    if

     (ClickPonit.Y > BlackRect.Top)

    and
     (ClickPonit.Y < BlackRect.Bottom)

    then begin

      PRect := Rect((XC+1)*WidthPic,
                    YC*HeightPic,

                    (XC+2)*WidthPic,
                    (YC+1)*HeightPic);

      Image1.Canvas.CopyRect
                    (ORect,
                    Image1.Canvas,
                    PRect);

      Image1.Canvas.Draw
                    (PRect.Left,
                    PRect.Top,
                    TempPic);

      BlackRect:=ORect;

    end;

  end;

    // Right of BlackRect

  if
   (ClickPonit.X>BlackRect.Right)

  and
   (ClickPonit.X  then

    if

     (ClickPonit.Y > BlackRect.Top)

    And

     (ClickPonit.Y < BlackRect.Bottom)
    then begin

            PRect := Rect
                    ((XC-1)*WidthPic,
                    YC*HeightPic,

                    XC*WidthPic,
                    (YC+1)*HeightPic);

      Image1.Canvas.CopyRect
                    (ORect,
                    Image1.Canvas,
                    PRect);

      Image1.Canvas.Draw(PRect.Left,
                         PRect.Top,
                         TempPic);

      BlackRect:=ORect;

    end;

    // Top of Blackrect

  if

   (ClickPonit.X>BlackRect.Left)

  and
   (ClickPonit.X  then

    if

     (ClickPonit.Y>BlackRect.Top-HeightPic)

    and

     (ClickPonit.Y    then begin

            PRect := Rect(XC*WidthPic,
                     (YC+1)*HeightPic,

                     (XC+1)*WidthPic,
                     (YC+2)*HeightPic);

      Image1.Canvas.CopyRect
                    (ORect,
                    Image1.Canvas,
                    PRect);

      Image1.Canvas.Draw
                   (PRect.Left,

                   PRect.Top,

                   TempPic);

      BlackRect:=ORect;

    end;

    // Bottom of BlackRect

  if
   (ClickPonit.X>BlackRect.Left)

  and

   (ClickPonit.X  then

    if
    (ClickPonit.Y>BlackRect.Bottom)

     and
 
 (ClickPonit.Y     then begin

            PRect := Rect(XC*WidthPic,
                     (YC-1)*HeightPic,

                     (XC+1)*WidthPic,
                     YC*HeightPic);

      Image1.Canvas.CopyRect
                    (ORect,
                    Image1.Canvas,
                    PRect);

      Image1.Canvas.Draw
            (PRect.Left,
            PRect.Top,
            TempPic);

      BlackRect:=ORect;

    end;

  TempPic.Free;

end;

 

در انتها لازم است آبجکتهای ایجاد شده در زمان اجرا را آزاد کنیم. پس در رویداد OnClose فرم به این صورت کدنویسی میکنیم.

 

procedure TForm1.FormClose

     (Sender: TObject; var Action: TCloseAction);

begin

  DesktopPic.Free;

  OrginalPic.Free;

end;

 

حالا میتوانبد برنامه را اجرا نمایید. بدلیل اینکه فرم بدون نوار عنوان است برای بستن فرم از کلیدهای Alt + F4 استفاده کنید. پس از اجرای برنامه میبینید تصویر صفحه نمایش به  64 قسمت در هم ریخته تبدیل میشود. یکی از قسمتها فاقد تصویر بوده و شما با کلیک کردن روی 4 قسمت چسبیده به آن (بالا، پایین، چپ، راست) میتوانید جای تصاویر را عوض کنید. چون برنامه فوق را با عجله زیاد نوشتم، رفع نقایص و خطاهای احتمالی را به عهده شما میگذارم.

+ نوشته شده در  یکشنبه چهارم دی 1384ساعت 8:14  توسط مهدی فدایی  | 

GDI در دلفی

GDI مخفف کلمه Graphics Device Interface و تکنیک رسم گرافیک دو بعدی ویندوز است. این روش متاسفانه روش بسیار کندی برای ترسم گرافیکی میباشد ولی بدلیل اینکه اساس برنامه نویسی گرافیک است یاد گیری آن بعنوان پایه برنامه نویسی گرافیک برای برنامه نویسان لازم به نظر میرسد. اولین نکته قابل توجه در این رابطه این است که نباید سعی کنید از GDI برای ایجاد هر جلوه خیالی گرافیکی استفاده کنید بدلیل اینکه GDI یک تکنیک ابتدایی در گرافیک است . برای استفاده حرفه ای از گرافیک سعی کنید از DirectX , OpenGL و ... بهره بگیرید. اگرچه شما با کمی خلاقیت قادر ید جلوه های ساده را با GDI ایجاد کنید . 

   یکی از کلمات عمومی که در GDI زیاد با آن برخورد خواهید کرد DC (Device Context ) است که نشان دهنده همان ناحیه ای است که ترسیم روی آن صورت میگیرد و در دلفی با TCanvas نشان داده میشود . در واقع DC  محل نشان دادن خروجی توابع گرافیکی است . بنابرین شما میتوانید از برخی توابع ترسیم برای ترسیم در صفحه نمایش یا پرینتر استفاده کنید . نکته دیگری که باید مورد توجه قرار بگیرد این است که توابعی که شما از آن استفاده میکنید توابع گرافیکی استاندارد دلفی بوده و پوششی برای توابع گرافیکی ویندوز است و دلفی آنها را برای ایجاد یک رابط کاربر خوب و مناسب آماده کرده است. در ابتدا برای آشنایی با سازماندهی GDI با معرفی بعضی از کلاسهای مهم GDI شروع میکنیم :

Pen   : برای رسم خطوط ساده ( مثال آن تابع LineTo است.) و ایجاد کادر برای اشکال دیگر استفاده میشود .

Brush : برای پر کردن یک محیط بسته با رنگ استفاده میشود .  مثال آن توابع,  FillRect   FloodFill. است .

Font : برای تعیین فونت و اندازه فونت در هر متنی که در ترسیم آن را مینویسید استفاده میشود .

Region : یک ناحیه بسته از فضای ویندوز که میتواند یه بیضی ، چهار ضلعی یا یه دوازه وجهی یا هر چیز دیگری باشد .

خوب ، حالا باید شروع به ترسیم کنیم . ابتدا با خطوط و اشکال ساده شروع میکنیم و بعد به سراغ توابع مورد استفاده در ترسیم Bitmap ها میرویم و در آخر راجع به تکنیکهای ترسیم در صفحه نمایش صحبت میکنیم . قبل از هر چیز باید بدانید که مختصات (0و0) نقطه بالا ، سمت چپ است . اگر یک تجسم ریاضی از مختصات داشته باشید ممکن است کمی گیج شوید . فراموش نکنید که در اینجا Y در بالاترین نقطه صفر و به سمت پایین صفحه نمایش مثبت و X در منتهی الیه سمت چپ صفر و به سمت راست صفحه نمایش مثبت است . در واقع مختصات اینجا بصورت (ارتفاع از بالا ، فاصله از چپ) میباشد. مثلا (0,50) یک نقطه در سمت چپ و 50 پیکسل پایین تر از بالای صفحه نمایش است.

خطوط و اشکال

رسم خطوط و اشکال خیلی ساده است. چیزی مهمی که اینجا باید بخاطر داشته باشید تفاوت میان Pen و Brush است. بطور ساده از Pen برای رسم خطوط استفاده میشود اگرچه ممکن است این خطوط یک چهار گوش را تشکیل دهد. ولیBrush   درون یک ناحیه ی بسته است که بوسیله خطوط بوجود آمده است. دو تابع برای رسم خطوط وجود دارد که هر دو از متعلقات TCanvas هستند .

MoveTo : با استفاده از این تابع موقعیت قلم را جابجا میکنیم . مثال :

Canvas.MoveTo(75,200);

LineTo : با استفاده از این تابع، از موقعیت فعلی قلم به یک نقطه خاص، خط رسم میکنیم . مثال:

Canvas.LineTo(50,150);

            شما میتوانید بجای استفاده از MoveTo موقعیت قلم را بوسیله تابع PenPos هم تغییر بدهید . برای مثال:

Canvas.PenPos.X:=150;
Canvas.PenPos.Y:=100;

یا

            Canvas.PenPos:=Point(150,100);

            به یاد داشته باشید که موقعیت پیش فرض قلم موقعیت (0,0) میباشد. اگر لازم است خط شما از نقطه دیگه ای شروع شود قبل از استفاده از LineTo باید موقعیت قلم را اصلاح کنید . بعد از استفاده از LineTo موقعیت قلم همان نقطه ای است که خط به آن کشیده شده مثلا بعد از اجرای Canvas.LineTo(100;200); موقعیت قلم نقطه (100,200) خواهد بود. خطوط رسم شده بوسیله Pen (TPen) در Canvas ایجاد میشود . شما براحتی میتوانید پارامترهای قلم را همانطور که میخواهید تغییر بدهید. مثلا برای تغییر اندازه قلم Canvas.Pen.Width:=4; و برای تغییر رنگ Canvas.Pen.Color:=clBlack; عمل کنید. یک مثال ساده را ببینیم . یک پروژه جدید ایجاد کنید و یک عدد Button روی آن قرار دهید و کد رویداد کلیک Button را بصورت زیر بنویسید.

 

procedure TForm1.Button1Click(Sender: TObject);

const NUM_LINES = 2000;

var i:integer;

begin

  Randomize;

  for i := 0 to NUM_LINES - 1 do

  begin

    Canvas.Pen.Color :=

        RGB(Random(256),Random(256),Random(256));

    Canvas.LineTo

        (Random(ClientWidth),Random(ClientHeight));

  end;

end;

 

 

در مثال بالا، 2000 خط با جهت های تصادفی و با رنگهای تصادفی فرم را پر میکند . تابع RGB   برای ایجاد رنگ با تعیین مقادیر قرمز، سبز و آبی مورد استفاده قرار میگیرد. RGB(Red,Green,Blue) . این مقادیر میتواند مابین 0 تا 255 باشد . این تابع به شما مقداری از نوع TColor بر میگرداند . در این مرحله به سراغ رسم اشکال میرویم. تابع رسم اشکال زیادی در TCanvas وجود دارند که براحتی قابل استفاده هستند.  چند مورد از پر استفاده ترین آنها به قرار زیرند:

Ellipse : برای رسم بیضی . مثال : Canvas.Ellipse(0,0,100,50); (پارامتر ها به ترتیب : X سمت چپ بیضی ، X سمت راست بیضی ، Y بالای بیضیی ، Y پایین بیضی).

FillRect : پر کردن یک چهارگوش با Brush Color  ولی بدون خط دور آن . مثال : Canvas.FillRect(Bounds(0,0,150,200));

FloodFill : پر کردن یک ناحیه یا Brush Color  با ایجاد خطوط لبه مثال : Canvas.FloodFill(10,10,clBlue,fsBorder);

Rectangle : رسم چهارگوش و پرکردن آن با Brosh Color  و  خطوط لبه آن با Pen Color . مثال : Canvas.Rectangle( Bounds(20, 20, 50, 50));

RoundRect : ایجاد چهارگوش با گوشه های منحنی. مثال : Canvas.RoundRect(20, 20, 50, 50, 3, 3);

(تابع Bounds یک مقدار TRect برمیگرداند. TRect چهار مقدار top, left, bottom, right را نگه میدارد. بجای این تابع میتوانید از Rect هم استفاده کنید که تفاوت چندانی با هم ندارند ) .

یک تابع مفید دیگر هم وجود دارد که برای ایجاد متن به کار میرود . این تابع به شما اجازه میدهد که متن مورد نظر خود را با فونت تعیین شده (Canvas font) ایجاد کنید . مثال :

Canvas.TextOut(20,50,'GDI in Delphi');

شما میتوانید نوع قلم ، رنگ و اندازه قلم را به دلخواه خود تغییر دهید. مثال :

Canvas.Font.Name := 'Verdana';
Canvas.Font.Size := 24;
Canvas.Font.Color := clRed;

در زیر یک مثال را میبینیم که 200 شکل را بصورت تصادفی روی فرم رسم میکند .

 

 


procedure TForm1. Button1Click(Sender: TObject);;

const

  NUM_SHAPES = 200;

var

  i,ShapeLeft,ShapeTop: Integer;

begin

  for i := 0 to NUM_SHAPES - 1 do

  begin

    Canvas.Brush.Color :=

        RGB(Random(256),Random(256),Random(256));

    ShapeLeft := Random(ClientWidth);

    ShapeTop := Random(ClientHeight);

    case Random(3) of

      0: Canvas.Rectangle(ShapeLeft,

                          ShapeTop,

                          ShapeLeft + Random(50),

                          ShapeTop + Random(50));

      1: Canvas.Ellipse(ShapeLeft,

                        ShapeTop,

                        ShapeLeft + Random(50),

                        ShapeTop + Random(50));

      2: begin

           Canvas.Font.Size := 10 + Random(7);

           Canvas.TextOut ( ShapeLeft, ShapeTop, 'Delphi');

         end;

    end;

  end;

end;

                در مثال بالا وقتی برنامه را اجرا میکنید فرم برنامه در حال اجرا را کمینه (Minimize) کنید و دوباره آنرا به حالت اول برگردانید . میبینید که خطوط پاک شدند . اصلا نگران نباشید. ناپدید شدن اشکالی که شما رسم کردید یکی از امتیازات مهم GDI است و برمیگردد به تفاوت بین Drawing و  Panting.

Drawing: Drawing بهمان صورتی است که در مثال قبل مشاهده فرمودید. گرافیک ایجاد شده بوسیله آن تا وقتی وجود دارد که پنجره Refresh نشده باشد.

            Painting: هر گاه یک پنجره نیاز به Refresh شدن دارد ویندوز یک پیام به پنجره مورد نظر ارسال میکند. این پیام میتواند Handle رویداد OnPaint فرم باشد . پس وقتی شما گرافیک مورد نظر خود را در رویداد OnPaint تعریف کنید جلوه ایجاد شده در هنگام Refresh ناپدید نمیشود. این تفاوت اساسی بین این دو است. Drawing فقط یک رویداد موقتی است در صورتی که Painting هر گاه پنجره احتیاج به Refresh داشته باشد فرا خونده میشود.

            بطور کلی اگه خواسته باشیم در صفحه بوسیله Drawing ترسم را انجام دهیم در حالیکه این تغییرات موقتی ایجاد شده به نحوی ذخیره شوند چند راه وجود دارد. یک را استفاده از Bitmap است به این صورت که میتوانیم یک Bitmap ایجاد کنیم و این تغییرات را همزمان با صفحه نمایش در Bitmap هم اعمال کنیم و بعد در زمان لازم این Bitmap را در صفحه نمایش، نمایش بدهیم.   

            استفاده از Handle ها

اگر چه هنگام استفاده از دلفی شما میتوانید بدون نگرانی از توابع گرافیکی دلفی استفاده کنید با این حال دسترسی شما به API ویندوز، بصورت مستقیم هم به هیچ وجه محدود نشده است. اما برای استفاده از توابع API ویندوز، این توابع از شما HDC میخواهند. اما میدانید HDC چیست؟

شاید بدانید که برای هر چیزی در ویندوز یک Handle (دستگیره) در نظر گرفته میشود. این Handle  ها برای شناسایی آبجکت ها استفاده میشوند. تمام پنجره ها، کلید ها، منو ها و... داری دستگیره هستند. پس نباید تعجب کنید اگه بفهمید که تمام آبجکت های شما این دستگیره را بصورت یک خصوصیت در خود دارند. مثلا:

Form1.Canvas.Handle

توضیح دستگیره ها در Win32.hlp دلفی به این صورت است:

"An application must obtain an object handle and use this handle to examine or modify the system resource (or both). In the Microsoft® Win32® application programming interface (API), handles are usually implemented as indirect pointers, but this is not always the case."

HDC ها یک نوع دستگیره هستند که مشخص کننده بخشی از فضای زمینه (Device Context) می باشند. همانطور که گفته شد TCanvas بیشترین توابع DC (فضای زمینه) را دارد. کافیست دستگیره  TCanvas آبجکت مورد نظر را در توابع API ویندوز استفاده کنید.

Abject .Canvas.Handle

در اینجا برخی از توابع API که معادل VCL آنها گفته شد را ببینید.

 VCL

WINDOWS API

Canvas.TextOut(x,y,myString);

TextOut(Canvas.Handle, x, y, PChar(myString), Length(String));

Canvas.FloodFill(X, Y, Color,fsBorder);

ExtFloodFill(Canvas.Handle, x, y, YourColour, FLOODFILLBORDER);

Canvas.LineTo(x,y);

LineTo(Canvas.Handle, x, y);

Canvas.MoveTo(x,y);

MoveToEx(Canvas.Handle, x, y, nil);

 

بطور کلی توابع بهمان صورت قابل استفاده هستند با این تفاوت که اول باید Handle را پاس کنید. بخاطر داشته باشید که شما میتوانید دستگیره ها متفاوت برای Drawing در محلهای مختلف استفاده کنید. مثلا از Bitmap1.Canvas.Handle برای یک Bitmap و از Form1.Canvas.Handle  برای فرم.

دقت داشته باشید که برای استفاده از داده رشته ای در این توابع، داده مورد نظر باید از نوع PChar باشد. (مثلا تابع TextOut()). گاهی ممکن است شما مجبور باشید طول رشته را نیز در تابع وارد کنید که در این صورت کافیست از تابع Length استفاده کنید.

Bitmap چیست؟

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

آبجکتی که معمولا برای رسم تصاویر استفاده میشود Bitmap است. Bitmap یک آبجکت گرافیکی است که دارای دو قسمت میباشد 1- هدری شامل اطلاعات مهمی درباره تصویر است (شامل طول، ارتفاع، اطلاعات رنگ و...) 2- بخشی که شامل داده های خود تصویر است (شامل یک آرایه بزرگ ار رنگ هر پیکسل). خوشبختانه شما نباید برای استفاده از Bitmap هیچ نگرانی داشته باشید بدلیل اینکه کلاس Bitmap از قبل در دلفی وجود داشته که TBitmap نامیده میشود. Bitmap ها خارق العاده هستند، آنها به ما آزادی عمل خیلی زیادی نسبت به خطوط و اشکال میدهند. شما حتی میتوانید Bitmap ها را بوسیله برنامه مورد نظرتان ایجاد نمایید و در برنامه خودتان از آنها استفاده نمایید. لازم است اول یک مثال از استفاده از Bitmap ها ببینیم.

procedure Form1.DrawBitmap(const Filename: String; const x,y: Integer);

var

  Bmp: TBitmap;

begin

  if not FileExists(Filename) then

  begin

    ShowMessage('The bitmap ' + Filename + ' was not found!');

    Exit;

  end;

  Bmp := TBitmap.Create;

  try

    Bmp.LoadFromFile(Filename);

    Canvas.Draw(x, y, Bmp);

  finally

    Bmp.Free;

  end;
end;

این تابع سعی در نمایش دادن تصویر Filename روی فرم در موقعیت (x,y) دارد. اگر شما قصد ندارید آبجکت های مورد نظر را در زمان راه اندازی (Run-Time) ایجاد کنید من شدیدا استفاده از اشاره گرها را توصیه میکنم. بهر حال در بالای رویه، Bitmap را ایجاد کنید و تصویر مورد نظر را در آن لود نمایید. استفاده از بلوک Try … Finally هم شما را از عدم ایجاد خطا مطمئن مینمایید حتی در صورت وجود فایل با فرمت نا معتبر. روش استفاده شده در مثال بالا همیشه موثر نیست. این روش ابتدا وجود فایل را چک میکند سپس Bitmap را ایجاد کرده و پس از استفاده آزاد میکند. یک روش بهتر برای استفاده و نمایش تصویر، ایجاد Bitmap و لود کردن تصویر در FormCreate و آزاد کردن آن در FormDestory است. این روش موثر تر است و در سراسر عمل قابل دسترسی است.

توابع رسم در GDI

TCanvas توابع رسم زیادی دارد که همه آنها با TGraphic سر و کار دارند. TGraphic کلاس پایه آبجکت های گرافیکی در دلفی است. برخی از مثال های آن عبارتند از: TBitmap برای Bitmap ها، Ticon برای icon ها، TMetafile برای Metafile ها و TJPEGImage برای JPEG ها. در زیر لیست سایر تابع رسم در GDI را میبینید.(تمام این توابع متدهای Tcanvas هستند.)

نام

توضیح

مثال

Draw

رسم تصویر در نقطه مورد نظر.

 

    Canvas.Draw(5,10,MyGraphic);

StrechDraw

رسم تصویر در محدوده مورد نظر با ایجاد وضعیت ارتجاعی.

 

   Canvas.StretchDraw( Bounds(0,0,32,32), MyGraphic);

CopyRect

کپی کردن بخشی از یک Tcanvas به دیگری و ایجاد حالت ارتجاعی در صورت لزوم

   Canvas.CopyRect( Bounds(0,0,32,32), MyBmp.Canvas, Bounds(0, 0, 640, 480));

همه این توابع راحت و آسان هستند اگرچه تابعی که در زیر با آن آشنا میشوید کمی مشکل تر است و نیاز به دقت بیشتری دارد. این تابع BitBlt است.

 

function BitBlt(

  hdcDest: HDC;     // handle to destination device context

  nXDest,           // x-coordinate of destination rectangle's upper-left corner

  nYDest,           // y-coordinate of destination rectangle's upper-left corner

  nWidth,           // width of destination rectangle

  nHeight: Integer; // height of destination rectangle

  hdcSrc: HDC;      // handle to source device context

  nXSrc,            // x-coordinate of source rectangle's upper-left corner

  nYSrc: Integer;   // y-coordinate of source rectangle's upper-left corner

  dwRop: DWORD      // raster operation code
): Boolean;

همانطور که میبینید این تابع برای ترسیم تصویر یک DC در محدوده یک DC دیگر است. درک این تابع کمی مشکل به نظر میرسد ولی با وجود Canvas.Draw شما احتمالا نیازی به استفاده از این تابع پیدا نخواهید کرد. برای درک بهتر این تابع به مثال زیر توجه فرمایید.

 

procedure TForm1.Button1Click(Sender: TObject);
var MyBitmap:TBitmap;
begin
  MyBitmap:=TBitmap.Create;
  MyBitmap.Width:=Screen.Width;
  MyBitmap.Height:=screen.Height;   
  BitBlt(MyBitmap.canvas.handle, 0, 0, MyBitmap.width, MyBitmap.height, GetDC(0),0,0,Srccopy);
  image1.Picture.Bitmap:= MyBitmap;
  MyBitmap.Free;
end;

 

      در مثال بالا برنامه بوسیله این تابع از صفحه نمایش عکس گرفته و در Image1 نمایش داده میشود. از تابع GetDC برای بدست آوردن دستگیره فضای زمینه یک ناحیه که Handle آن را داریم استفاده میکنیم. در این مثال برای اشاره به تمامی صفحه نمایش مقدار صفر را در تابع GetDC قرار میدهیم.

            تا اینجا فرض بر این بود که شما Bitmap را در زمان راه اندازی ترسیم میکنید. اما راه بهتر در این موارد استفاده از TImage و تنظیم کردن خاصیت Picture آن در زمان طراحی، برای نمایش تصویر از زمان راه اندازی است. این روش گذشته از دقت در محل روی فرم، حرکت دادن تصویر روی فرم را در زمان اجرا آسانتر میکند.

+ نوشته شده در  یکشنبه چهارم دی 1384ساعت 8:4  توسط مهدی فدایی  | 

قرار دادن يك Bitmap در يك متافايل

procedure TForm1.Button1Click(Sender: TObject);
var
  m : TmetaFile;
  mc : TmetaFileCanvas;
  b : tbitmap;
begin
  m := TMetaFile.Create;
  b := TBitmap.create;
  b.LoadFromFile('C:\SomePath\SomeBitmap.BMP');
  m.Height := b.Height;
  m.Width := b.Width;
  mc := TMetafileCanvas.Create(m, 0);
  mc.Draw(0, 0, b);
  mc.Free;
  b.Free;
  m.SaveToFile('C:\SomePath\Test.emf');
  m.Free;
  Image1.Picture.LoadFromFile('C:\SomePath\Test.emf'  );
end;
+ نوشته شده در  یکشنبه چهارم دی 1384ساعت 7:39  توسط مهدی فدایی  | 

تغيير Resolution مونيتور

procedure SetResolution(ResX, ResY: DWord);
var
lDeviceMode : TDeviceMode;
begin
EnumDisplaySettings(nil, 0, lDeviceMode);
lDeviceMode.dmFields:=DM_PELSWIDTH or DM_PELSHEIGHT;
lDeviceMode.dmPelsWidth :=ResX;
lDeviceMode.dmPelsHeight:=ResY;
ChangeDisplaySettings(lDeviceMode, 0);
end;
 
+ نوشته شده در  یکشنبه چهارم دی 1384ساعت 7:38  توسط مهدی فدایی  | 

تغيير Volume ويندوز

يك TrackBar در فرم خود قرار دهيد و Max value را به 15 تغيير دهيد و در رويداد OnChange آن كد زير را قرار دهيد:

procedure TForm1.TrackBar1Change(Sender: TObject);
var
Count, i: integer;
begin
  Count := waveOutGetNumDevs;
  for i := 0 to Count do
  begin
   waveOutSetVolume(i,longint(TrackBar1.Position*4369  )*65536+longint(TrackBar1.Position*4369));
end;
end;


+ نوشته شده در  یکشنبه چهارم دی 1384ساعت 7:35  توسط مهدی فدایی  | 

تبدیل عدد به حرف

یکی از دوستان نحوه تبدیل عدد به حرف رو خاسته بود که با unite زیر این کار قابل انجامه.

 

Download Unite

+ نوشته شده در  پنجشنبه بیست و چهارم شهریور 1384ساعت 14:52  توسط مهدی فدایی  | 

Ntfs یا Fat32

برای اینکه بفهمین یک درایو Ntfs هست یا Fat از این function استفاده کنین.

function GetHardDiskPartitionType(const DriveLetter: Char): string;
  // FAT
  // NTFS
var
  NotUsed: DWORD;
  VolumeFlags: DWORD;
  VolumeInfo: array[0..MAX_PATH] of Char;
  VolumeSerialNumber: DWORD;
  PartitionType: array[0..32] of Char;
begin
  GetVolumeInformation(PChar(DriveLetter + ':\'),
    nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,
    VolumeFlags, PartitionType, 32);
  Result := PartitionType;
end;

نحوه استفاده:

ShowMessage(GetHardDiskPartitionType('c'));


+ نوشته شده در  سه شنبه بیست و دوم شهریور 1384ساعت 12:23  توسط مهدی فدایی  | 

بازکردن پنجره ی Task manager

در قسمت uses این کد رو اضافه کنین.

ShellApi

حالا از این کد استفاده کنین.

ShellExecute (HWND(nil), 'open', 'taskmgr','', '', SW_SHOWNORMAL);
 
 
 
+ نوشته شده در  سه شنبه بیست و دوم شهریور 1384ساعت 12:20  توسط مهدی فدایی  | 

اعمال فيلتر Emboss روي يك تصوير

اعمال فيلتر Emboss روي يك تصوير

 

 

procedure Emboss(ABitmap : TBitmap; AMount : Integer);

var

    x, y, i : integer;

    p1, p2: PByteArray;

begin

for i := 0 to AMount do

begin

for y := 0 to ABitmap.Height-2 do

begin

p1 := ABitmap.ScanLine[y];

p2 := ABitmap.ScanLine[y+1];

for x := 0 to ABitmap.Width do

begin

p1[x*3] := (p1[x*3]+(p2[(x+3)*3] xor $FF)) shr 1;

p1[x*3+1] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;

p1[x*3+2] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;

end;

end;

end;

end;

+ نوشته شده در  شنبه دوازدهم شهریور 1384ساعت 5:41  توسط مهدی فدایی  | 

ليست تمام فايلهاي موجود در يك دايركتوري

ليست تمام فايلهاي موجود در يك دايركتوري

procedure ListFileDir(Path: string; FileList: TStrings);
var
    SR: TSearchRec;
begin
    if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then
    begin
        repeat
            if (SR.Attr <> faDirectory) then
            begin
                FileList.Add(SR.Name);
            end;
        until FindNext(SR) <> 0;
        FindClose(SR);
    end;
end;

+ نوشته شده در  شنبه دوازدهم شهریور 1384ساعت 5:39  توسط مهدی فدایی  | 

تغییر Volume ویندوز

تغییر Volume ویندوز

type
    tvolRange=1..15;
Procedure ChangeVolume(value:tvolRange);
var
    Count, i: integer;
begin
    Count := waveOutGetNumDevs;
    for i := 0 to Count do
    begin
        waveOutSetVolume(i,longint(value*4369)*65536+longint(value*4369));
    end;
end;

+ نوشته شده در  شنبه دوازدهم شهریور 1384ساعت 5:38  توسط مهدی فدایی  | 

به دست آوردن تمامی درایو های CD , DVD

با کد زیر میتونین این کار رو انجام بدین.

 

Function GetCdDrives:Tstringlist;
 const
     Drv:array[0..23]of char=('c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z');
 var
     Drives:Set of 0..25;
     n:Byte;
 begin
     Result:=Tstringlist.Create;
     Result.Clear;
     Integer(Drives):= GetLogicalDrives;
     For n:=0 to 23 do
     If n in Drives then
     begin
     If GetDriveType(Drv[n])=5{Cd} then
     begin
     Result.Add(Drv[n]);
     end;
     end;
 end;
 

+ نوشته شده در  شنبه دوازدهم شهریور 1384ساعت 5:36  توسط مهدی فدایی  | 

آموزش زبان SQL به صورت فارسي

زبان SQL تنها زبان استاندارد و جامع پياده سازي، مديريت، نگهداري و كار با بانكهاي اطلاعاتي مي باشد كه تقريباً توسط تمام بانكهاي اطلاعاتي كوچك و بزرگ مانند Access، SQL Server، Oracle و DB2 پشتيباني مي شود. طراحان و افرادي كه بنوعي با بانكهاي اطلاعاتي سروكار دارند و همچنين برنامه نويساني كه از اين بانكها استفاده مي كنند هركدام بايد تا اندازه  اي با اين زبان آشنايي  داشته باشند. اين مقاله كه در سه قسمت تهيه شده است مي كوشد تا مفاهيم زبان SQL را در قالب يك مثال كاربردي بيان كند. هرچند كه مفاهيم بكار رفته در اين مقاله در تمامي بانكهاي اطلاعاتي قابل پياده سازي مي باشند ولي مثالهاي ارائه شده در 2000 SQL Server مورد تست قرار گرفته اند.

 

Link

+ نوشته شده در  شنبه دوازدهم شهریور 1384ساعت 5:21  توسط مهدی فدایی  | 

استفاده از اسکنر در دلفی

با این سورس میتونین این کار رو انجام بدین.

 

Link

+ نوشته شده در  پنجشنبه دهم شهریور 1384ساعت 12:19  توسط مهدی فدایی  | 

پاسخ به سوالات دوستان

شیما خانم سوال کرده بودن که چه جوری میشه از داخل برنامه بدون هیچ واسطه ای به اینترنت وصل شد.خوب فکر میکنم کد زیر بدردش بخوره.البته کانکشن باید از قبل ساخته شده باشه.

 

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Connect: TButton;
    Disconnect: TButton;
    ConnectionName: TEdit;
    UserName: TEdit;
    PassWord: TEdit;
    procedure DisconnectClick(Sender: TObject);
    procedure ConnectClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DisconnectClick(Sender: TObject);
var
cmd,par,fil,dir:pchar;
begin
cmd:='open';
fil:='rasdial.exe';
par:=pchar(ConnectionName.Text+' /DISCONNECT');
dir:='C:';
ShellExecute(Self.Handle,cmd,fil,par,dir,SW_SHOWNORMAL)
end;

procedure TForm1.ConnectClick(Sender: TObject);
var
cmd,par,fil,dir:pchar;
begin
cmd:='open';
fil:='rasdial.exe';
par:=pchar(ConnectionName.Text+' '+UserName.Text+' '+PassWord.Text);
dir:='c:';
ShellExecute(Self.Handle,cmd,fil,par,dir,SW_SHOWNORMAL)
end;

end.

این هم یک کد دیگه که با استفاده از اون میشه با اینترنت کانکشن پیش فرض کانکت شد

 

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
dwConnectionTypes:dword;
begin
dwConnectionTypes:=INTERNET_CONNECTION_MODEM+
INTERNET_CONNECTION_LAN+
INTERNET_CONNECTION_PROXY;
if not InternetGetConnectedState(@dwConnectionTypes,0) then
if not InternetAutodial(INTERNET_AUTODIAL_FORCE_ONLINE or
INTERNET_AUTODIAL_FORCE_UNATTENDED,0) then
begin

end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
dwConnectionTypes:dword;
begin
dwConnectionTypes:=INTERNET_CONNECTION_MODEM+
INTERNET_CONNECTION_LAN+
INTERNET_CONNECTION_PROXY;
if InternetGetConnectedState(@dwConnectionTypes,0) then
InternetAutodialHangup(0)
end;

end.

+ نوشته شده در  سه شنبه هشتم شهریور 1384ساعت 22:39  توسط مهدی فدایی  | 

اضافه کردن Quick Report به دلفی 7

دوستانی که از دست Rave report خسته شدن و يا حال ياد گرفتنش رو ندارن و می خوان برنامه های Delphi 6 رو تو Delphi 7 اجرا کنن می تونن به راحتی Quick Report رو نصب کنن.

 

۱- Delphi 7 رو اجرا کنيد.

۲- از منوی Componet گزينه Install Packages رو انتخاب کنيد.

۳- روی دکمه Add کليک کنيد.

۴- به شاخه ای که دلفی رو نصب کرده ايد برويد و وارد شاخه Bin بشويد.

۵- فايل dclqrt70.bpl رو انتخاب کنيد.

۶- روی دکمه Open کليک کنيد.

7- روی دکمه Ok کليک کنيد.

 

به همین سادگی

+ نوشته شده در  دوشنبه هفتم شهریور 1384ساعت 11:23  توسط مهدی فدایی  | 

تبدیل اعداد به حروف فارسی

با استفاده از این تابع می توانید اعداد را به حروف فارسی تبدیل نمایید.

Download

+ نوشته شده در  دوشنبه هفتم شهریور 1384ساعت 11:20  توسط مهدی فدایی  | 

Titlebar button

ابزاری برای گذاشتن یک دکمه بر روی عنوان فرم. با قابليت های زیر:

  • توانایی پذیرفتن تصویر به جای متن.

  • توانایی داشتن توضیح ( Hint).

  • داشتن رویدادهایی برای حرکات ماوس بر روی آن.

  • قابلیت تعیین اندازه و ... .

 

Download

+ نوشته شده در  دوشنبه هفتم شهریور 1384ساعت 11:16  توسط مهدی فدایی  | 

SalarSoft Hint

یک کامپوننت که Hint های برنامه شما را تغییر داده و به شكل جالبی در می آورد!

 

  • توانایی قرار گرفتن از راست به چپ برای زبان فارسی.

  • قابلیت تعیین رنگ.

  • قابلیت تعیین فونت دلخواه.

  •  

    Download Component

    + نوشته شده در  دوشنبه هفتم شهریور 1384ساعت 11:14  توسط مهدی فدایی  | 

    بالون

    کامپوننتی که با استفاده از آن میتوانید بالونهایی همانند بالون های ویندوز XP در برنامه خود داشته باشید.

     

    Download Component

    + نوشته شده در  دوشنبه هفتم شهریور 1384ساعت 11:12  توسط مهدی فدایی  | 

    Flash player

    سورس پخش کننده فایل های swf

    Download Source

    + نوشته شده در  دوشنبه هفتم شهریور 1384ساعت 11:10  توسط مهدی فدایی  | 

    دومین نسخه کاندیدای انتشار FreePascal 2

    دومین نسخه کاندیدای انتشار کامپایلر FreePascal 2 منتشر شد. این کمپایلر شی گرا به طور کامل با بورلند پاسکال 7 سازگار است و بسیاری از قابلیتهای دلفی را نیز پشتیبانی می کند. یک RAD IDE شبیه به دلفی به اسم لازاروس نیز برای آن وجود دارد (گالری عکسها). برای جزئیات بیشتر اینجا و برای دریافت اینجا را کلیک کنید.
    + نوشته شده در  دوشنبه هفتم شهریور 1384ساعت 10:50  توسط مهدی فدایی  |