ceglobal.pas

群星医药系统源码

//{$define useRzComp}
{$define useEhLib}
{$define useEhLibEx}
{$ifdef useEhLibEx}
  {$define useEhLib}
{$endif}
{.$I VER_ChainEnt.INC}

unit ceGlobal;

interface
uses
  {$ifdef VER_DebugMode}csIntf, {$endif}
  {$ifdef useEhLib}DBGridEh, {$endif}
  {$ifdef useEhLibEx}xEhLibCtl, {$endif}
//	{$ifdef useRzComp} RzEdit, RzDBEdit, RzRadGrp, RzDTP, RzDbDTP, {$endif}
  windows, Messages, Classes, SysUtils, controls, stdctrls, comctrls, TypInfo,
  ExtCtrls, Forms, IniFiles, DBClient, IMainFrm, uDataTypes,DB;

  
type
  TDefault = Record
    EligibleCard : WideString;   //合格证
    QualityState : WideString;   //外观质量
    PackageState : WideString;   //包装
    LabelState   : WideString;   //标签
    Directions   : WideString;   //说明书
    CheckVerdict : WideString;   //结论
    Checker      : WideString;   //验收人
    Accepter     : WideString;   //收货人
  End;
  PDefault = ^TDefault;


procedure xSetReDraw(Handle:integer; CanReDraw : Boolean);
procedure xSetAllEmpty(Comp : TWinControl; Recursive: Boolean=false);
procedure xSetAllReadOnly(Comp: TWinControl; ReadOnly: Boolean; Recursive: Boolean=false; IgnoreTag: Integer=-1; IgnSelfTag: Integer=-2);
procedure xSetAllCtrlEnable(Comp: TWinControl; Enabled: Boolean; Recursive: Boolean=false; IgnoreTag: Integer=-1; IgnSelfOnly: Boolean=true);
function  BuildBillNo(BillType: String): String;
procedure CheckDataCanModify(BillType, BillCreater: String; BillGroup: Integer);
function  DataCanModify(BillType, BillCreater: String; BillGroup: Integer): Boolean;
//取得汉字串的拼音首字符
function  BuildSpellHeadOfHZ(HZString: string; bUpperCase: boolean=true): string;
{$ifdef useEhLibEx}
procedure SetGridEhColor(Grids: Array of TxDBGridEh);
{$endif}

var
  sIniFileName, XMLPath: String;
  cdsBillSetting: TClientDataSet;
  FormBackColor: integer = $00EFEFEF;
  TitlePanelColor:integer= $00C2DEC2;
  GridFixColor:  integer = $00EFE7E7;
  GridRowColor1: Integer = $00FFEEEE;//$00C6DEC6
  GridRowColor2: Integer = $02FFFFFF;
  NavigationBack: Integer = $00FEEFED;
  NavigationGradient: integer = $00FBBAB1;
  UseSysMenuColor: Boolean = true;
  MenuColor: integer = 16777215;
  MenuIconBackColor : integer = -16777212;

implementation

function  BuildBillNo(BillType: String): String;
var SystemTime: TSystemTime;
    iBranchNo,iMachineNo : Integer;
    sResult,sTime,sYear,sMonth,sDay,sBranchNo,sMachineNo,sPrefix: String;
begin
  sResult := '';
  if not cdsBillSetting.Active then
    cdsBillSetting.LoadFromFile(XMLPath+'BillSetting.xml');
  If cdsBillSetting.Locate('BillType',Billtype,[loCaseInsensitive]) then
    sPrefix := Trim(CdsBillSetting.FieldByName('Prefix').AsString);
  GetLocalTime(SystemTime);
  iBranchNo  := (Application.MainForm as iMainForm).IFmMainEx.GetLocSetting^.BranchNo;
  iMachineNo := (Application.MainForm as iMainForm).IFmMainEx.GetLocSetting^.MachineNo;
  sBranchNo  := FormatFloat('000',iBranchNo);
  sMachineNo := FormatFloat('00',iMachineNo);
  sYear := FormatFloat('00',SystemTime.wYear-(SystemTime.wYear div 100)*100);
  sMonth:= FormatFloat('00',SystemTime.wMonth);
  sDay  := FormatFloat('00',SystemTime.wDay);
  sTime := FormatFloat('00000',SystemTime.wHour*3600+SystemTime.wMinute*60+SystemTime.wSecond);
  sResult := sPrefix+sYear+sMonth+sDay+sBranchNo+sMachineNo+sTime;
  Result :=sResult;
end;

procedure CheckDataCanModify(BillType, BillCreater: String; BillGroup: Integer);
begin
  if not DataCanModify(BillType, BillCreater, BillGroup) then
    raise Exception.Create('对不起，你无权对当前数据执行修改操作！');
end;

