uglobal.pas

简单易用的按件按时计工资管理系统

  begin
    sTemp := sSelect + ' * ' + sFrom + sTables + ' Where (1=2)';
    with TClientDataSet.Create(Application) do
    begin
      try
        DM.GetRecords(sTemp, vData, i, i);
        Data := vData;
        sFields := '';
        for i := 0 to Fields.Count - 1 do
          sFields := sFields + Fields[i].FieldName + ',';
        System.Delete(sFields, length(sFields), 1);
        Result := sSelect + ' ' + sFields + ' ' + sFrom + sTables + sWhere;
      finally
        free;
      end;
    end;
  end;
end;


function GetRecordCount(const pSQL: string): integer;
var
  sSelect, sFields, sFrom, sTables, sWhere, sTemp: string;
  vData: OleVariant;
  i: integer;
begin
  Result := 0;
  OpenWaitingDlg('正在统计记录数......');
  try
    AnalyseSelect(pSQL, sSelect, sFields, sFrom, sTables, sWhere);

    if copy(Trim(sTables), length(Trim(sTables)), 1) = '.' then
      exit;

    if (sSelect <> '') and (sTables <> '') then
    begin
      sTemp := sSelect + ' Count(*) as FCOUNT ' + sFrom + sTables + sWhere;
      with TClientDataSet.Create(Application) do
      begin
        try
          DM.GetRecords(sTemp, vData, i, i);
          Data := vData;
          if RecordCount = 0 then exit;
          Result := FieldByName('FCOUNT').AsInteger;
        finally
          free;
        end;
      end;
    end;
  finally
    CloseWaitingDlg;
  end;
end;

procedure OpenWaitingDlg(const pMsg: string; pCancel: Boolean);
begin
  if Pub_WaitingDlg = nil then
    Pub_WaitingDlg := TfmWaitingDlg.Create(Application);
  //Screen.Cursor :=crHourGlass;
  with Pub_WaitingDlg do
  begin
    if pMsg <> '' then
      Title := pMsg;
    IfCancel := False;
    btnCancel.Visible := pCancel;
    Show;
    RefreshDisplay;
  end;
end;

procedure CloseWaitingDlg;
begin
  if Pub_WaitingDlg <> nil then
  begin
    //Screen.Cursor :=crDefault;
    Pub_WaitingDlg.Close;
    FreeAndNil(Pub_WaitingDlg);
  end;
end;

function FormatSql(Value: string): string;
var
  i, p, iCount: integer;
begin
  Result := Value;
  p := pos(CS_RemoteLog_SQLBegin, Result);
  if p > 0 then
    Result := Trim(copy(Result, p + 1, length(Result)));
  iCount := 0;
  p := 0;
  for i := length(Result) downto 1 do
  begin
    if Result[i] = #9 then
      Inc(iCount);
    if iCount = 3 then
    begin
      p := i;
      break;
    end;
  end;
  if p > 0 then
    Result := copy(Result, 1, p);
end;

function TransIconToBmp(AIcon: TIcon): Graphics.TBitmap;
begin
  Result := Graphics.TBitmap.create;
  Result.Width := AIcon.Width;
  Result.height := AIcon.Height;
  Result.Canvas.Draw(0, 0, AIcon);
end;

procedure GrayBmp1(Bitmap: Graphics.TBitmap);
var
  i, j, iColor: integer;
  rr, gg, bb: byte;
  res: byte;
  c: TColor;
begin
  for i := 0 to Bitmap.Width + 1 do
  begin
    for j := 0 to Bitmap.height + 1 do
    begin
      c := Bitmap.Canvas.Pixels[i, j];
      iColor := ColorToRGB(c);
      rr := byte(iColor shr 8);
      gg := byte(iColor shr 2);
      bb := byte(iColor shr 6);
      res := (rr + gg + bb) div 3;
      Bitmap.Canvas.Pixels[i, j] := rgb(res, res, res);
    end;
  end;
end;

procedure GrayBmp2(Bitmap: Graphics.TBitmap; Value: integer);
  function GrayColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
  var
    r, g, b, avg: integer;

  begin
    if Value > 100 then Value := 100;
    clr := ColorToRGB(clr);
    r := Clr and $000000FF;
    g := (Clr and $0000FF00) shr 8;
    b := (Clr and $00FF0000) shr 16;

    Avg := (r + g + b) div 3;
    Avg := Avg + Value;

    if Avg > 240 then Avg := 240;

    Result := Windows.GetNearestColor(ACanvas.Handle, RGB(Avg, avg, avg));
  end;
var
  x, y: integer;
  LastColor1, LastColor2, Color: TColor;
begin
  LastColor1 := 0;
  LastColor2 := 0;

  for y := 0 to Bitmap.Height do
    for x := 0 to Bitmap.Width do
    begin
      Color := Bitmap.Canvas.Pixels[x, y];
      if Color = LastColor1 then
        Bitmap.Canvas.Pixels[x, y] := LastColor2
      else
      begin
        LastColor2 := GrayColor(Bitmap.Canvas, Color, Value);
        Bitmap.Canvas.Pixels[x, y] := LastColor2;
        LastColor1 := Color;
      end;
    end;
