cl991036
管理员
管理员
  • 注册日期2003-07-25
  • 发帖数5913
  • QQ14265545
  • 铜币29655枚
  • 威望213点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • GIS帝国铁杆
阅读:1660回复:1

拖放排序列表演示程序及代码

楼主#
更多 发布于:2003-08-03 00:32
本程序是一个比较常用的功能单元演示,主要是支持列表拖放,程序比较简单却非常实用,例如设置可选类型,Windows中设立IIS缺省首页等等。
其他的也没有什么好说的了,下载演示程序看看就明白了,下面是代码,加了详细的注释。
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';
  SectionName='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);
    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,''));
        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 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);
end;

{ 拖放时滚动ListView组件的函数 }
procedure TForm1.ListBox1DragOver(Sender, Source: TObject;
  X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  { Scroll Listview when Drag/Drop }
  if Y<15 then SendMessage(ListBox1.Handle,WM_VSCROLL,SB_LINEUP,0)
  else if ListBox1.Height-Y<15 then SendMessage(ListBox1.Handle,WM_VSCROLL,SB_LINEDOWN,0);
  { whether accept it }
  if (Source is TListBox) and (ListBox1.Count>0) and
     (ListBox1.ItemAtPos(Point(X,Y),True)<>ListBox1.ItemIndex) then
    Accept:=True else Accept:=False;
end;

procedure TForm1.ListBox1KeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Key=46 then { Delete Key }
    Button2.OnClick(Sender);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ListBox1.Clear;
  LoadIniFile(ListBox1.Items);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {得到程序路径}
  Application_Path:=ExtractFilePath(ParamStr(0));
end;

end.
喜欢0 评分0
没钱又丑,农村户口。头可断,发型一定不能乱。 邮箱:gisempire@qq.com
游客

返回顶部