function  DataCanModify(BillType, BillCreater: String; BillGroup: Integer): Boolean;
var iDBModiRange: Integer;
    LogonInfo: PLogonInfo;
begin
  Result := false;
  if not cdsBillSetting.Active then
    cdsBillSetting.LoadFromFile(XMLPath+'BillSetting.xml');
  LogonInfo := (Application.MainForm as IMainForm).IFmMainEx.LogonInfo;
  if cdsBillSetting.Locate('BillType',Billtype,[]) then
    iDBModiRange := cdsBillSetting.fieldByName('DBModiRange').AsInteger
  else
    iDBModiRange := 2;//如果找不到匹配的设置则默认只允许资料创建者修改
  if LogonInfo^.DBModiRange>iDBModiRange then
    iDBModiRange := LogonInfo^.DBModiRange;
  case iDBModiRange of
    0: Result := true;
    1: Result := BillGroup=LogonInfo^.UserGrupID;
    2: Result := BillCreater=LogonInfo^.UserID;
  end;
end;

procedure xSetReDraw(Handle:integer; CanReDraw : Boolean);
begin
	SendMessage(Handle, WM_SETREDRAW, integer(CanReDraw), 0);
end;

procedure xSetAllEmpty(Comp : TWinControl; Recursive: Boolean);
var n, k : integer;
		vCtrl: TControl;
begin
	k := Comp.ControlCount;
  for n:=0 to k-1 do begin
    vCtrl := Comp.Controls[n];
  	if Recursive and (vCtrl is TWinControl) then
      xSetAllEmpty(vCtrl as TWinControl, Recursive);
  	if vCtrl is TCustomEdit then
    	(vCtrl as TCustomEdit).Text := ''
    else if vCtrl is TComboBox then
    	(vCtrl as TComboBox).Text := ''
    else if vCtrl is TCheckBox then
    	(vCtrl as TCheckBox).Checked := false;
  end;
end;

{设置控件下所有子控件的只读属性
Recursive：是否递归设置子控件的子控件的...属性
IgnoreTag：如果某一控件的Tag值为该值则忽略设置此控件包括其子控件
IgnSelfTag:如果某一控件的Tag值为该值则仅忽略设置此控件，如果递归有效的话还会设置其子控件
}
procedure xSetAllReadOnly(Comp: TWinControl; ReadOnly: Boolean; Recursive: Boolean;
  IgnoreTag, IgnSelfTag: Integer);
var n, k : integer;
		vCtrl: TControl;
    p1: PPropInfo;
    b1, b2: Boolean;
    {$ifdef VER_DebugMode}csObj: TCSGlobalObject; {$endif}
