【delphi开源代码栏目提醒】:以下是网学会员为您推荐的delphi开源代码-Frm_changeAttr.pas,希望本篇文章对您学习有所帮助。
unit Frm_changeAttr;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Filectrl, ExtCtrls, StdCtrls, XPMan;
type
TFrmChangeAttr = class(TForm)
GBxFileList: TGroupBox;
LBXFile: TFileListBox;
LbxDirectory: TDirectoryListBox;
cbxDrive: TDriveComboBox;
CbXFilter: TFilterComboBox;
GBxArrt: TGroupBox;
CBxReadOnly: TCheckBox;
CBxSysFile: TCheckBox;
CBxArchive: TCheckBox;
CBxHidden: TCheckBox;
BtnAttrChang: TButton;
BtnClose: TButton;
procedure LBXFileChange(Sender: TObject);
procedure BtnAttrChangClick(Sender: TObject);
procedure BtnCloseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmChangeAttr: TFrmChangeAttr;
implementation
{$R *.dfm}
procedure TFrmChangeAttr.LBXFileChange(Sender: TObject);
var
attr:integer;
begin
attr:=0;
if LBXFile.FileName = '' then
begin
cbxReadOnly.Checked:=False;
cbxSysFile.Checked:=False;
cbxHidden.Checked:=False;
cbxArchive.Checked:=False;
exit;
end;
attr:=FileGetAttr(LBXFile.FileName);
if attr and faReadOnly = faReadOnly then
CBXReadOnly.Checked:=true
else
cbxReadOnly.Checked:=False;
if attr and faSysFile = faSysFile then
CBXSysFile.Checked:=true
else
cbxSysFile.Checked:=False;
if attr and faHidden = faHidden then
CBXHidden.Checked:=true
else
cbxHidden.Checked:=False;
if attr and faArchive = faArchive then
CBXArchive.Checked:=true
else
cbxArchive.Checked:=False;
end;
procedure TFrmChangeAttr.BtnAttrChangClick(Sender: TObject);
var
attr:integer;
begin
if LBXFile.FileName <> '' then
begin
attr:=FilegetAttr(LBXFile.FileName);
if cbxReadOnly.Checked then
Attr := Attr or faReadOnly
else
attr := Attr and (not faReadOnly);
if cbxSysFile.Checked then
Attr := Attr or FaSysFile
else
Attr := Attr and (not FaSysFile);
if cbxHidden.Checked then
Attr := Attr or faHidden
else
Attr := Attr and (not faHidden);
if cbxArchive.Checked then
Attr := Attr or faArchive
else
attr := Attr and (not faArchive);
FileSetAttr(LBXFile.FileName,attr);
end
else
Showmessage('请选择文件!!');
end;
procedure TFrmChangeAttr.BtnCloseClick(Sender: TObject);
begin
Close;
end;
end.