hisutilitis.pas

某大型医院护士站

unit HisUtilitis;
{$R-}
interface

uses Windows, Messages, SysUtils, CommDlg, Classes, Graphics, Controls,
  Forms, StdCtrls, Dialogs;

const
   UniqueKey :PChar = 'key';
   WindowName :PChar = '护士工作站管理系统';
   
procedure hisErrorPrompt(const ErrorStr : PChar);
procedure hisWarningPrompt(const WarningStr : PChar);
procedure hisInfoPrompt(const InfoStr : PChar);

function hisIsYesQuery(const QuestionStr : PChar) : Boolean;
function hisIsOKQuery(const QuestionStr : PChar) : Boolean;

function hisInputQuery(const ACaption, APrompt: string;
  var Value: string): Boolean;

{将日期时间数值向历史靠近,转换成正半点}
function cwlStdDateTime(const aDateTime : TDateTime) : TDateTime;
function IsNextInstance :Boolean;
procedure ActiveFirstInstanceWindow;

implementation

var MutexHandle :THandle;

procedure hisErrorPrompt(const ErrorStr : PChar);
begin
  Application.MessageBox(ErrorStr, '错误', MB_ICONERROR+MB_OK+MB_SETFOREGROUND);
end;

procedure hisWarningPrompt(const WarningStr : PChar);
begin
  Application.MessageBox(WarningStr, '警告', MB_ICONWARNING+MB_OK+MB_SETFOREGROUND);
end;

procedure hisInfoPrompt(const InfoStr : PChar);
begin
  Application.MessageBox(INfoStr, '信息', MB_ICONINFORMATION+MB_OK+MB_SETFOREGROUND);
end;

function hisIsYesQuery(const QuestionStr : PChar) : Boolean;
begin
  Result := Application.MessageBox(QuestionStr,'提问',
                MB_ICONQUESTION+MB_YESNO+MB_SETFOREGROUND) = IDYES;
end;

function hisIsOKQuery(const QuestionStr : PChar) : Boolean;
begin
  Result := Application.MessageBox(QuestionStr,'提问',
                MB_ICONQUESTION+MB_OKCANCEL+MB_SETFOREGROUND) = IDOK;
end;

function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

function hisInputQuery(const ACaption, APrompt: string;
  var Value: string): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do
    try
      Font.Name := '宋体';
      Font.Size := 9;
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      ClientHeight := MulDiv(63, DialogUnits.Y, 8);
      Position := poScreenCenter;
      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        AutoSize := True;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Caption := APrompt;
      end;
      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := MulDiv(19, DialogUnits.Y, 8);
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text := Value;
        SelectAll;
      end;
      ButtonTop := MulDiv(41, DialogUnits.Y, 8);
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '确定';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '取消';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      if ShowModal = mrOk then
      begin
        Value := Edit.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
end;

{将日期时间数值向(前)历史靠近,转换成正半点}
function cwlStdDateTime(const aDateTime : TDateTime) : TDateTime;
var
  DateTmp : Extended; //日期变量
  TimeTmp : Extended; //时间变量
  t1, t2 : Extended;
begin
  DateTmp := Int(aDateTime);  //取得日期部分
  TimeTmp := Frac(aDateTime); //取得时间部分

  t1 := trunc(TimeTmp*24*60); //取分钟数
  t2 := trunc(TimeTmp*24)*60; //取整点时的分钟数
  //如果分钟部分大于30,则结果为整点加30分钟
  if ( t1 - t2 ) >= 30 then
    TimeTmp := DateTmp + (t2 + 30)/24/60
  //否则,结果为相应的整点
  else
    TimeTmp := DateTmp + t2/24/60;
  Result := TimeTmp;
end;

function IsNextInstance :Boolean;
begin
  Result := False;
  MutexHandle := CreateMutex(NIL,TRUE ,UniqueKey);
  if MutexHandle <> 0 then
     if GetLastError = ERROR_ALREADY_EXISTS then
     begin
       Result := True;
       CloseHandle(MutexHandle);
     end;
end;

procedure ActiveFirstInstanceWindow;
var
  hPrev :hWnd;
begin
  hPrev := GetWindow(GetDesktopWindow ,GW_CHILD);
//  while hPrev <> null do
//  begin
    if GetProp(hPrev ,WindowName) <> 0 then
    begin
      if isIconic(hPrev) then
          ShowWindow(hPrev ,SW_RESTORE);

      SetForegroundWindow(hPrev);
      SetForegroundWindow(GetLastActivePopup(hPrev));
      halt;
    end;
//    hPrev := GetWindow(GetDesktopWindow ,GW_CHILD);
//  end;

end;

end.