czygl.pas

已经给出使用的每个SQL Server数据库

unit czygl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, fram, ImgList, ExtCtrls, ComCtrls, ToolWin, StdCtrls, Grids;

type
  Tf_czygl = class(Tf_fram)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    czymc: TEdit;
    czymm: TEdit;
    czyjb: TComboBox;
    Panel2: TPanel;
    bg: TStringGrid;
    Label4: TLabel;
    tx2: TImage;
    Label5: TLabel;
    Label6: TLabel;
    tx1: TImage;
    tx: TImage;
    chb: TListBox;
    Image1: TImage;
    procedure bgDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure bgClick(Sender: TObject);
    procedure bgSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure B4Click(Sender: TObject);
    procedure czymcKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure chbExit(Sender: TObject);
    procedure chbKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure chbDblClick(Sender: TObject);
    procedure B3Click(Sender: TObject);
    procedure czymmKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure B9Click(Sender: TObject);
    procedure B10Click(Sender: TObject);
    procedure B11Click(Sender: TObject);
    procedure B12Click(Sender: TObject);
    procedure B1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);override;
    procedure B2Click(Sender: TObject);
    procedure B5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    Procedure SetGridFieldName;
    Procedure IniGrid;
    Procedure SetQx(Rect: TRect;isyq: Boolean);
    Procedure EditValue;
    Procedure SetListPos(WinControl: TWinControl);
    { Public declarations }
  end;
  RQx= Record
    bnlb: String;
    Qx: Boolean;
  end;
var
  f_czygl: Tf_czygl;
  col1,row,row1: integer;
  gn: Array [0..15]of RQx;
implementation
  uses Datamodal;
{$R *.dfm}
Const
  gnzd = 1;
  qx = 2;
{ Tf_czygl }

procedure Tf_czygl.SetGridFieldName;
var
  rect: TRect;
  zdmc: String;
  zdwidth: integer;
  zdheight,i: Integer;
begin
  zdheight:= 12;
  For i := 1 to bg.ColCount-1 do
  begin
    rect := bg.CellRect(i,0);
    case i of
      1: zdmc := '功能表';
      2: zdmc := '是否有权';
    end;
    zdwidth := length(zdmc);
    bg.Canvas.Brush.Color := clBtnFace;
    bg.Canvas.Font.Color := clRed;
    bg.Canvas.TextOut(rect.Left+Trunc((rect.Right-rect.Left-zdwidth*6)/2),rect.Top+Trunc((rect.Bottom-rect.Top -zdheight)/2),zdmc );
  end;
end;

procedure Tf_czygl.bgDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  SetGridFieldName;
  IniGrid;
end;

procedure Tf_czygl.bgClick(Sender: TObject);
var
  Rect: TRect;
begin
  rect := bg.CellRect(0,0);
  bg.Canvas.Brush.Color := clBtnFace;
  bg.Canvas.FillRect(rect);
  if row<>0 then
  begin
    rect := bg.CellRect(0,row);
    bg.Canvas.Brush.Color := clBtnFace;
    bg.Canvas.FillRect(rect);
  end;
  rect := bg.CellRect(0,row1);
  bg.Canvas.Draw(rect.Left+trunc((rect.Right-rect.Left-tx.Width)/2),rect.Top+trunc((20-tx.Height)/2),tx.Picture.Graphic);
  if col1 = qx then
  begin
    rect := bg.CellRect(col1,Row1);
    bg.Canvas.Brush.Color := clwhite;
    bg.Canvas.FillRect(rect);
    if gn[Row1-1].Qx= False then
    begin
      SetQx(rect,True);
      gn[Row1-1].Qx := True;
    end
    else
    begin
      SetQx(rect,False);
      gn[Row1-1].Qx := False;
    end;
  end;
  row := row1;
end;

procedure Tf_czygl.bgSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);

begin
  row1 := Arow;
  col1 := Acol;
end;

procedure Tf_czygl.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  Data.Query1.RequestLive := True;
  For i := low(gn) to high(gn)  do
  begin
    gn[i].Qx := False;
    Case i of
      0: gn[i].bnlb := '部门代码';
      1: gn[i].bnlb :='付款代码';
      2: gn[i].bnlb :='采购退货';
      3: gn[i].bnlb :='库存价格调整';
      4: gn[i].bnlb :='商品定价';
      5: gn[i].bnlb :='库存上下限管理';
      6: gn[i].bnlb :='库存资料维护';
      7: gn[i].bnlb :='报损处理';
      8: gn[i].bnlb :='报溢处理';
      9: gn[i].bnlb :='销售退货';
      10: gn[i].bnlb :='厂商结款';
      11: gn[i].bnlb :='厂商预付款';
      12: gn[i].bnlb :='客户结款';
      13: gn[i].bnlb :='客户预付款';
      14: gn[i].bnlb :='月成本核算';
      15: gn[i].bnlb :='利润分析';
    end;
    bg.Cells[gnzd,i+1]:= gn[i].bnlb;
  end;
  B4.OnClick(Sender);
