main.pas

一个表达式计算库

unit Main;

interface

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

const
  StrStruct = 1;
    
type
  TMainForm = class(TForm)
    Edit1: TEdit;
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    ListBox2: TListBox;
    DList1: TDList;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Label7: TLabel;
    Edit5: TEdit;
    GroupBox2: TGroupBox;
    Label8: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure DList1DisposeStructure(Sender: TObject; Structure: Integer;
      Properties: Pointer);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure DList1FileHeader(Sender: TObject; var F: file;
      Action: THeaderAction; Format, InitPos: Integer);
    procedure DList1LoadStructure(Sender: TObject; Structure: Integer;
      var Properties: Pointer; var F: file; Format: Integer);
    procedure DList1SaveStructure(Sender: TObject; Structure: Integer;
      Properties: Pointer; var F: file; Format: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure ShowDescription;
    procedure Refresh;
  public
    { Public declarations }
  end;

type
  PS = ^string;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.Button1Click(Sender: TObject);
var
  Description: PS;
begin
  if Edit1.Text<>'' then with DList1 do begin
    New(Description);
    Description^:=Edit5.Text;
    Add(Edit1.Text, StrStruct, Description);
    Refresh;
  end;
end;

procedure TMainForm.Button3Click(Sender: TObject);
begin
  DList1.SetFilter(Edit2.Text,StrToInt(Edit3.Text),StrToInt(Edit4.Text));
  DList1.Clear;
  Refresh;
end;

procedure TMainForm.ShowDescription;
var
  S: pointer;
  Structure: integer;
begin
  Label8.Caption:='';
  with DList1 do if ListBox2.Focused then with ListBox2 do begin
    if (Items.Count=0) or (ItemIndex<0) then Exit;
    GetFields(Items[ItemIndex], Structure, S);
  end
  else with ListBox1 do begin
    if (Items.Count=0) or (ItemIndex<0) then Exit;
    GetFields(Items[ItemIndex], Structure, S);
  end;
  Label8.Caption:=PS(S)^;
end;

procedure TMainForm.Refresh;
var
  s:string;
begin
  with DList1 do begin
    ListBox1.Clear;
    SetFilter('',0,100);
    if first then repeat
      GetName(s);
      ListBox1.Items.Add(s);
    until not Next;
    ListBox2.Clear;
    SetFilter(Edit2.Text,StrToInt(Edit3.Text),StrToInt(Edit4.Text));
    if First then repeat
      GetName(s);
      ListBox2.Items.Add(s);
    until not Next;
  end;
  ShowDescription;
end;

procedure TMainForm.Button4Click(Sender: TObject);
begin
  Refresh;
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
  i:integer;
begin
  with ListBox1 do if ItemIndex>-1 then begin
    DList1.Remove(Items[ItemIndex]);
    i:=ItemIndex;
    MainForm.Refresh;
    if Items.Count-1<i then ItemIndex:=Items.Count-1
    else ItemIndex:=i;
  end;
end;

procedure TMainForm.Button5Click(Sender: TObject);
begin
  DList1.ClearAll;
  Refresh;
end;

procedure TMainForm.Button6Click(Sender: TObject);
begin
  DList1.SetFilter(Edit2.Text,StrToInt(Edit3.Text),StrToInt(Edit4.Text));
  DList1.Save('Test.dls',1);
end;

procedure TMainForm.Button7Click(Sender: TObject);
begin
  DList1.Load('Test.dls',1);
  Refresh;
end;

procedure TMainForm.DList1DisposeStructure(Sender: TObject;
  Structure: Integer; Properties: Pointer);
begin
  if Structure = StrStruct then Dispose(PS(Properties));
end;

procedure TMainForm.ListBox1Click(Sender: TObject);
begin
  ListBox2.ItemIndex:=-1;
  ShowDescription;
end;

procedure TMainForm.ListBox2Click(Sender: TObject);
begin
  ListBox1.ItemIndex:=-1;
  ShowDescription;
end;

procedure TMainForm.DList1FileHeader(Sender: TObject; var F: file;
  Action: THeaderAction; Format, InitPos: Integer);
var
  MyAge: integer;
begin
  case Action of
    haRead: begin
      BlockRead(F, MyAge, SizeOf(MyAge));
      {Use MyAge}
    end;
    haWrite: begin
      MyAge:=32;
      BlockWrite(F, MyAge, SizeOf(MyAge));
    end;
  end;
end;

procedure TMainForm.DList1LoadStructure(Sender: TObject;
  Structure: Integer; var Properties: Pointer; var F: file;
  Format: Integer);
var
  i, Len: integer;
begin
  if Structure=StrStruct then begin
    BlockRead(F, Len, SizeOf(Len));
    New(PS(Properties));
    SetLength(PS(Properties)^, Len);
    for i:=1 to Len do BlockRead(F, PS(Properties)^[i], 1);
  end;
end;

procedure TMainForm.DList1SaveStructure(Sender: TObject;
  Structure: Integer; Properties: Pointer; var F: file; Format: Integer);
var
  i, Len: integer;
begin
  if Structure=StrStruct then begin
    Len:=Length(PS(Properties)^);
    BlockWrite(F, Len, SizeOf(Len));
    for i:=1 to Len do BlockWrite(F, PS(Properties)^[i], 1);
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Button7Click(Sender);
end;

end.