publicfunction.pas

Barcode And LabelPrint

unit PublicFunction;

interface
uses windows, messages, sysutils, dialogs, forms, Graphics, ExtCtrls, db, adodb, StdCtrls,
  registry, classes, controls, ComCtrls, ComObj, IniFiles, Math, Grids, PublicParameter;
//connect with database.
function connect_DB(ADO: TADOConnection; ConnStr: string): bool;
//Get ID from a string;
function GetIDFromChar(ASecStr: string; Achar: string): string;
function FormCenter(AForm: TForm): bool;
function GetPYIndexChar(hzchar: string): char;
function RemoveFrontZeroFromStr(sec: string): string;

function selectDB(Aform: TForm): string;
function GetCfgValue(const key: string; cfgFileName: string): string;
function SetCfgValue(const key: string; Value: string; cfgFileName: string): bool;
function GetValueTostr(ATable: string; AFile: string; AFlagField: string; Avalue: string): string;
function checkValue(ATable: string; AFile: string; Avalue: string): bool;
//返回下一个ID取最大值（整型）
function GetNextRecNoMax(ADOConnection: TADOConnection; TableName, Fieldstr, Condition, DesFieldstr: string; FieldLen: integer): longint;
function GetBlobToStream(Table: TDataSet; const FieldName: string; var ResultStream: TmemoryStream): Bool;
function GetBlobFileToStream(ADOTable1: TAdoQuery; Name: string): TStream;
function blobcontenttostring(const fileName: string; ADOTable1: TDataSet; FiledName: string): bool;
//去掉字符串中的某一字符除去空格
function checkFilename(tempchar: string; SourceStr: string): string; //去掉filemae中的s除去空格
procedure deleteRec(var Connection: TADOConnection; TableName, Condition: string);
function NumClear(Num: string): string; //去掉数字中的','等
function formatfloat(s: string): string;
procedure StringGridgridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
function GetValueToCMB(ATable: string; AFile: string; Avalue: string): TStrings;
function GetValueToCMBOrderId(ATable: string; AFile: string; Avalue: string): TStrings;
//读写ini文件
procedure WriteIniFile(Section, KeyName: AnsiString; KeyValue: AnsiString);
function ReadIniFile(Section, KeyName: AnsiString): AnsiString;
//导出到Excel
function ExportToExcel(adorecordset: TAdoQuery): Boolean;

implementation
uses StockDataModel;
//add combox as a list item
//导出到Excel

function ExportToExcel(adorecordset: TAdoQuery): Boolean;
var
  xlApp, xlBook, xlSheet, xlQuery: Variant;
begin
  xlApp := CreateOleObject('Excel.Application');
  xlBook := xlApp.Workbooks.Add;
  xlSheet := xlBook.Worksheets['sheet1'];
  xlApp.Visible := True;
  //把查询结果导入EXCEL数据
  xlQuery := xlSheet.QueryTables.Add(adoRecordset.Recordset, xlSheet.Range['A1']); //关键是这一句
  xlQuery.FieldNames := True;
  xlQuery.RowNumbers := False;
  xlQuery.FillAdjacentFormulas := False;
  xlQuery.PreserveFormatting := True;
  xlQuery.RefreshOnFileOpen := False;
  xlQuery.BackgroundQuery := True;
  //xlQuery.RefreshStyle := xlInsertDeleteCells;
  xlQuery.SavePassword := True;
  xlQuery.SaveData := True;
  xlQuery.AdjustColumnWidth := True;
  xlQuery.RefreshPeriod := 0;
  xlQuery.PreserveColumnInfo := True;
  xlQuery.FieldNames := True;
  xlQuery.Refresh;
end;
//导出到Excel

procedure WriteIniFile(Section, KeyName: AnsiString; KeyValue: AnsiString);
begin
  if not Assigned(iniFile) then
    iniFile := TIniFile.Create(gCurrDirectory + 'Incomcfg.ini');
  try
    iniFile.WriteString(Section, KeyName, KeyValue);
  except
  end;
end;

function ReadIniFile(Section, KeyName: AnsiString): AnsiString;
begin
  if not Assigned(iniFile) then
    iniFile := TIniFile.Create(gCurrDirectory + 'Incomcfg.ini');
  try
    Result := iniFile.ReadString(Section, KeyName, '');
  except
  end;
end;

function GetValueToCMB(ATable: string; AFile: string; Avalue: string): TStrings;
var
  test: string;
begin
  Result := TStringList.Create;
