sibofrm.pas

考勤管理是企业内部管理的重要环节和基础

unit SiBoFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ToolWin, ComCtrls, ExtCtrls, ImgList, Grids, DBGrids, Buttons,
  StdActns, ActnList, DBActns, CRLabel, jpeg, DB;

resourcestring
  sbackupPrompt='数据备份之前将关闭所有子窗口,是否继续?';
  sBackup='数据备份';
  sRestorePrompt='数据恢复之前将关闭所有子窗口,是否继续?';
  sRestore='数据恢复';
  sError='没有此月工资数据!!';
  sCaption='工资条打印';
  sCaption1='工资发放表';
  sCaption2='工资汇总表';
  sFilter='报表导出';
  sOption='打印选项';
  sPrinter='打印';

type
  TSiBoForm = class(TForm)
    MainMenu: TMainMenu;
    mmiFile: TMenuItem;
    mmiEdit: TMenuItem;
    mmiDoct: TMenuItem;
    mmiWindow: TMenuItem;
    mmiHelp: TMenuItem;
    mmiBackup: TMenuItem;
    mmiRestore: TMenuItem;
    N1: TMenuItem;
    mmiOperation: TMenuItem;
    mmiModify: TMenuItem;
    mmiChange: TMenuItem;
    N2: TMenuItem;
    mmiExit: TMenuItem;
    mmiCut: TMenuItem;
    mmiCopy: TMenuItem;
    mmiPaste: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    mmiSelectAll: TMenuItem;
    CoolBar1: TCoolBar;
    Animate1: TAnimate;
    CoolBar2: TCoolBar;
    N8: TMenuItem;
    mmiAccount: TMenuItem;
    mmiNavigation: TMenuItem;
    mmiCascade: TMenuItem;
    mmiTile: TMenuItem;
    mmiArrange: TMenuItem;
    N42: TMenuItem;
    N43: TMenuItem;
    N44: TMenuItem;
    N45: TMenuItem;
    N46: TMenuItem;
    N47: TMenuItem;
    N48: TMenuItem;
    N49: TMenuItem;
    N50: TMenuItem;
    ImageList1: TImageList;
    mmiCloseAll: TMenuItem;
    ActionList1: TActionList;
    EditCopy1: TEditCopy;
    EditCut1: TEditCut;
    EditPaste1: TEditPaste;
    mmiRefresh1: TDataSetRefresh;
    mmiPrior1: TDataSetPrior;
    mmiPost1: TDataSetPost;
    mmiNext1: TDataSetNext;
    mmiLast1: TDataSetLast;
    mmiInsert1: TDataSetInsert;
    mmiFirst1: TDataSetFirst;
    mmiEdit1: TDataSetEdit;
    mmiDelete1: TDataSetDelete;
    Edit1: TMenuItem;
    Insert1: TMenuItem;
    Delete1: TMenuItem;
    Last1: TMenuItem;
    Last2: TMenuItem;
    Last3: TMenuItem;
    N3: TMenuItem;
    Refresh1: TMenuItem;
    CoolBar3: TCoolBar;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    CoolBar4: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    TabSheet5: TTabSheet;
    imgMain: TImage;
    Panel1: TPanel;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ImageList2: TImageList;
    TabSheet6: TTabSheet;
    RLabel: TRunLabel;
    mmiDepartment: TMenuItem;
    mmiEmploy: TMenuItem;
    N11: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    mmiWorkPro: TMenuItem;
    mmiProject: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    mmiMakeNo: TMenuItem;
    mmiExpression: TMenuItem;
    mmiEmpType: TMenuItem;
    ActionList2: TActionList;
    backup: TAction;
    restore: TAction;
    Faccredit: TAction;
    department: TAction;
    emptype: TAction;
    employ: TAction;
    workpro: TAction;
    expression: TAction;
    makeNo: TAction;
    project: TAction;
    piecework: TAction;
    laborage: TAction;
    mmiDuty: TMenuItem;
    Report: TAction;
    BasePay: TAction;
    procedure FormCreate(Sender: TObject);
    procedure mmiNavigationClick(Sender: TObject);
    procedure mmiCascadeClick(Sender: TObject);
    procedure mmiTileClick(Sender: TObject);
    procedure mmiArrangeClick(Sender: TObject);
    procedure mmiCloseAllClick(Sender: TObject);
    procedure N42Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure mmiExitClick(Sender: TObject);
    procedure DepartmentExecute(Sender: TObject);
    procedure mmiModifyClick(Sender: TObject);
    procedure FaccreditExecute(Sender: TObject);
    procedure mmiChangeClick(Sender: TObject);
    procedure EmpTypeExecute(Sender: TObject);
    procedure WorkProExecute(Sender: TObject);
    procedure ProjectExecute(Sender: TObject);
    procedure MakeNoExecute(Sender: TObject);
    procedure PieceWorkExecute(Sender: TObject);
    procedure ExpressionExecute(Sender: TObject);
    procedure LaborageExecute(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure RestoreExecute(Sender: TObject);
    procedure backupExecute(Sender: TObject);
    procedure employExecute(Sender: TObject);
    procedure ReportExecute(Sender: TObject);
  private
    FOldClientProc,
    FNewClientProc: TFarProc;
    FDrawDC: hDC;
    FYear, FMonth, FDay:Word;
    procedure ClientWndProc(var Message: TMessage);
//    procedure DrawStretched;
    procedure DrawCentered;
//    procedure DrawTiled;
    procedure CycleRuning(Sender: TObject);
    { Private declarations }
  protected
    procedure CreateWnd; override;
  public
    { Public declarations }
  end;

var
  SiBoForm: TSiBoForm;

implementation

uses Globals, DepartmentFrm, EmployFrm, unDM2,dialog, SDIfrm, AccreditFrm,
ChangeUserFrm, DataBackupFrm, navigatefrm, ModiPassFrm, EmpTypeFrm,
  WorkProFrm, ProjectFrm, MakeFrm, PieceWorkFrm, ExpressionFrm,
  SelectMonthFrm, LaborageFrm, DutyFrm;

{$R *.DFM}

procedure TSiBoForm.CreateWnd;
begin
  inherited CreateWnd;
  // Turn the ClientWndProc method into a valid window procedure
  FNewClientProc := MakeObjectInstance(ClientWndProc);
  // Get a pointer to the original window procedure
  FOldClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  // Set ClientWndProc as the new window procedure
  SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FNewClientProc));
