List列表拖放排序记忆演示

2008-02-23 07:20:55来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折

分  类:组件
语  种:简体中文
编辑器:Delphi6
平  台:Win9x,Win2k/NT,WinXP
作品源代码: 本地下载
软件或演示: -
代码大小: 219.2K
软件大小: -

本程序是一个比较常用的功能单元演示,主要是支持列表拖放,程序比较简单却非常实用,例如设置可选类型,Windows中设立IIS缺省首页等等。
其他的也没有什么好说的了,下载演示程序看看就明白了,下面是代码,加了详细的注释。

//
// -'`"_ -'`" // / \ / "
// / /\\__ / ___ \ ADDRESS:
// | | \ -"`.-( \ | Che-Bei road Tian-He district of GuangZhou
// | | | | \" | | ZIP CODE:
// | / / "-" \ \ | 710054
// \___/ / (o o) \ (__/ NAME:
// __| _ _ |__ ZHONG WAN
// ( ( ) ) EMAIL:
// \_\.-.___.-./_/ root@2ccc.com
// __ | | __ HOMEPAGE:
// | \.| |./ | http://www.2ccc.com
// | '#. .#' | OICQ:
// |__/ '"" \__| 6036742
// -/ \-
//

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms,
Dialogs, StdCtrls, IniFiles;

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Button3: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
Application_Path:string;
procedure SetIniFile(sList: TStrings);
{ Private declarations }
public
procedure LoadIniFile(sList: TStrings);
{ Public declarations }
end;

var
Form1: TForm1;

const
iniFileName='2ccc.com.ini';
Section_Name='TypeStrings';

implementation

{$R *.dfm}

{ 保存列表数据到ini文件的函数 }
procedure TForm1.SetIniFile(sList:TStrings);
var
i:Integer;
f:TIniFile;
begin
f:=TIniFile.Create(Application_Path iniFileName); {建立ini文件}
try
{删除原来的数据}
if f.SectionExists(SectionName) then f.EraseSection(SectionName);
if sList.Count>0 then
begin
for i:=0 to sList.Count-1 do {循环写入数据}
f.WriteString(SectionName,'Value' IntToStr(i),sList.Strings[i]);
end;
finally
f.Free;
end;
end;

{ 从ini文件读出列表数据的函数 }
procedure TForm1.LoadIniFile(sList:TStrings);
var
i:Integer;
f:TIniFile;
ss:TStrings;
begin
f:=TIniFile.Create(Application_Path iniFileName);
try
if f.SectionExists(SectionName) then
begin
ss:=TStringList.Create;
try
f.ReadSection(SectionName,ss); {读入全部列表数据名}
if ss.Count>0 then
begin
for i:=0 to ss.Count-1 do {循环读入数据}
sList.Add(f.ReadString(SectionName,ss.Strings[i],'));
end;
finally
ss.Free;
end;
end;
finally
f.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var {添加数据}
i:Integer;
b:Boolean;
begin
if Edit1.Text=' then Exit;
b:=True;
if ListBox1.Count>0 then
for i:=0 to ListBox1.Count-1 do
if Edit1.Text=ListBox1.Items.Strings[i] then b:=False;
if b then
begin
ListBox1.Items.Add(Edit1.Text);
Edit1.Text:=#0;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
SetIniFile(ListBox1.Items);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ListBox1.Items.Delete(ListBox1.ItemIndex);
Button2.Enabled:=False;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
Button1.Default:=False;
Button2.Enabled:=True;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
if (Sender as TEdit).Text<>' then
begin
Button1.Default:=True;
Button1.Enabled:=True;
end else
begin
Button1.Default:=False;
Button1.Enabled:=False;
end;
end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject;
X, Y: Integer);
var {列表框拖放处理}
aPoint:TPoint;
begin
aPoint.x:=X;
aPoint.y:=Y;
if ListBox1.ItemAtPos(aPoint,True)<>-1 then {是否超出最后一个的范围}
ListBox1.Items.Exchange(ListBox1.ItemIndex,
ListBox1.ItemAtPos(aPoint,True))
else
ListBox1.Items.Exchange(ListBox1.ItemIndex,ListBox1.Count-1);

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:简化版BDE注册及OCX注册演示

下一篇:Pakker 0.1 (文件打包及释放)