wsutils.pas

企业ERP管理系统

  I: Integer;
begin
  if DataSet <> nil then
    with DataSet do
    begin
      try
        if not Succeeded(GetActiveObject(CLASS_ExcelApplication, nil, Unknown)) then
          Unknown := CreateComObject(CLASS_ExcelApplication);
      except
        raise Exception.Create('不能启动 Microsoft Excel，请确认 Microsoft Excel 已正确安装在本机上');
      end;
      ExcelApp := Unknown as IDispatch;
      ExcelApp.Visible := True;
      ExcelApp.Workbooks.Add;
      Sheet := ExcelApp.ActiveSheet;
      if DisableScreenUpdating then
        ExcelApp.ScreenUpdating := False;
      DisableControls;
      try
        Bm := Bookmark;
        First;
        Row := 4;
        Col := 1;
        for I := 0 to Fields.Count - 1 do
        begin
          if Fields[I].Visible then
            ExcelApp.Cells[Row, Col] := Fields[I].DisplayLabel;
          Inc(Col);
        end;
        Inc(Row);
        while not EOF do
        begin
          Col := 1;
          for I := 0 to Fields.Count - 1 do
          begin
            if Fields[I].Visible then
              if Fields[I] <> nil then
                ExcelApp.Cells[Row, Col] := Fields[I].DisplayText;
            Inc(Col);
          end;
          Inc(Row);
          Next;
        end;
        Col := 1;
        for I := 0 to Fields.Count - 1 do
        begin
          if Fields[I].Visible then
            ExcelApp.Columns[Col].AutoFit; ;
          Inc(Col);
        end;
        ExcelApp.Cells[1, 1] := ReportCaption;
        ExcelApp.Cells[2, 1] := ReportMemo;
        ExcelApp.Cells[3, 1] := ReportTtl;
        Bookmark := Bm;
      finally
        EnableControls;
        if not ExcelApp.ScreenUpdating then
          ExcelApp.ScreenUpdating := True;
      end;
    end;
  if AddChart then
  begin
    Sheet := ExcelApp.ActiveSheet;
    Sheet.Range[Sheet.Cells[4, 1], Sheet.Cells[Row - 1, Col - 1]].Select;
    Chart := ExcelApp.ActiveWorkbook.Charts.Add;
    Chart.SetSourceData(
      Sheet.Range[Sheet.Cells[4, 1], Sheet.Cells[Row - 1, Col - 1]], EmptyParam);
    Chart.Location(1, EmptyParam);
  end;
  ExcelApp.ActiveWorkbook.PrintPreview;
end;

procedure ExportDBGridToExcel(Grid: TDBGrid; DisableScreenUpdating: Boolean;
  ReportCaption,ReportMemo,ReportTtl :string; AddChart: Boolean);
const
  CLASS_ExcelApplication: TGUID = '{00024500-0000-0000-C000-000000000046}';

var
  ExcelApp, Sheet, Chart: OleVariant;
  Unknown: IUnknown;
  Bm: TBookmarkStr;
  Col, Row: Integer;
  I: Integer;
