uoutfieldset.pas

说明: 比较简单的人事档案管理程序,包含了人事档案的大部分功能,做人事档案的兄弟可以看看. 本程序类型：delphi7 + Access2000 桌面数据库 初始用户名/密码:admin

unit UOutFieldSet;

interface

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

type
  TForm_OutFieldSet = class(TForm)
    FieldNameList: TCheckListBox;
    FieldList: TCheckListBox;
    SelectOk: TSpeedButton;
    AllNo: TSpeedButton;
    AllYes: TSpeedButton;
    Label1: TLabel;
    SelectNumber: TEdit;
    SelectSQL: TEdit;
    EdUserName: TEdit;
    procedure FieldNameListClick(Sender: TObject);
    procedure AllYesClick(Sender: TObject);
    procedure AllNoClick(Sender: TObject);
    procedure SelectOkClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FieldNameListDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
  private
    { Private declarations }
    count: integer;
  public
    { Public declarations }
  end;

var
  Form_OutFieldSet: TForm_OutFieldSet;

implementation
uses Umain;

{$R *.dfm}

procedure TForm_OutFieldSet.FieldNameListClick(Sender: TObject);
var i: integer;
begin
  i := FieldNameList.ItemIndex;
  FieldList.Checked[i] := FieldNameList.Checked[i];
  FieldNameList.Style := lbOwnerDrawFixed;
end;

procedure TForm_OutFieldSet.AllYesClick(Sender: TObject);
var i: integer;
begin
  count := FieldList.Count; //获取列表项数
  for i := 0 to Count - 1 do
  begin
    FieldList.Checked[i] := true;
    FieldNameList.Checked[i] := true;
  end;
  FieldNameList.Style := lbOwnerDrawFixed;
end;

procedure TForm_OutFieldSet.AllNoClick(Sender: TObject);
var i: integer;
begin
  count := FieldList.Count; //获取列表项数
  for i := 0 to Count - 1 do
  begin
    FieldList.Checked[i] := false;
    FieldNameList.Checked[i] := false;
  end;
  FieldNameList.Style := lbOwnerDrawFixed;
end;

procedure TForm_OutFieldSet.SelectOkClick(Sender: TObject);
var i: integer;
begin
  Count := FieldList.Count; //获取列表项数
  SelectNumber.Clear; //清空数
  SelectSQL.Clear; //清空ＳＱＬ
  for i := 0 to Count - 1 do
  begin
    if FieldList.Checked[i] then
    begin
      if SelectSQL.Text <> '' then
       SelectSQL.Text := SelectSQL.Text + ',';
      SelectNumber.Text := SelectNumber.Text + '1';
      SelectSQL.Text := SelectSQL.Text + FieldList.Items[i];
    end
    else
    begin
      SelectNumber.Text := SelectNumber.Text + '0';
    end;
  end;
  //将数据写入用户表
  try
    with Form_Main.TabUser do
    begin
      close;
      open;
      first;
      while not eof do
      begin
        if FieldByName('User_Name').AsString = EdUserName.Text then
        begin
          Update;
          edit;
          FieldByName('User_FieldList').AsString := SelectNumber.Text;
          FieldByName('User_Fieldsql').AsString := SelectSQL.Text;
          post;
          last;                    //指针指向未记录
          showmessage('设置成功');
        end;
        next;
      end;
      close;
    end;
  except
    showmessage('无法打开用户表');
  end;
  close;
end;

procedure TForm_OutFieldSet.FormShow(Sender: TObject);
var SelectString: string;
  i: integer;
begin
  FieldNameList.Style := lbOwnerDrawFixed;
  Count := FieldList.Count; //获取列表项目数
  if SelectNumber.Text <> '' then //判断有没传送上次选择项过来
  begin
    SelectString := trim(SelectNumber.Text);
    for i := 0 to Count - 1 do
    begin
      if SelectString[i] = '1' then
      begin
        FieldList.Checked[i] := true;
        FieldNameList.Checked[i] := true;
      end
      else
      begin
        FieldList.Checked[i] := false;
        FieldNameList.Checked[i] := false;
      end;
    end;
  end;

end;

procedure TForm_OutFieldSet.FieldNameListDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  with FieldNameList do
  begin
    if FieldNameList.Checked[Index] then
      Canvas.Font.Color := clGreen
    else
      Canvas.Font.Color := clRed;
    Canvas.TextRect(Rect, Rect.Left, Rect.Top, FieldNameList.Items[Index]);
  end;
end;
end.