fpxl_pas.pas

delphi6.0电子寻更源程序,用来计算保安有无查抄

unit fpxl_pas;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, StdCtrls, Buttons, RXCtrls, ExtCtrls, DBCtrls;

type
  Tfpxl = class(TForm)
    Panel2: TPanel;
    DBGrid2: TDBGrid;
    Panel3: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Panel4: TPanel;
    DBGrid1: TDBGrid;
    Panel5: TPanel;
    DBLookupComboBox1: TDBLookupComboBox;
    Label2: TLabel;
    BitBtn10: TBitBtn;
    procedure DBLookupComboBox1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitBtn10Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fpxl: Tfpxl;

implementation
uses dm_fpxl_pas,menu;
{$R *.DFM}

procedure Tfpxl.DBLookupComboBox1Click(Sender: TObject);
begin
with dm_fpxl.q_fpxl do
begin
close;
parambyname('code').asstring:=varastype(dblookupcombobox1.keyvalue,varstring);
open;
end;
end;

procedure Tfpxl.FormShow(Sender: TObject);
var
  i1,i2,i3:integer;
  f1,f2:real;
begin
if (screen.Height<600) and( screen.Width<800) then
  begin
  scaled:=true;
  self.height:=round(382*longint(screen.height)*96 / 600/screen.pixelsperinch);
  self.width :=round( 610 *longint(screen.width)*96 / 800/screen.pixelsperinch);
  ScaleControls(screen.width, 800);
  ScaleControls(96,screen.pixelsperinch);
   f1:=screen.width*96/800/screen.pixelsperinch;
  f2:=screen.width/800;
  with dbgrid1  do
  begin
    i1:=columns.Count;
    i3:=round(12*f1);if i3<7  then i3:=7;
    //panel1.Font.size:=20;
    BitBtn1.font.size:=i3-1;
    BitBtn2.font.size:=i3-1;
    BitBtn10.font.size:=i3-1;
    label2.font.size:=i3-1;
    dblookupcombobox1.font.size:=i3-1;
    font.size:=i3-1;
    for i2:=0 TO i1-1 DO
    begin
      columns[i2].title.font.size:=i3-1;
      columns[i2].width:=round(columns[i2].width*f2);
    end;
  end;
  with dbgrid2  do
  begin
    i1:=columns.Count;
    font.size:=i3-1;
    for i2:=0 TO i1-1 DO
    begin
      columns[i2].title.font.size:=i3-1;
      columns[i2].width:=round(columns[i2].width*f2);
    end;
  end;

  end
  else
  begin
self.Height:=382;
self.Width:=609;
  end;
//if not assigned(DM_fpxl) then
  //Application.CreateForm(TDM_fpxl, dm_fpxl);
with dm_fpxl do
 begin
q_ry.close;
q_xl.close;
 q_fpxl.close;
 q_ry.open;
 q_xl.open;
 q_fpxl.open;
 end;
end;

procedure Tfpxl.BitBtn2Click(Sender: TObject);
begin
if dblookupcombobox1.Text='' then
  begin
    Application.MessageBox('必須選擇巡更員','消息',MB_ICONINFORMATION);
    exit;
  end;
with dm_fpxl do
 begin
 q_fpxl_test.close;
 q_fpxl_test.parambyname('code').asstring:=varastype(dblookupcombobox1.keyvalue,varstring);
 q_fpxl_test.parambyname('shift').asstring:=q_xl.fieldbyname('shifts').asstring;
 q_fpxl_test.parambyname('linename').asstring:=q_xl.fieldbyname('linename').asstring;
 q_fpxl_test.open;
 if q_fpxl_test.RecordCount>0 then
 begin
 Application.MessageBox('該線路/班次已經存在，請重新選擇！','消息',MB_ICONINFORMATION);
 exit;
 end;
 with dm_fpxl.q_fpxl do
 begin
   append;
   edit;
   fieldbyname('code').asstring:= varastype(dblookupcombobox1.keyvalue,varstring);
   fieldbyname('shift').asstring:=dm_fpxl.Q_xl.fieldbyname('shifts').asstring;
   fieldbyname('linename').asstring:=dm_fpxl.q_xl.fieldbyname('linename').asstring;
   post;
 end;
 end;

end;

procedure Tfpxl.BitBtn1Click(Sender: TObject);
begin
if  dm_fpxl.q_fpxl.Eof then
begin
Application.MessageBox('沒有可以移去的線路/班次.','消息',MB_ICONINFORMATION);
exit;
//dm_fpxl.q_fpxl.Delete;
end;
dm_fpxl.q_fpxl.Delete;
end;

procedure Tfpxl.BitBtn5Click(Sender: TObject);
begin
close;
end;

procedure Tfpxl.FormCreate(Sender: TObject);
begin
if not assigned(DM_fpxl) then
  Application.CreateForm(TDM_fpxl, dm_fpxl);

end;

procedure Tfpxl.FormClose(Sender: TObject; var Action: TCloseAction);
begin
dm_fpxl.free;
dm_fpxl:=nil;
action:=cafree;
fpxl :=nil ;
end;

procedure Tfpxl.BitBtn10Click(Sender: TObject);
begin
close;
end;

procedure Tfpxl.Button1Click(Sender: TObject);
begin
Application.MessageBox(Pchar('width='+inttostr(self.width)+'--'+'height='+inttostr(self.height)+'--'+'left='+inttostr(self.left)+'--top='+inttostr(self.top)),'消息',MB_ICONINFORMATION);

end;

end.