end;

procedure Tf_czygl.SetQx(Rect: TRect; isyq: Boolean);
begin
  bg.Canvas.Brush.Color := clWhite;
  bg.Canvas.FillRect(rect);
  if isyq = False then
    bg.Canvas.Draw(rect.Left+trunc((rect.Right-rect.Left-tx1.Width)/2),rect.Top+trunc((20-tx1.Height)/2),tx1.Picture.Graphic)
  else
    bg.Canvas.Draw(rect.Left+trunc((rect.Right-rect.Left-tx2.Width)/2),rect.Top+trunc((20-tx2.Height)/2),tx2.Picture.Graphic);
end;

procedure Tf_czygl.IniGrid;
var
  rect1: TRect;
  i: Integer;
begin
  if Row1<>0 then
  begin
    rect1 := bg.CellRect(0,row1);
    bg.Canvas.Draw(rect1.Left+trunc((rect1.Right-rect1.Left-tx.Width)/2),rect1.Top+trunc((20-tx.Height)/2),tx.Picture.Graphic);
  end;
  For i :=1 to bg.RowCount-1 do
  begin
    rect1 := bg.CellRect(qx,i);
    if gn[i-1].Qx= False then
      SetQx(rect1,False)
    else
      SetQx(rect1,True);
  end;
  bg.Canvas.Brush.Color := clBtnFace;
  rect1 := bg.CellRect(0,0);
  bg.Canvas.FillRect(rect1);
end;

procedure Tf_czygl.B4Click(Sender: TObject);
var
  i: Integer;
begin
  with Data.Query1 do
  begin
    RequestLive := True;
    Close;
    SQL.Clear;
    SQL.Add('select * from t_czyxx');
    Open;
    RequestLive := False;
  end;                  
  if Data.Query1.RecordCount>0 then
  begin
    B2.Enabled := True;
    B5.Enabled := True;
    B9.Enabled := True;
    B10.Enabled := True;
    B11.Enabled := True;
    B12.Enabled := True;
    EditValue;
  end
  else
  begin
    B2.Enabled := False;//修改按钮不可用
    B5.Enabled := False;
    B9.Enabled := False;
    B10.Enabled := False;
    B11.Enabled := False;
    B12.Enabled := False;
    For i := 0 to 15 do
      gn[i].Qx := False;
    iniGrid;
  end;
end;

procedure Tf_czygl.EditValue;
var
  i: Integer;
begin
  czymc.Text:=Data.Query1.FieldByName('czymc').AsString;
  czymm.Text:=Data.Query1.FieldByName('czymm').AsString;
  czyjb.ItemIndex := Data.Query1.FieldByName('czyjb').AsInteger;
  with Data.Query2 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select * from t_czyqx where czymc = :a');
    ParamByName('a').AsString := Trim(czymc.Text);
    Open;
  end;
  For i := 1 to Data.Query2.FieldCount-1 do
  begin
    if Data.Query2.Fields[i].AsInteger = 1 then
      gn[i-1].Qx := False //没有权限
    else
      gn[i-1].Qx := True;
  end;
  IniGrid;
end;

procedure Tf_czygl.czymcKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
  begin
    if Trim(czymc.Text)<>'' then
    begin
      with Data.Query2 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select * from t_employee where ygdm = :a or ygmc = :a');
        ParamByName('a').AsString := Trim(czymc.Text);
        Open;
      end;
      if Data.Query2.RecordCount>0 then
      begin
        czymc.Text := Data.Query2.FieldByName('ygmc').AsString;
        czymm.SetFocus;
      end
      else
      begin
        czymc.Clear;
        Application.MessageBox('该员工不存在.','提示',64);
      end;
    end;
  end
  else if Key = vk_Next then
  begin
    if chb.Items.Count<1 then
    begin
      with Data.Query2 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select * from t_employee');
        Open;
      end;
      while Not Data.Query2.Eof do
      begin
        chb.Items.Add(Trim(Data.Query2.FieldByName('ygmc').AsString));
        Data.Query2.Next;
      end;
    end;
    SetListPos(czymc);
    chb.Visible := True;
    chb.ItemIndex := 0;
    chb.SetFocus;
  end;
end;

procedure Tf_czygl.SetListPos(WinControl: TWinControl);
begin
  chb.Top := WinControl.Top;
  chb.Left := WinControl.Left+(WinControl.Width-chb.Width);
  chb.Visible := True;
  chb.SetFocus;
end;

procedure Tf_czygl.chbExit(Sender: TObject);
begin
  inherited;
  chb.Visible := False;
end;

procedure Tf_czygl.chbKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
  begin
    if chb.Items.Count>0 then
      czymc.Text := chb.Items[chb.ItemIndex];