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;
//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 ExportToExcel(ADO: TADOConnection; SQLSTR: string): Boolean;
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 gridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
implementation
uses StockDataModel;

procedure gridDrawCell(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;
end;

function formatfloat(s: string): string;
var
  I, MaxSym, MinSym, Group: Integer;
  IsSign: Boolean;
  Thousands: Boolean;
begin
  Thousands := True;
  Result := '';
  MaxSym := Length(S);
  IsSign := (MaxSym > 0) and (S[1] in ['-', '+']);
  if IsSign then MinSym := 2
  else MinSym := 1;
  I := Pos(DecimalSeparator, S);
  if I > 0 then MaxSym := I - 1;
  I := Pos('E', AnsiUpperCase(S));
  if I > 0 then MaxSym := Min(I - 1, MaxSym);
  Result := Copy(S, MaxSym + 1, MaxInt);
  Group := 0;
  for I := MaxSym downto MinSym do begin
    Result := S[I] + Result;
    Inc(Group);
    if (Group = 3) and Thousands and (I > MinSym) then begin
      Group := 0;
      Result := ThousandSeparator + Result;
    end;
  end;
  if IsSign then Result := S[1] + Result;
  if Result = '0' then Result := '';
end;

function NumClear(Num: string): string; //去掉数字中的','等
var
  i: integer;
  NumChr: string;
  NumStr: string;
begin
  if num = '' then num := '0';
  for i := 1 to length(num) do
  begin
    NumChr := copy(num, i, 1);
    if (NumChr = '0') or (NumChr = '1') or (NumChr = '2') or
      (NumChr = '3') or (NumChr = '4') or (NumChr = '5') or (NumChr = '6')
      or (NumChr = '7') or (NumChr = '8') or (NumChr = '9') or (NumChr = '.') or (NumChr = '-') then
      numstr := numstr + numchr;
  end;
  if numstr = '' then numstr := '0';
//  Result := strtofloat(numstr);
  result := numstr;
end;

procedure deleteRec(var Connection: TADOConnection; TableName, Condition: string);
var
  Query1: TADOQuery;
begin
  Query1 := TADOQuery.Create(nil);
  try
    with Query1 do begin
      Connection := StockDM.ADOConnBarCodeTemp; //Connection;
      SQL.Clear;
      if Condition <> '' then
        SQL.Add('delete from' + TableName + ' where ' + Condition)
      else
        SQL.Add('delete from ' + TableName);
      ExecSQL;
      Close;
    end;
  finally
    Query1.Free;
  end;
end;

function checkFilename(tempchar: string; SourceStr: string): string; //去掉filemae中的s除去空格
var
  temp, stemp: string;
  i: integer;
begin
  temp := '';
  for i := 0 to Length(SourceStr) do
  begin
    stemp := copy(SourceStr, i + 1, 1);
    if (stemp <> tempchar) then
      temp := temp + stemp;
  end;
  result := temp;
end;
 //读文件，存储文件到blob

function blobcontenttostring(const fileName: string; ADOTable1: TDataSet; FiledName: string): bool;
var
  AStream: TmemoryStream;