begin
  {$ifdef VER_DebugMode}
  csObj := TCSGlobalObject.Create(nil);
  {$endif}
	k := Comp.ControlCount;
  for n:=0 to k-1 do begin
    vCtrl := Comp.Controls[n];
    if vCtrl is TCustomLabel then Continue;
    b1 := vCtrl.Tag<>IgnoreTag;
    b2 := vCtrl.Tag<>IgnSelfTag;
    if b1 and b2 then begin //判断是否忽略该控件
      p1 := GetPropInfo(vCtrl.ClassInfo, 'Readonly');
      if p1<>nil then
        SetPropValue(vCtrl, 'Readonly', ReadOnly)
      else
        vCtrl.Enabled := not ReadOnly;
      {$ifdef VER_DebugMode}
      CodeSite.SendObject(Comp.Name+'.Items['+IntToStr(n)+']:', vCtrl);
      {$endif}
    end;
  	if Recursive and b1 then begin
      b1 := (vCtrl is TCustomControl){ or (vCtrl is ...};
      if b1 and (vCtrl.Enabled=true) then
        xSetAllReadOnly(vCtrl as TWinControl, ReadOnly, Recursive, IgnoreTag, IgnSelfTag);
    end;
  end;
  {$ifdef VER_DebugMode}
  csObj.Free;
  {$endif}
end;
(*原xSetAllReadOnly过程中的核心代码，现已改为用TypInfo单元提供的相关过程实现
    if vCtrl is TEdit then
      (vCtrl as TEdit).ReadOnly := ReadOnly
    else if vCtrl is TDBEdit then
      (vCtrl as TDBEdit).ReadOnly := ReadOnly
    else if vCtrl is TDBLookupComboBox  then
      (vCtrl as TDBLookupComboBox).ReadOnly := ReadOnly
    else if vCtrl is TDBGrid then
      (vCtrl as TDBGrid).ReadOnly := ReadOnly
    {$ifdef useRzComp}//要将判断是否为数据敏感控件的代码放前面
    //保留下面二行是因为虽然TRzDBDateTimePicker.ReadOnly=false与TRzDateTimePicker.Enabled=false是一样的，但外观上还是有差别的
    else if vCtrl is TRzDBDateTimePicker then
      (vCtrl as TRzDBDateTimePicker).ReadOnly := ReadOnly
    else if vCtrl is TRzDBEdit then
      (vCtrl as TRzDBEdit).ReadOnly := ReadOnly
    else if vCtrl is TRzEdit then
      (vCtrl as TRzEdit).ReadOnly := ReadOnly
    {$endif}
    {$ifdef useEhLib}
    else if vCtrl is TDBGridEh then
      (vCtrl as TDBGridEh).ReadOnly := ReadOnly
    {$endif}

    else if vCtrl is TCustomComboBox then
      (vCtrl as TCustomComboBox).Enabled := not ReadOnly
    else if vCtrl is TCustomCheckBox then
      (vCtrl as TCustomCheckBox).Enabled := not ReadOnly
    else if vCtrl is TCustomGroupBox then
      (vCtrl as TCustomGroupBox).Enabled := not ReadOnly
    {$ifdef useRzComp}
    else if vCtrl is TRzCustomRadioGroup then
      (vCtrl as TRzCustomRadioGroup).Enabled := not ReadOnly
    else if vCtrl is TRzDateTimePicker then
      (vCtrl as TRzDateTimePicker).Enabled := not ReadOnly
    {$endif}
    else if vCtrl is TDateTimePicker then
      (vCtrl as TDateTimePicker).Enabled := not ReadOnly;
*)

procedure xSetAllCtrlEnable(Comp: TWinControl; Enabled: Boolean; Recursive: Boolean;
  IgnoreTag: Integer; IgnSelfOnly: Boolean);
var n, k : integer;
		vCtrl: TControl;
begin
	k := Comp.ControlCount;
  for n:=0 to k-1 do begin
    vCtrl := Comp.Controls[n];
    if vCtrl.Tag = IgnoreTag then Continue; //如果忽略该控件
  	if Recursive and (vCtrl is TWinControl)then
      xSetAllCtrlEnable(vCtrl as TWinControl, Enabled, Recursive);
    vCtrl.Enabled := Enabled;
  end;
end;

function BuildSpellHeadOfHZ(HZString: string; bUpperCase: boolean): string;
type
  TPyHeadOfHz = Function(HZStr: PChar): PChar stdcall;
var hLib: THandle;
    proc: TFarProc;
    i: integer;
begin
  Result := '';
  i :=1;
  hLib := LoadLibrary('GetHZSpell.dll');
  if hLib >= 32 then
  try
    proc := GetProcAddress(hLib,'PyHeadOfHz');
    if proc<>nil then
      Result := StrPas(TPyHeadOfHz(proc)(PChar(HZString)));
    while (i<=Length(Result))and(Result[i]>='A')and(Result[i]<='z') do inc(i);
    Result := Copy(Result,1,i-1);
    if bUpperCase then
      Result := UpperCase(Result);
  finally
    FreeLibrary(hLib);
  end;
end;

{$ifdef useEhLibEx}
procedure SetGridEhColor(Grids: Array of TxDBGridEh);
var i, k: integer;
begin
  k := Length(Grids);
  for i:=0 to k-1 do begin
    Grids[i].RowColor1 := GridRowColor1;
    Grids[i].RowColor2 := GridRowColor2;
    Grids[i].FixedColor:= GridFixColor;
    Grids[i].RowColorsUse := true;
  end;
end;
{$endif}

initialization
  cdsBillSetting := TClientDataSet.Create(nil);
  XMLPath := ExtractFilePath(ParamStr(0))+'XML\';
  if Application.MainForm.ClassName<>'TAppBuilder' then begin
    sIniFileName := (Application.MainForm as IMainForm).IniFileName;
    if FileExists(sIniFileName) then
      with TIniFile.Create(sIniFileName) do begin
        FormBackColor := ReadInteger('LocaSetting', 'FormBackColor', FormBackColor);
        TitlePanelColor:=ReadInteger('LocaSetting', 'TitlePanelColor', TitlePanelColor);
        GridFixColor  := ReadInteger('LocaSetting', 'GridFixColor',  GridFixColor);
        GridRowColor1 := ReadInteger('LocaSetting', 'GridRowColor1', GridRowColor1);
        GridRowColor2 := ReadInteger('LocaSetting', 'GridRowColor2', GridRowColor2);
        NavigationBack := ReadInteger('LocaSetting','NavigationBack',NavigationBack);
        NavigationGradient := ReadInteger('LocaSetting','NavigationGradient',NavigationGradient);
        MenuColor := ReadInteger('LocaSetting','MenuColor',MenuColor);
        MenuIconBackColor := ReadInteger('LocaSetting','MenuIconBackColor',MenuIconBackColor);
        Free;
      end;
  end;

finalization
  cdsBillSetting.Free;

end.