begin
  if (Grid.DataSource <> nil) and (Grid.DataSource.DataSet <> nil) then
    with Grid.DataSource.DataSet do
    begin
      try
        if not Succeeded(GetActiveObject(CLASS_ExcelApplication, nil, Unknown)) then
          Unknown := CreateComObject(CLASS_ExcelApplication);
      except
        raise Exception.Create('不能启动 Microsoft Excel，请确认 Microsoft Excel 已正确安装在本机上');
      end;
      ExcelApp := Unknown as IDispatch;
      ExcelApp.Visible := True;
      ExcelApp.Workbooks.Add;
      if DisableScreenUpdating then
        ExcelApp.ScreenUpdating := False;
      DisableControls;
      try
        Bm := Bookmark;
        First;
        Row := 4;
        Col := 1;
        for I := 0 to Grid.Columns.Count - 1 do
        begin
          if Grid.Columns[I].Visible then
            ExcelApp.Cells[Row, Col] := Grid.Columns[I].Title.Caption;
          Inc(Col);
        end;
        Inc(Row);
        while not EOF do
        begin
          Col := 1;
          for I := 0 to Grid.Columns.Count - 1 do
          begin
            if Grid.Columns[I].Visible then
              if Grid.Columns[I].Field <> nil then
                ExcelApp.Cells[Row, Col] := Grid.Columns[I].Field.DisplayText;
            Inc(Col);
          end;
          Inc(Row);
          Next;
        end;
        Col := 1;
        for I := 0 to Grid.Columns.Count - 1 do
        begin
          if Grid.Columns[I].Visible then
            ExcelApp.Columns[Col].AutoFit; ;
          Inc(Col);
        end;
        ExcelApp.Cells[1, 1] := ReportCaption;
        ExcelApp.Cells[2, 1] := ReportMemo;
        ExcelApp.Cells[3, 1] := ReportTtl;
        Bookmark := Bm;
      finally
        EnableControls;
        if not ExcelApp.ScreenUpdating then
          ExcelApp.ScreenUpdating := True;
      end;
    end;
  if AddChart then
  begin
    Sheet := ExcelApp.ActiveSheet;
    Sheet.Range[Sheet.Cells[4, 1], Sheet.Cells[Row - 1, Col - 1]].Select;
    Chart := ExcelApp.ActiveWorkbook.Charts.Add;
    Chart.SetSourceData(
      Sheet.Range[Sheet.Cells[4, 1], Sheet.Cells[Row - 1, Col - 1]], EmptyParam);
    Chart.Location(1, EmptyParam);
  end;
  ExcelApp.ActiveWorkbook.PrintPreview;
end;

function GetTempFileName(const FileName: string): string;
var
  Path: array[0..255] of Char;
  FName: array[0..MAX_PATH - 1] of Char;
begin
  SetLength(Result, MAX_Path);
  GetTempPath(256, Path);
  Windows.GetTempFileName(Path, PChar(FileName), 0, FName);
  Result := FName;
end;


//完成了无限制编码.支持 1.限定字符+数字方式 2.限定字符+字母方式 3.限定字符+数字+字母.
//三个参数分别是Number(数字)/Letter(字母)/Ascii(数字+字母)
//胡建平

function Coding(value: widestring; flag: tflag): string;
var
  temp: array[0..254] of widechar;
  i, k: integer;
begin
  if Trim(value) = '' then Value := '00000';
  value := uppercase(value);
  for i := 0 to 254 do temp[i] := widechar($D);
  k := 0;
  if flag = ascii then
  begin
    for i := 1 to length(value) do
      if (integer(value[i]) > 57) and (integer(value[i]) < 65) or (integer(value[i]) > 90)
        or (integer(value[i]) < 48) then
      begin
        temp[i] := value[i];
        value[i] := widestring('天')[1];
      end;
    k := 91;
  end;
  if flag = number then
  begin
    for i := 1 to length(value) do
      if (integer(value[i]) > 57) or (integer(value[i]) < 48) then
      begin
        temp[i] := value[i];
        value[i] := widestring('天')[1];
      end;
    k := 58;
  end;
  if flag = letter then
  begin
    for i := 1 to length(value) do
      if not (integer(value[i]) in [65..90]) then
      begin
        temp[i] := value[i];
        value[i] := widestring('天')[1];
      end;
    k := 91;
  end;
  value := stringreplace(value, '天', '', [rfreplaceall]);
  value[length(value)] := widechar(integer(value[length(value)]) + 1);
  if flag = number then
  begin
    for i := length(value) downto 2 do
      if integer(value[i]) = k then
      begin
        value[i - 1] := widechar(integer(value[i - 1]) + 1);
        value[i] := widechar('0');
      end;
  end;
  if flag = letter then
  begin
    for i := length(value) downto 2 do
      if integer(value[i]) = k then
      begin
        value[i - 1] := widechar(integer(value[i - 1]) + 1);
        value[i] := widechar('A');
      end;
  end;
  if flag = ascii then
  begin
    for i := length(value) downto 2 do
    begin
      if integer(value[i]) = k then
      begin
        value[i - 1] := widechar(integer(value[i - 1]) + 1);
        value[i] := widechar('0');
      end;
      if integer(value[i]) = 58 then
      begin
        value[i] := 'A';
      end;
    end;
  end;
  if integer(value[1]) = k then
  begin
    messageboxex(application.Handle, '数据范围超出设定位数,请查证数据', '提示',
      MB_ICONWARNING or MB_OK or MB_APPLMODAL, 936);
    result := '00000000001';
    exit;
  end;
  for i := 0 to 254 do
    if temp[i] <> widechar($D) then insert(temp[i], value, i);
  result := value;
