1. SysUtils单元下的TSearchRec是一个记录类型,主要通过FindFirst, FindNext, and FindClose使用。
其中:Findfirst的第一个参数为需要搜索的文件路径文件名(可以使用*通配符),第二个参数为文件的属性,第三个参数会将搜索到的文件保存到TSearchRec记录类型的变量中。搜索完毕后一定不要忘记findclose
实例说明:其中用到的组件 edit,checkbox,button,label,stringgrid。功能是在编辑框中输入要搜索的文件路径,点击合适的属性筛选文件。

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls;
type
TForm1 = class(TForm)
lbl1: TLabel;
edt1: TEdit;
btn1: TButton;
chk1: TCheckBox;
chk2: TCheckBox;
chk3: TCheckBox;
chk4: TCheckBox;
chk5: TCheckBox;
chk6: TCheckBox;
chk7: TCheckBox;
strngrd1: TStringGrid;
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
var
sr:TSearchRec;
FiltAttr:Integer;
begin
strngrd1.RowCount:=1;
if chk1.Checked then
FiltAttr:=faReadOnly
else
FiltAttr:=0;
if chk2.Checked then
FiltAttr:=FiltAttr+fahidden;//文件属性一般都是用数值fa...
if chk3.Checked then
FiltAttr:=FiltAttr+fasysfile;
if chk4.Checked then
FiltAttr:=FiltAttr+favolumeId;
if chk5.Checked then
FiltAttr:=FiltAttr+fadirectory;
if chk6.Checked then
FiltAttr:=FiltAttr+faarchive;
if chk7.Checked then
FiltAttr:=FiltAttr+faanyfile;
with strngrd1 do
begin
rowcount:=0;
if FindFirst(edt1.Text,FiltAttr,sr)=0 then
begin
Cells[1,0]:='文件名';
Cells[2,0]:='大小(k)';
repeat
if(sr.Attr and FiltAttr)=sr.Attr then
begin
RowCount:=rowcount+1;
Cells[1,RowCount-1]:=sr.name;
Cells[2,RowCount-1]:=IntToStr(sr.Size);
end;
until FindNext(sr)<>0;
FindClose(sr);
end;
end;
end;
end.
2.检验输入路径的文件是否存在
实例说明:编辑框输入文件路径,显示是否存在。调用的findfirstfile函数的第一个参数要把string类型转换为pchar,因为findfirstfile是win32 sdk类型函数,保持兼容

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
lbl1: TLabel;
edt1: TEdit;
btn1: TButton;
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
var
handle:THandle;
FindData:TWin32FindData;
FileName:TFileName;
begin
FileName:=edt1.Text;
handle:=FindFirstFile(PChar(FileName),FindData);
if handle <>Invalid_handle_value then
MessageDlg('文件存在',mtInformation,[mbOK],0)
else
MessageDlg('文件不存在',mtInformation,[mbOK],0);
end;
end.
3.创建文件
功能展示:动态的创建一个文件,单机创建文件后,自动创建。需要DirveComboBox,DirectoryListBox,FileListBox,memo,button等组件。
这里还要特别注意组建的关联关系


unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, FileCtrl;
type
TForm1 = class(TForm)
drvcbb1: TDriveComboBox;
dirlst1: TDirectoryListBox;
fllst1: TFileListBox;
btn1: TButton;
lbl1: TLabel;
edt1: TEdit;
lbl2: TLabel;
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
var
DirName,FullName,RanStr:String;
FileSaveTo:TextFile;
begin
lbl2.Caption:='';
Randomize;
RanStr:='';
DirName:=dirlst1.Directory;
if DirName[Length(DirName)]<>'\' then Dirname:=DirName+'\';
FullName:=DirName+edt1.Text;
if FileExists(FullName) then DeleteFile(FullName);
AssignFile(FileSaveTo,FullName);
if FileExists(FullName) then
Reset(FileSaveTo) //读文件
else
Rewrite(FileSaveTo);//写文件
Writeln(filesaveto,ranstr);
CloseFile(FileSaveTo);
lbl2.Caption:='文件创建完毕';
fllst1.Update;//创建完成后刷新目录
end;
end.
4.自由绘图
功能说明:要在界面上任意绘制图形,主要是将鼠标响应事件与绘图函数相结合在一起。mousedown按下鼠标,mousemove移动鼠标,mouseup松开鼠标。使用的组件colorBox、statusbar等。
问题分析:其实delphi语法怎么使用不是很重要,重要是理解画图的本质算法。
绘制图形,必须设置一个标识符,当该点为0时,作为起点才能开始绘图,其次在擦除图片时,可以将绘制的图型的背景颜色设置为表单form的颜色,重点是擦出完,还要再次恢复删除之前画笔的颜色,才可以再次绘制。
在这里插入图片描述

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
lbl1: TLabel;
ColorBox1: TColorBox;
btn1: TButton;
stat1: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ColorBox1Change(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
StartX,StartY,end_flag:Integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
end_flag:=1;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
end_flag:=0;
StartX:=X;
StartY:=Y;
Canvas.MoveTo(x,y);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if end_flag=0 then
Canvas.LineTo(x,y);
stat1.SimpleText:='鼠标当前位置:X='+IntToStr(x)+',Y='+IntToStr(Y);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
end_flag:=1;
end;
procedure TForm1.ColorBox1Change(Sender: TObject);
begin
Canvas.Pen.Color:=ColorBox1.Selected;
end;
procedure TForm1.btn1Click(Sender: TObject);
var
i:Integer;
old_color:TColor;
begin
lbl1.Enabled:=false;
old_color:=Canvas.Pen.Color;
for i:=0 to Form1.Height do
begin
Canvas.Pen.color:=form1.Color;
Canvas.MoveTo(0,i); //设置画笔的起点
Canvas.LineTo(form1.Width,i); //画笔终点坐标
end;
Canvas.Pen.Color:=old_color;
lbl1.Enabled:=True;
end;
end.

被折叠的 条评论
为什么被折叠?