//  With TAdoQuery.Create(nil) do
  with TAdoQuery.Create(nil) do
  begin
    try
      connection := StockDM.ADOConn;
      Sql.Clear;
      if UpperCase(Avalue) = 'ALL' then
      begin
      //test:='SELECT * FROM  '+ATable+'';
      //henry modify 2007-2-7 15:04
        test := 'SELECT  ' + AFile + '  FROM ' + ATable + '';
      end
      else
      begin
      //test:='SELECT * FROM  '+ATable+'  where '+AFile+'='#39 + Avalue +#39'';
      //henry modify 2007-2-7 15:04
        test := 'SELECT  ' + AFile + '  FROM  ' + ATable + '  where ' + AFile + '='#39 + Avalue + #39'';
      end;
      sql.Text := test;
      open;
      if not Isempty then
      begin
        while not eof do
        begin
          if pos(',', AFile) <= 0 then
            Result.Add(fieldbyname(AFile).AsString)
          else Result.Add(fieldbyname(copy(AFile, 1, pos(',', AFile) - 1)).AsString + ',' + fieldbyname(copy(AFile, pos(',', AFile) + 1, MaxInt)).AsString);
          next;
        end;
      end;
    finally
      close;
      Free;
    end;
  end;
end;
//add combox as a list item
function GetValueToCMBOrderId(ATable: string; AFile: string; Avalue: string): TStrings;
var
  test: string;
begin
  Result := TStringList.Create;
//  With TAdoQuery.Create(nil) do
  with TAdoQuery.Create(nil) do
  begin
    try
      connection := StockDM.ADOConn;
      Sql.Clear;
      if UpperCase(Avalue) = 'ALL' then
      begin
      //test:='SELECT * FROM  '+ATable+'';
      //henry modify 2007-2-7 15:04
        test := 'SELECT distinct ' + AFile + '  FROM ' + ATable + '';
      end
      else
      begin
      //test:='SELECT * FROM  '+ATable+'  where '+AFile+'='#39 + Avalue +#39'';
      //henry modify 2007-2-7 15:04
        test := 'SELECT distinct ' + AFile + '  FROM  ' + ATable + '  where ' + AFile + '='#39 + Avalue + #39'';
      end;
      sql.Text := test;
      open;
      if not Isempty then
      begin
        while not eof do
        begin
          if pos(',', AFile) <= 0 then
            Result.Add(fieldbyname(AFile).AsString)
          else Result.Add(fieldbyname(copy(AFile, 1, pos(',', AFile) - 1)).AsString + ',' + fieldbyname(copy(AFile, pos(',', AFile) + 1, MaxInt)).AsString);
          next;
        end;
      end;
    finally
      close;
      Free;
    end;
  end;
end;
//add combox as a list item

procedure StringGridgridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var cy, cx: integer;
  txt: string;
  style: string;
  i, j, k: integer;
  R, D, L, U: integer;
  TxtLeft, TxtTop, TxtBottom, TxtRight: integer;
  MyREct: Trect;
  function GetCol(Acol, Arow: integer): string;
  var i: integer;
    Mypos: integer;
    MyString: string;
  begin
    MyString := TSTringGrid(Sender).cells[acol, 0];
    for i := 0 to Arow do
    begin
      myPos := pos('|', MyString) - 1;
      if Mypos < 0 then
      begin
        REsult := MyString;
        exit;
      end;
      if pos('|', MyString) <> 1 then
        Result := copy(MyString, 1, Mypos);
      Mystring := copy(Mystring, Mypos + 2, length(MyString));
    end;
  end;
  procedure Line3d(canvas: Tcanvas; x, y, x1, y1: integer; light, an: Tcolor);
  begin
    with canvas do
    begin
      pen.Color := light;
      MOVETO(x, y1);
      lineto(x, y);
      lineto(x1, y);
      pen.Color := an;
      lineto(x1, y1);
      lineto(x, y1);
    end;
  end;