end;


procedure FullBmp(Canvas: TCanvas; Bmp: Graphics.TBitmap; Width, Height: integer);
var
  i, j, iCol, iRow: integer;
begin
  iCol := width div Bmp.Width;
  iRow := Height div Bmp.Height;
  for i := 0 to iCol do
    for j := 0 to iRow do
      if (j + i) mod (Random(5) + 1) = 1 then
        Canvas.Draw(i * Bmp.Width, j * Bmp.Height, Bmp);

end;

procedure Emboss(ABitmap: Graphics.TBitmap; AMount: Integer);
var
  x, y, i: integer;
  p1, p2: PByteArray;
begin
  for i := 0 to AMount do
  begin
    for y := 0 to ABitmap.Height - 2 do
    begin
      p1 := ABitmap.ScanLine[y];
      p2 := ABitmap.ScanLine[y + 1];
      for x := 0 to ABitmap.Width do
      begin
        p1[x * 3] := (p1[x * 3] + (p2[(x + 3) * 3] xor $FF)) shr 1;
        p1[x * 3 + 1] := (p1[x * 3 + 1] + (p2[(x + 3) * 3 + 1] xor $FF)) shr 1;
        p1[x * 3 + 2] := (p1[x * 3 + 1] + (p2[(x + 3) * 3 + 1] xor $FF)) shr 1;
      end;
    end;
  end;
end;

procedure SetFieldValue(DataSet: TdataSet; Field, Val: string);
begin
  if not CheckDataSet(DataSet) then Exit;
  if DataSet.FindField(Field) = nil then Exit;
  if not (DataSet.State in [dsEdit, dsInsert]) then DataSet.Edit;

  case DataSet.FieldByName(Field).DataType of
    {字符串型}
    ftString, ftWideString,
      ftMemo, ftFmtMemo,
      ftFixedChar: DataSet.FieldByName(Field).AsString := val;
    {整型}
    ftSmallint, ftInteger,
      ftWord, ftBytes,
      ftAutoInc, ftLargeint:
      begin
        if val = '' then val := '0';
        DataSet.FieldByName(Field).AsInteger := StrToInt(Val);
      end;

    ftFloat:
      begin
        if val = '' then val := '0.00';
        DataSet.FieldByName(Field).AsFloat := StrToFloat(Val);
      end;

    ftCurrency:
      begin
        if val = '' then val := '0.00';
        DataSet.FieldByName(Field).AsCurrency := StrToCurr(Val);
      end;

    ftBCD:
      begin
        if val = '' then val := '0.00';
        DataSet.FieldByName(Field).AsBCD := StrToBCD(Val);
      end;

    ftDate, ftDateTime, ftTime:
      begin
        if val = '' then
          DataSet.FieldByName(Field).AsString := ''
        else
          DataSet.FieldByName(Field).AsDateTime := StrToDateTime(Val);
      end;
  end;
end;

function GetFirstDayOfMonth(pDate: TDateTime): TDateTime;
{获取pDate所在月份的首日日期,返回TDateTime型数值}
var
  yy, mm, dd: Word;
begin
  DecodeDate(pDate, yy, mm, dd);
  Result := StartOfAMonth(yy, mm);
end;

procedure ComSetFieldFormat(pField: TField; pDisplayFormat: string);
var
  pFieldType: TFieldType;
begin
  if pField = nil then Exit;
  pFieldType := pField.DataType;
  case pFieldType of
      ftBCD,
      ftFloat,
      ftCurrency:
      begin
        if pDisplayFormat<>'' then
          TNumericField(pField).DisplayFormat:=pDisplayFormat
        else
          TNumericField(pField).DisplayFormat := '#,##0.00';
      end;
    ftDate:
      begin
        if pDisplayFormat<>'' then
          TDateField(pField).DisplayFormat:=pDisplayFormat
        else
          TDateField(pField).DisplayFormat := 'YYYY-MM-DD';
      end;
    ftDateTime:
      begin
        if pDisplayFormat<>'' then
          TDateTimeField(pField).DisplayFormat:=pDisplayFormat
        else
          TDateTimeField(pField).DisplayFormat := 'YYYY-MM-DD';
      end; 
  else
    Exit;
  end;
end;

procedure CreateCellCols(Cell: TDxDBGrid; ACDS:TClientDataSet);
var
  i:integer;
  sFieldName:string;
  DBColumn: TdxDBTreeListColumn;
