(F1) do
begin
Read(F1, Ch);
Write(F2, Ch);
end;
CloseFile(F2);
end;
CloseFile(F1);
end;
end;
-----------------------------------------------------------------------------
OpenPictureDialog OpenDialog 开启档案.
-----------------------------------------------------------------------------
//SavePictureDialog1.DefaultExt := GraphicExtension(TBitmap);
//SavePictureDialog1.Filter := GraphicFilter(TBitmap);
procedure TForm1.Button1Click(Sender: TObject);
var
Done: Boolean;
begin
OpenPictureDialog1.DefaultExt := GraphicExtension(TIcon);
OpenPictureDialog1.FileName := GraphicFileMask(TIcon);
OpenPictureDialog1.Filter := GraphicFilter(TIcon);
OpenPictureDialog1.Options := [ofFileMustExist, ofHideReadOnly, ofNoChangeDir ];
while not Done do
begin
if OpenPictureDialog1.Execute then
begin
if not (ofExtensionDifferent in OpenPictureDialog1.Options) then
begin
Application.Icon.LoadFromFile(OpenPictureDialog1.FileName);
Done := True;
end
else
OpenPictureDialog1.Options := OpenPictureDialog1.Options - ofExtensionDifferent;
end
else { User cancelled }
Done := True;
end;
end;
## Eof, Read, Write Example
-----------------------------------------------------------------------------
Erase 删除档案.
-----------------------------------------------------------------------------
Unit System
函数原型 procedure Erase(var F);
说明 要先关档後才可以执行.
范例 procedure TForm1.Button1Click(Sender: TObject);
var
F: Textfile;
begin
OpenDialog1.Title := ''''Delete File'''';
if OpenDialog1.Execute then
begin
AssignFile(F, OpenDialog1.FileName);
try
Reset(F);
if MessageDlg(''''Erase '''' + OpenDialog1.FileName +
''''?'''',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
CloseFile(F);
Erase(F);
end;
except
on EInOutError do
MessageDlg(''''File I/O error.'''', mtError, [mbOk], 0);
end;
end;
end;
Example
procedure TForm1.Button1Click(Sender: TObject);
var
F: Textfile;
begin
OpenDialog1.Title := ''''Delete File'''';
if OpenDialog1.Execute then begin
AssignFile(F, OpenDialog1.FileName);
try
Reset(F);
if MessageDlg(''''Erase '''' + OpenDialog1.FileName + ''''?'''',
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
CloseFile(F);
Erase(F);
end;
except
on EInOutError do
MessageDlg(''''File I/O error.'''', mtError, [mbOk], 0);
end;
end;
end;
##Erase, OpenDialog.Title, OpenDialog.FileName Example
-----------------------------------------------------------------------------
Rename 更改档名.
-----------------------------------------------------------------------------
Unit System
函数原型 procedure Rename(var F; Newname);
范例 uses Dialogs;
var
f : file;
begin
OpenDialog1.Title := ''''Choose a file... '''';
if OpenDialog1.Execute then
begin
SaveDialog1.Title := ''''Rename to...'''';
if SaveDialog1.Execute then
begin
AssignFile(f, OpenDialog1.FileName);
Canvas.TextOut(5, 10, ''''Renaming '''' +
OpenDialog1.FileName +'''' to '''' +
SaveDialog1.FileName);
Rename(f, SaveDialog1.FileName);
end;
end;
end;
Example
uses Dialogs;
var
f : file;
begin
OpenDialog1.Title := ''''Choose a file... '''';
if OpenDialog1.Execute then begin
SaveDialog1.Title := ''''Rename to...'''';
if SaveDialog1.Execute then begin
AssignFile(f, OpenDialog1.FileName);
Canvas.TextOut(5, 10, ''''Renaming '''' + OpenDialog1.FileName + '''' to '''' +
SaveDialog1.FileName);
Rename(f, SaveDialog1.FileName);
end;
end;
end;
-----------------------------------------------------------------------------
GetDir 传回指定磁碟机的目录.
-----------------------------------------------------------------------------
Unit System
函数原型 procedure GetDir(D: Byte; var S: string);
说明 D
0=目前磁碟机,1=A磁碟机,2=B磁碟机....
**此函式不检查磁碟机错误.
范例 var
s : string;
begin
GetDir(0,s); { 0 = Current drive }
MessageDlg(''''Current drive and directory: '''' + s,
mtInformation, [mbOk] , 0);
end;
-----------------------------------------------------------------------------
MkDir 建立子目录.
-----------------------------------------------------------------------------
Unit System
函数原型 procedure MkDir(S: string);
范例 uses Dialogs;
begin
{$I-}
{ Get directory name from TEdit control }
MkDir(Edit1.Text);
if IOResult <> 0 then
MessageDlg(''''Cannot create directory'''', mtWarning,
[mbOk], 0)
else
MessageDlg(''''New directory created'''', mtInformation,
[mbOk], 0);
end;
-----------------------------------------------------------------------------
RmDir 删除一个空的子目录.
-----------------------------------------------------------------------------
Unit System
函数原型 procedure RmDir(S: string);
范例 uses Dialogs;
begin
{$I-}
{ Get directory name from TEdit control }
RmDir(Edit1.Text);
if IOResult <> 0 then
MessageDlg(''''Cannot remove directory'''', mtWarning,
[mbOk], 0)
&n << 上一页 [11] [12] [13] [14] [15] [16] [17] [18] [19] [20] ... 下一页 >> |