end;

procedure TSiBoForm.DrawCentered;
{ This procedure centers the image on the form's client area }
var
  CR: TRect;
begin
  GetWindowRect(ClientHandle, CR);
   with imgMain do
     BitBlt(FDrawDC, ((CR.Right - CR.Left) - Picture.Width) div 2,
            ((CR.Bottom - CR.Top) - Picture.Height) div 2,
            Picture.Graphic.Width, Picture.Graphic.Height,
            Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

{
procedure TSiBoForm.DrawStretched;
// This procedure stretches the image on the form's client area
var
  CR: TRect;
begin
  GetWindowRect(ClientHandle, CR);
  StretchBlt(FDrawDC, 0, 0, CR.Right, CR.Bottom,
             imgMain.Picture.Bitmap.Canvas.Handle, 0, 0,
             imgMain.Picture.Width, imgMain.Picture.Height, SRCCOPY);
end;

procedure TSiBoForm.DrawTiled;
// This procedure tiles the image on the form's client area
var
  Row, Col: Integer;
  CR, IR: TRect;
  NumRows, NumCols: Integer;
begin
  GetWindowRect(ClientHandle, CR);
  IR := imgMain.ClientRect;
  NumRows := CR.Bottom div IR.Bottom;
  NumCols := CR.Right div IR.Right;
  with imgMain do
    for Row := 0 to NumRows+1 do
      for Col := 0 to NumCols+1  do
        BitBlt(FDrawDC, Col * Picture.Width, Row * Picture.Height,
               Picture.Width, Picture.Height, Picture.Bitmap.Canvas.Handle,
               0, 0, SRCCOPY);
end;
}

procedure TSiBoForm.ClientWndProc(var Message: TMessage);
begin
  case Message.Msg of
    // Capture the WM_ERASEBKGND messages and perform the client area drawing
    WM_ERASEBKGND:
      begin
        CallWindowProc(FOldClientProc, ClientHandle, Message.Msg, Message.wParam,
          Message.lParam);
        FDrawDC := TWMEraseBkGnd(Message).DC;
          DrawCentered;
{        if mmiStretch.Checked then
          DrawStretched
        else if mmiCenter.Checked then
          DrawCentered
        else DrawTiled;
}//
        Message.Result := 1;
      end;
    { Capture the scrolling messages and ensure the the client area
      is redrawn by calling InvalidateRect }
    WM_VSCROLL, WM_HSCROLL:
      begin
        Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
          Message.wParam, Message.lParam);
        InvalidateRect(ClientHandle, nil, True);
      end;
    else
    // By Default, call the original window procedure
      Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
        Message.wParam, Message.lParam);
  end; { case }