end;

function GetMaxCode(Field: string; Table: string; Value: TFlag): string;
var
  adoTemp: TADOQuery;
  c: string;
begin
  Screen.Cursor := CrHourglass;
  adoTemp := TADOQuery.Create(nil);
  adoTemp.Connection := CommonData.acnConnection;
  with adoTemp do
  begin
    close;
    //sql.Text := 'Select Max(' + Field + ') as ' + Field + ' from ' + Table;
    sql.Text := 'Select ' + Field + ' as ' + Field + ' from ' + Table + ' where ID=(Select Max(ID) from ' + Table + ')';
    open;
    if RecordCount = 0 then
      c := ''
    else
      c := fieldbyname(Field).AsString;
  end;
  result := coding(c, Value);
  Screen.Cursor := CrDefault;
end;

var
  ReportsDLLHandle: THandle;

function ReportsLibHandle: THandle;
var
  InitLibrary: procedure(App: TApplication); stdcall;
begin
  if ReportsDLLHandle = 0 then
  begin
    ReportsDLLHandle := LoadLibrary('Reports.DLL');
    if ReportsDLLHandle = 0 then
      raise Exception.Create('找不到报表动态连接库 Reports.DLL');
    @InitLibrary := GetProcAddress(ReportsDLLHandle, 'InitLibrary');
    InitLibrary(Application);
  end;
  Result := ReportsDLLHandle;
end;

procedure RunReportExplorer;
var
  RunExplorer: procedure; stdcall;
begin
  @RunExplorer := GetProcAddress(ReportsLibHandle, 'RunReportExplorer');
  RunExplorer;
end;

procedure PrintReport(const ReportName, Params, DeviceType: string);
var
  PReport: procedure (const ReportName, Params, ADeviceType: string); stdcall;
begin
  @PReport := GetProcAddress(ReportsLibHandle, 'PrintReport');
  PReport(ReportName, Params, DeviceType);
end;

function NumberToHZ(Value: Extended; Style: Integer): string;
const
  HZNumbers: array[0..1, 0..9] of string =
    (('零', '一', '二', '三', '四', '五', '六', '七', '八', '九'),
    ('零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖'));
  HZNumberUnits: array[0..1, 0..12] of string =
    (('', '十', '佰', '仟', '万', '拾', '佰', '仟', '亿', '拾', '佰', '仟', '万'),
    ('', '拾', '佰', '仟', '万', '拾', '佰', '仟', '亿', '拾', '佰', '仟', '万'));
var
  Temp: string;
  I, Len: Integer;
  ZeroFlag, Empty: Boolean;
begin
  Result := '';
  ZeroFlag := False;
  Empty := True;
  Temp := IntToStr(Trunc(Value));
  Len := Length(Temp);
  for I :=  1 to Len do
  begin
    if Temp[I] <> '0' then
    begin
      if ZeroFlag then Result := Result + HZNumbers[Style, 0];
      Result := Result + HZNumbers[Style, StrToInt(Temp[I])] + HZNumberUnits[Style, Len - I];
      if (Len - I) mod 4 <> 0 then Empty := False;
    end
    else if (Len - I) mod 4 = 0 then
    begin
      if not Empty or ((Len - I) = 0) then Result := Result + HZNumberUnits[Style, Len - I];
      Empty := True;
    end;
    ZeroFlag := Temp[I] = '0';
  end;
  Temp := FormatFloat('0.##########', Frac(Value));
  if Length(Temp) > 2 then Result := Result + '点';
  for I := 3 to Length(Temp) do
    Result := Result + HZNumbers[Style, StrToInt(Temp[I])];
end;

end.