chformutils.pas

双色球矩阵计算程序

unit CHFormUtils;

interface
uses
  Windows, Classes, Forms, Controls, Graphics, ADODB, ComCtrls, StrUtils;

type
  PMyTreeData = ^TMyTreeData;
  TMyTreeData = record
    ID: array[0..50] of char;
  end;

procedure CHCreateForm(InstanceClass: TComponentClass; var AForm: TForm;
    const AParent: TComponent; const AFont: TFont);

procedure CHLoadTree(ds: TADOQuery; Tree: TTreeView);
procedure CHFreeTree(Tree: TTreeView);

implementation

procedure CHCreateForm(InstanceClass: TComponentClass; var AForm: TForm;
    const AParent: TComponent; const AFont: TFont);
var
  Instance: TComponent;
begin
  if AForm <> nil then begin
    if (AForm.ClassName = InstanceClass.ClassName) then begin
      AForm.Show;
      Exit;
    end else begin
      AForm.Free;
      AForm := nil;
    end;
  end;

  Instance := TComponent(InstanceClass.NewInstance);
  TComponent(AForm) := Instance;
  try
    Instance.Create(AParent);
  except
    TComponent(AForm) := nil;
    raise;
  end;

  TForm(Instance).HandleNeeded;
  AForm.Parent := TWinControl(AParent);
  AForm.Align := alClient;
  AForm.Font := AFont;
  AForm.BorderStyle := bsNone;
  AForm.Show;
end;

procedure CHLoadTree(ds: TADOQuery; Tree: TTreeView);
  procedure InsertTreeNode(Tree: TTreeView; ParentID, ID, Name: string);
  var
    p: PMyTreeData;
    i: Integer;
  begin
    if Tree.Items.Count = 0 then begin
      New(p);
      lstrcpy(p^.ID, PChar(ID));
      Tree.Items.AddObject(nil, Name, p);
      Exit;
    end;

    for i:=0 to Tree.Items.Count-1 do begin
      p := Tree.Items.Item[i].Data;
      if ParentID = string(p^.ID) then begin
        New(p);
        lstrcpy(p^.ID, PChar(ID));
        Tree.Items.AddChildObject(Tree.Items.Item[i], Name, p);
        Exit;
      end;
    end;
  end;
var
  str: string;
begin
  ds.Active := True;
  ds.First;
  while not ds.Eof do begin
    str := ds.FieldByName('编号').AsString;
    str := LeftStr(str, Length(str)-2);
    InsertTreeNode(Tree, str, ds.FieldByName('编号').AsString, ds.FieldByName('名称').AsString);
    ds.Next;
  end;
end;

procedure CHFreeTree(Tree: TTreeView);
var
  i: Integer;
  p: PMyTreeData;
begin
  for i:=0 to Tree.Items.Count-1 do begin
    p := PMyTreeData(Tree.Items.Item[i].Data);
    Dispose(p);
  end;
end;

end.