end;

procedure TSiBoForm.CycleRuning(Sender: TObject);
begin
  RLabel.RLStart( -1);
end;

procedure TSiBoForm.FormCreate(Sender: TObject);
var
  i,laccredit,l:integer;
begin
    width:=screen.Width;
    height:=screen.Height-30;
    CoolBar1.Left:=Width-BorderWidth-85;
    CoolBar3.Left:=CoolBar4.Width+1;
    CoolBar3.Width:=Width-BorderWidth*2-CoolBar4.Width-CoolBar1.Width-2;
    CoolBar2Height:=CoolBar2.Height;
    RLabel.OnEnd:= CycleRuning;
    RLabel.RLStart(0);
    Animate1.FileName:=myGetCurrentDirectory()+'\cool.avi';
    Animate1.Active:=True;
    laccredit:=accredit;
    l:=1;
    for i:=0 to actionlist2.ActionCount-1 do begin
      case i of
        0:begin
          if (laccredit and l)=1 then
            backup.Enabled:=True
          else
            backup.Enabled:=False;
        end;
        1:begin
          if (laccredit and l)=1 then
            restore.Enabled:=True
          else
            restore.Enabled:=False;
        end;
        2:begin
          if (laccredit and l)=1 then
            Faccredit.Enabled:=True
          else
            Faccredit.Enabled:=False;
        end;
        3:begin
          if (laccredit and l)=1 then
            department.Enabled:=True
          else
            department.Enabled:=False;
        end;
        4:begin
          if (laccredit and l)=1 then
            emptype.Enabled:=True
          else
            emptype.Enabled:=False;
        end;
        5:begin
          if (laccredit and l)=1 then
            employ.Enabled:=True
          else
            employ.Enabled:=False;
        end;
        6:begin
          if (laccredit and l)=1 then
            workpro.Enabled:=True
          else
            workpro.Enabled:=False;
        end;
        7:begin
          if (laccredit and l)=1 then
            expression.Enabled:=True
          else
            expression.Enabled:=False;
        end;
        8:begin
          if (laccredit and l)=1 then
            makeNo.Enabled:=True
          else
            makeNo.Enabled:=False;
        end;
        9:begin
          if (laccredit and l)=1 then
            project.Enabled:=True
          else
            project.Enabled:=False;
        end;
        10:begin
          if (laccredit and l)=1 then
            piecework.Enabled:=True
          else
            piecework.Enabled:=False;
        end;
        11:begin
          if (laccredit and l)=1 then
            laborage.Enabled:=True
          else
            laborage.Enabled:=False;
        end;
        12:begin
          if (laccredit and 1)=1 then
            Report.Enabled:=True
          else
            Report.Enabled:=False;
        end;
        13:begin
          if (laccredit and 1)=1 then
            GetText:=True
          else
            GetText:=False
        end;
      end;
      Laccredit:=laccredit shr 1;
    end;
end;

procedure TSiBoForm.mmiNavigationClick(Sender: TObject);