نصب ProgressBar روی StatusBar در دلفی

 

نصب ProgressBar روی StatusBar در دلفی

StatusBar می باشد. انجام این کار بسیار ساده است. برای این کار کافی است بر روی فرم خود یک StatusBar اضافه نمایید حالا در قسمت تعاریف متغیر های عمومی کد زیر را بنویسید:

ProgressBar1: TprogressBar;

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

var

ProgressBarStyle: LongInt;

begin

{create a run progress bar in the status bar}

ProgressBar1 := TProgressBar.Create(StatusBar1);

ProgressBar1.Parent := StatusBar1;

{remove progress bar border}

ProgressBarStyle := GetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE);

ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;

SetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle);

{set progress bar position and size - put in Panel[2]}

ProgressBar1.Left := StatusBar1.Panels.Items[0].Width +

StatusBar1.Panels.Items[1].Width + 4;

ProgressBar1.Top := 4;

ProgressBar1.Height := StatusBar1.Height - 6;

ProgressBar1.Width := StatusBar1.Panels.Items[2].Width - 6;

{set range and initial state}

ProgressBar1.Min := 0;

ProgressBar1.Max := 100;

ProgressBar1.Step := 1;

ProgressBar1.Position := 0;

end;

حالا برای آنکه پس از خارج شدن از فرم حافظه اشغال شده آزاد گردد، در قسمت OnDestroy در Event فرمتان دستور زیر را اضافه نمایید:

ProgressBar1.free;

نمایش میزان کپی شدن فایل با ProgressBar در دلفی

 

نمایش میزان کپی شدن فایل با ProgressBar در دلفی

 چطور میتوان زمان کپی شدن فایل را با استفاده از ProgressBar نمایش داد؟
برای انجام این کار ابتدا بر روی یک فرم یک ProgressBar اضافه کنید سپس تابع زیر را تایپ کنید:

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:Welcome.exe', 'c:	empWelcome.exe'); 

end;

چطور می توان زمان کپی شدن فایل را محاسبه و نمایش داد؟
برای این کار نیز میتوانید از تابع زیر استفاده کنید:

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;

در این تابغ ابتدا زمان اولیه در متغیر t1 ذخیره شده و سپس پس از کپی شدن هر قسمت از فایل، زمان در متغیر t2 ذخیره میشود و توسط فرمول زیر مقدار زمان باقی مانده تا کپی کامل فایل بدست می آید.

((t2 - t1) / min * maxi - t2 + t1) / 100

تغییر Hint برای هر ستون از DBGrid در دلفی

تغییر Hint برای هر ستون از DBGrid در دلفی

 

ابتدا باید یک عنصر جدید مبتنی بر TDBGrid ایجاد کنید و رویداد OnMouseMove را فراخوانی کنید:

type

   TMyDBGrid = class(TDBGrid)

   published

    property OnMouseMove;

   end;

اگرچه شما در رویداد OnMouseMove مختصات X و Y را بدست خواهید آورد، اما شما باید ستون مورد نظر را پیدا کنید. برای ادامه کار لازم است که سطر زیر را در قسمت protected قرار دهید:

procedure WMMouseMove(var Message : TWMMouse); message WM_MOUSEMOVE;

همچنین متغیر های زیر را در قسمت public اضافه نمایید:

MouseRow : integer;

MouseCol : integer;

بنابراین متد WMMouseMove بصورت ریر خواهد بود:

procedure TMyDBGrid.WMMouseMove(var Message : TWMMouse);

var

   t : TGridCoord;

begin

   t := MouseCoord(Message.XPos, Message.YPos);

   MouseCol := t.x;

   MouseRow := t.y;

   inherited;

end;

ما ابتدا فیلدهای XPost و YPos را از ساختار WMMouseMove تنظیم میکنیم:

procedure TForm2.MyDBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:

Integer);

begin

    if (((dgIndicator in MyDBGrid1.Options) and (MyDBGrid1.MouseCol > 0)) or

       ((not (dgIndicator in MyDBGrid1.Options)) and (MyDBGrid1.MouseCol <> -1)))

       and (MyDBGrid1.MouseCol <> OldMouseCol) then begin

      OldMouseCol := MyDBGrid1.MouseCol;

      if dgIndicator in MyDBGrid1.Options then

         MYDBGrid1.Hint := MyDBGrid1.Columns[MyDBGrid1.MouseCol - 1].FieldName

      else

         MYDBGrid1.Hint := MyDBGrid1.Columns[MyDBGrid1.MouseCol].FieldName;

    end;

end;

حالا مجددا" تعریف زیر را در قسمت public قرار دهید:

HintMouseMessage(Control : TControl; var Message : TMessage)

در قسمت OnMouseMove از TDBGrid نیز فرامین زیر را اضافه نمایید:

var

   r : TMessage;

begin

   Application.HintMouseMessage(self, r);

   TWMMouse(r).XPos := X;

   TWMMouse(r).YPos := Y;

   Application.HintMouseMessage(MyDBGrid1, r);

end;

همه کارها انجام شد. حالا شما میتوانید نتیجه را مشاهده کنید.