begin
  if not CheckDataset(ACDS) then exit;
  Cell.BeginUpdate ;
  try
    Cell.DestroyColumns ;
    for i:=0 to ACDS.Fields.Count -1 do
    begin
      sFieldName:= ACDS.Fields[i].FieldName ;
      if (pos(CS_KeyFieldName, sFieldName)>0) or
        (sFieldName=CS_SelectFieldName) then
        continue;
      ComSetFieldFormat(ACDS.Fields[i]); //设置显示格式
      if (pos('是否', sFieldName)>0) then
      begin
        DBColumn := Cell.CreateColumn(TDxDBGridCheckColumn) as TDxDBGridCheckColumn;
        with TDxDBGridCheckColumn(DBColumn) do
        begin
          ValueChecked := '1';
          ValueUnChecked := '0';
          TabStop := False;
        end;
      end else
      if (pos('性别', sFieldName)>0) then
      begin
        DBColumn := Cell.CreateColumn(TdxDBGridPickColumn) as TdxDBGridPickColumn;
        with TdxDBGridPickColumn(DBColumn) do
        begin
          Items.Add('女');
          Items.Add('男');
          Items.Add('不详');
        end;
      end else
      begin
        DBColumn := Cell.CreateColumn(TDxDBGridColumn) as TDxDBGridColumn;
      end;

      DBColumn.Name := 'COL_' + IntToStr(i);
      DBColumn.FieldName := sFieldName;
      DBColumn.Caption := sFieldName;
      DBColumn.VertAlignment := tlCenter;
      DBColumn.HeaderAlignment := taCenter;
      //DBColumn.DisableEditor := True;
      if Cell.Bands.Count > 1 then DBColumn.BandIndex := 1;
      {if (Trim(FieldByName(CS_FldName_Sumed).AsString) = CS_DefVal_Yes) and
        (IsNumerField(DataSet.FieldByName(sFieldName))) then
      begin
        DBColumn.SummaryFooterField := sFieldName;
        DBColumn.SummaryFooterType := cstSum;
        DBColumn.SummaryFooterFormat := Trim(FieldByName(CS_FldName_DisplayFormat).AsString);
      end; }

    end;
  finally
    Cell.EndUpdate ;
  end;
end;

procedure AddCheckColumn(Cell: TDxDBGrid; pFieldName: string);
var
  DBColumn: TdxDBTreeListColumn;
begin
  Cell.BeginUpdate;
  DBColumn := Cell.CreateColumn(TDxDBGridCheckColumn) as TDxDBGridCheckColumn;
  with TDxDBGridCheckColumn(DBColumn) do
  begin
    Name := 'ColSelect';
    FieldName := pFieldName;
    Caption := pFieldName;
    Alignment := taCenter;
    VertAlignment := tlCenter;
    HeaderAlignment := taCenter;
    TabStop := False;
    DisableEditor := False;
    DisableCustomizing := True;
    DisableDragging := True;
    Sizing := False;
    Width := 35;
    ValueChecked := '1';
    ValueUnChecked := '0';
    glyphCount := 3;
    //Glyph := COM_Resource.Img_YesNoNull.Picture.Bitmap;
    if Cell.Bands.Count > 1 then BandIndex := 0;
    ColIndex:=0;
  end;
  Cell.EndUpdate;
end;

function CheckCanNotEmptyField(DataSet: TdataSet; pFieldName: string):Boolean;
begin
  Result:=True;
  if not CheckDataSet(DataSet) then exit;
  if DataSet.FindField(pFieldName)=nil then exit;
  if DataSet.FindField(pFieldName).AsString ='' then
  begin
    Result:=False;
    Application.MessageBox(pchar('[' + pFieldName + ']不能为空!'), pchar(Application.Title ), MB_OK + MB_ICONERROR );
  end;
end;

function FormatFloat_Ex(const AValue: Extended; const ADigit: TRoundRange = 2): Extended;
var sTmp : string;
begin
  sTmp := FloatToStrF(AValue,ffFixed,CI_MaxFloatPrecision,ADigit);
  result := StrToFloat(sTmp);
end;

function GetFieldSumValue(pDataSet: TclientdataSet; pField: string): Double;
var
  aAggFld: TAggregate;
  sExpression: string;
  vResult: Variant;
begin
  Result := 0.00;
  if (Trim(pField) = '') or
    (pDataSet = nil) or
    (not pDataSet.Active) then
    Exit;

  sExpression := 'SUM(' + pField + ')';
  aAggFld := pDataSet.Aggregates.Add;
  try
    aAggFld.Expression := sExpression;
    aAggFld.Active := True;
    vResult := aAggFld.Value;
    if VarIsNull(vResult) or VarIsEmpty(vResult) then
      Result := 0.00
    else
      Result := vResult;
    aAggFld.Active := False;
  finally
    FreeAndNil(aAggFld);
  end;
end;

procedure SetPayItemColumnsInfo(Cell: TDxDBGrid);
var
  i: integer;
begin
  for i:=0 to Cell.ColumnCount -1 do
  begin
    if (Cell.Columns[i].FieldName = CS_RateFieldName) or
      (Cell.Columns[i].FieldName = CS_NoteFieldName) then
    begin
      Cell.Columns[i].DisableEditor :=False;
      Cell.Columns[i].ReadOnly :=False;
    end else
    begin
      Cell.Columns[i].DisableEditor :=True;
      Cell.Columns[i].ReadOnly :=True;
    end;
  end;

end;

procedure SetAllColumnsCanEdit(Cell: TDxDBGrid;pCanEdit:Boolean);
var
  i: integer;
begin
  for i:=0 to Cell.ColumnCount -1 do
  begin
    Cell.Columns[i].DisableEditor :=not pCanEdit;
    Cell.Columns[i].ReadOnly :=not pCanEdit;
  end;

end;
end.