Прогресс загрузки и сохранения текста -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [3.133.86.172]

Модераторы: jack128, Rouse_, Krid

Прогресс загрузки и сохранения текста , в TMemo

s-mike

Сообщ. #1 , 28.01.05, 19:25

Unregistered

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ToolWin, ComCtrls;

type

TForm1 = class(TForm)

Memo1: TMemo;

ToolBar1: TToolBar;

Button1: TButton;

StatusBar: TStatusBar;

OpenDialog: TOpenDialog;

ProgressBar: TProgressBar;

Button2: TButton;

SaveDialog: TSaveDialog;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button2Click(Sender: TObject);

public

procedure LoadFile(const FileName: string);

procedure SaveFile(const FileName: string);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses Math;

procedure TForm1.LoadFile(const FileName: string);

const

BufferSize = 8192;

var

StrBuffer: array[0..BufferSize - 1] of Char;

F: file;

MemoryStream: TMemoryStream;

Result, Max, Curr, Progress: Integer;

begin

AssignFile(F, FileName);

Reset(F, 1);

Curr := 0;

Max := FileSize(F) div BufferSize + 1;

MemoryStream := TMemoryStream.Create;

try

repeat

BlockRead(F, StrBuffer, BufferSize, Result);

MemoryStream.Write(StrBuffer, Result);

Inc(Curr);

Progress := Curr * 100 div Max;

StatusBar.SimpleText := IntToStr(Progress) + '%';

ProgressBar.Position := Progress;

Application.ProcessMessages;

until Result <= 0;

MemoryStream.Seek(0, soBeginning);

Memo1.Lines.LoadFromStream(MemoryStream);

finally

MemoryStream.Free;

end;

CloseFile(F);

ProgressBar.Position := 0;

StatusBar.SimpleText := FileName;

end;

procedure TForm1.SaveFile(const FileName: string);

const

BufferSize = 8192;

var

StrBuffer: array[0..BufferSize - 1] of Char;

F: file;

MemoryStream: TMemoryStream;

Max, Curr, Progress, ToWrite: Integer;

begin

AssignFile(F, FileName);

Rewrite(F, 1);

MemoryStream := TMemoryStream.Create;

try

Memo1.Lines.SaveToStream(MemoryStream);

Curr := 0;

Max := MemoryStream.Size div BufferSize + 1;

MemoryStream.Seek(0, soBeginning);

while MemoryStream.Position < MemoryStream.Size do

begin

ToWrite := Min(MemoryStream.Size - MemoryStream.Position, BufferSize);

MemoryStream.Read(StrBuffer, ToWrite);

BlockWrite(F, StrBuffer, ToWrite);

Inc(Curr);

Progress := Curr * 100 div Max;

StatusBar.SimpleText := IntToStr(Progress) + '%';

ProgressBar.Position := Progress;

Application.ProcessMessages;

end;

finally

MemoryStream.Free;

end;

CloseFile(F);

ProgressBar.Position := 0;

StatusBar.SimpleText := FileName;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

with OpenDialog do

if Execute then LoadFile(OpenDialog.FileName);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

OpenDialog.InitialDir := ExtractFilePath(Application.ExeName);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

with SaveDialog do

if Execute then

SaveFile(FileName);

end;

end.

Весь проект находится в прикрепленном файле.

Это сообщение было перенесено сюда или объединено из темы "Прогресс загрузки"
Прикреплённый файл

TextProgress.zip (2.58 Кбайт, скачиваний: 170)

0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,0221 ] [ 16 queries used ] [ Generated: 27.04.24, 07:26 GMT ]