begin
  with TSTringGrid(Sender) do
  begin
    canvas.Font.Name := Font.Name;
    canvas.font.Size := Font.Size;
    Canvas.Font.Color := font.Color;
    txt := Trim(cells[acol, arow]);
    if arow < fixedrows then
      txt := getcol(acol, arow);
    if ((state = [gdSelected, gdFocused]) and (arow >= fixedrows)) or
      ((goRowselect in Options) and (arow = row))
      then
      Canvas.Brush.Color := $0099FFFF
    else
      if state = [gdfixed] then
        canvas.Brush.Color := $00CCCCCC
      else
        if (arow mod 2) = 0 then
          Canvas.Brush.Color := $00F3D5B1 //clGradientActiveCaption  //$00F0F0ff
        else
          Canvas.Brush.Color := $00F7E0CC; //$00e0e0ff;
    cy := 3;

    if ((state = [gdfixed]) and (arow <= fixedrows - 1)) then
    begin
      if pos('$$', txt) > 0 then
        txt := copy(txt, 1, pos('$$', txt) - 1);
      cy := (rect.Right - rect.left - Canvas.TextWidth(txt)) div 2;
    end else
    begin
      Style := cells[acol, 0];
      if pos('$$', Style) > 0 then
      begin
        style := uppercase(copy(style, pos('$$', style), length(style)));
        if pos('N', style) > 0 then
        begin
          txt := formatfloat(numclear(txt));
          if txt = '0.0' then txt := '';
        end;
        if pos('R', style) > 0 then
          cy := rect.right - Canvas.TextWidth(txt) - rect.left - 3;
        if pos('M', Style) > 0 then
          cy := (rect.Right - rect.left - Canvas.TextWidth(txt)) div 2;
        if pos('L', style) > 0 then
          cy := 3;
      end;
    end;
    if {state=[gdfixed]}  arow < fixedrows then
    begin //多列头处理....
      R := 0;
      TxtLeft := rect.Left;
      TxtTop := rect.Top;
      TxtBottom := rect.Bottom;
      TxtRight := Rect.Right;
      for r := Acol to colcount - 1 do
      begin
        if Getcol(Acol, Arow) <> Getcol(R, Arow) then Break;
        if r <> acol then //补
          TxtRight := TxtRight + ColWidths[r];
      end;
      k := 0;
      for D := Arow to fixedrows - 1 do
      begin
        for i := acol to R - 1 do
          if Getcol(Acol, Arow) <> getcol(i, D) then
          begin
            k := -1;
            Break;
          end;
        if k = -1 then Break;
        TxtBottom := TxtBottom + RowHeights[d];
      end;
        //If Acol>0 then
      begin
        k := 0;
        for l := Acol downto 0 do
        begin
          for i := Arow to D - 1 do
            if getcol(l, i) <> Getcol(acol, Arow) then
            begin
              k := -1;
              Break;
            end;
          if K = -1 then Break;
          TxtLeft := TxtLeft - ColWidths[l];
        end; // for l:=Acol-1 downto 0 do
      end; // if Acol >0 then
      if Arow > 0 then
      begin
        k := 0;
        for U := Arow - 1 downto 0 do
        begin
          for i := l + 1 to r - 1 do
          begin
            if Getcol(i, u) <> getcol(acol, arow) then
            begin
              k := -1;
              Break;
            end;
            if k = -1 then Break;
            TxtTop := TxtTop - RowHeights[u];
          end;
          if k = -1 then Break;
        end; // for u:=arow-1 downto 0 do
      end; // if Arow>0 then
      cy := ((txtbottom - txttop) div 2) + txttop - rowheights[arow];
      Cx := ((txtright - Txtleft + colwidths[acol] - canvas.TextWidth(txt)) div 2) + txtleft;
      Myrect := rect;
      if txtright <> rect.Right then rect.Right := rect.Right + 1;
      if (txtleft + colwidths[acol]) <> rect.Left then
        rect.Left := rect.Left - 1;
      if txttop <> rect.top then rect.Top := rect.Top - 1;
      if (txtbottom - Myrect.Bottom) <> rowheights[arow] then
        rect.Bottom := rect.Bottom + 1;
      with canvas do
      begin
        if txtright = Myrect.Right then
        begin
          pen.Color := ClGray;
          Moveto(rect.Right - 1, rect.Top - 1);
          lineto(rect.Right - 1, rect.Bottom + 1);
        end;
        if (txtleft + colwidths[acol]) = rect.Left then
        begin
          pen.Color := ClWhite;
          Moveto(rect.left, rect.Top);
          lineto(rect.left, rect.Bottom - 1);
        end;
        if txttop = Myrect.top then
        begin
          pen.Color := ClWhite;
          Moveto(rect.left, rect.Top);
          lineto(rect.Right - 1, rect.Top);
        end;
        if (txtbottom - Myrect.Bottom) = rowheights[arow] then
        begin
          pen.Color := ClGray;
          Moveto(Myrect.left, rect.bottom - 1);
          lineto(Myrect.Right + 2, rect.bottom - 1);
        end;
      end;
      rect.Top := rect.Top + 1;
      rect.Left := rect.Left + 1;
      rect.Bottom := rect.Bottom - 1;
      rect.Right := rect.Right - 1;
      Canvas.TextRect(Rect, cx, cy + 4, Txt);
    end
    else
    begin
      cx := (rect.Bottom - rect.Top - canvas.TextHeight(txt)) div 2;
      Canvas.TextRect(Rect, Rect.Left + cy, Rect.Top + cx, txt);
      rect.Top := rect.Top;
      rect.Left := rect.Left;
      rect.Bottom := rect.Bottom - 1;
      rect.Right := rect.Right - 1;
      if state = [gdfixed] then
        line3d(canvas, rect.Left, rect.Top, rect.Right, rect.Bottom, clwhite, clGray)
      else
        line3d(canvas, rect.Left, rect.Top, rect.Right, rect.Bottom, clwhite, clSilver);
    end;
  end; // with grid1;end;