untactreport.pas.bak

飞思科技的书不错

    data := 0;
  end;
end;

procedure GetEditValue(edt: TEdit; var data: string); overload;
begin
  data := edt.Text;
end;

procedure GetEditValue(edt: TEdit; var data: Currency); overload;
begin
  try
    data := StrToCurr(edt.Text);
  except
    data := 0;
  end;
end;

procedure GetEditValue(edtlst: TEditList; idx: Integer; var data: Integer); overload;
begin
  try
    data := StrToInt(edtlst[idx].Text);
  except
    data := 0;
  end;
end;

procedure GetEditValue(edtlst: TEditList; idx: Integer; var data: string); overload;
begin
  data := edtlst[idx].Text;
end;

procedure GetEditValue(edtlst: TEditList; idx: Integer; var data: Currency); overload;
begin
  try
    data := StrToCurr(edtlst[idx].Text);
  except
    data := 0;
  end;
end;

procedure SetEditValue(edt: TEdit; data: Integer); overload;
begin
  edt.Text := IntToStr(data);
end;

procedure SetEditValue(edt: TEdit; data: string); overload;
begin
  edt.Text := data;
end;

procedure SetEditValue(edt: TEdit; data: Currency); overload;
var
  str: string;
begin
  str := FormatCurr('#.#', data);
  if Length(str) = 0 then
    str := '0';
  edt.Text := str;
end;

procedure SetEditValue(edtlst: TEditList; idx: Integer; data: Integer); overload
begin
  edtlst[idx].Text := IntToStr(data);
end;

procedure SetEditValue(edtlst: TEditList; idx: Integer; data: string); overload;
begin
  edtlst[idx].Text := data;
end;

procedure SetEditValue(edtlst: TEditList; idx: Integer; data: Currency); overload;
var
  str: string;
begin
  str := FormatCurr('#.#', data);
  if Length(str) = 0 then
    str := '0';
  edtlst[idx].Text := str;
end;

procedure GetComboValue(cmb: TComboBox; var data: Integer); overload;
begin
  data := cmb.ItemIndex;
end;

procedure SetComboValue(cmb: TComboBox; data: Integer); overload;
begin
  cmb.ItemIndex := data;
end;

procedure GetComboValue(cmblst: TComboBoxList; idx: Integer; var data: Integer); overload;
begin
  data := cmblst[idx].ItemIndex;
end;

procedure SetComboValue(cmblst: TComboBoxList; idx: Integer; data: Integer); overload;
begin
  cmblst[idx].ItemIndex := data;
end;

procedure GetRadioValue(rdo: TRadioGroup; var data: Integer); overload;
begin
  data := rdo.ItemIndex;
  if data = -1 then
    data := 0;
end;

procedure SetRadioValue(rdo: TRadioGroup; data: Integer); overload;
begin
  try
    rdo.ItemIndex := data;
  except
    rdo.ItemIndex := -1;
  end;
end;

procedure GetCheckValue(chk: TCheckBox; var data: Boolean); overload;
begin
  data := chk.Checked;
end;

procedure SetCheckValue(chk: TCheckBox; data: Boolean); overload;
begin
  chk.Checked := data;
end;

procedure GetCheckValue(chklst: TCheckBoxList; idx: Integer; var data: Boolean); overload;
begin
  data := chklst[idx].Checked;
end;

procedure SetCheckValue(chklst: TCheckBoxList; idx: Integer; data: Boolean); overload;
begin
  chklst[idx].Checked := data;
end;

function FindCtrlByName(grp: TGroupBox; str: string) : TControl;
var
  i: Integer;
  ctrl: TControl;
begin
  Result := nil;
  for i := 0 To grp.ControlCount - 1 do begin
    ctrl := grp.Controls[i];
    if ctrl is TGroupBox then begin
      ctrl := FindCtrlByName(TGroupBox(ctrl), str);
      if Assigned(ctrl) then begin
        Result := ctrl;
        Exit;
      end;
    end
    else if ctrl.Name = str then begin
      Result := ctrl;
      Exit;
    end;
  end;
end;

procedure GetEditValueByName(grp: TGroupBox; str: string;
                             var data: Integer); overload;
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TEdit) then
    GetEditValue(TEdit(ctrl), data);
end;

procedure GetEditValueByName(grp: TGroupBox; str: string;
                             var data: string); overload;
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TEdit) then
    GetEditValue(TEdit(ctrl), data);
end;

procedure GetEditValueByName(grp: TGroupBox; str: string;
                             var data: Currency); overload;
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TEdit) then
    GetEditValue(TEdit(ctrl), data);
end;

procedure SetEditValueByName(grp: TGroupBox; str: string;
                             data: Integer); overload;
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TEdit) then
    SetEditValue(TEdit(ctrl), data);
end;

procedure SetEditValueByName(grp: TGroupBox; str: string;
                             data: string); overload;
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TEdit) then
    SetEditValue(TEdit(ctrl), data);
end;

procedure SetEditValueByName(grp: TGroupBox; str: string;
                             data: Currency); overload;
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TEdit) then
    SetEditValue(TEdit(ctrl), data);
end;

procedure GetCheckValueByName(grp: TGroupBox; str: string;
                              var data: Boolean);
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TCheckBox) then
    GetCheckValue(TCheckBox(ctrl), data);
end;

procedure SetCheckValueByName(grp: TGroupBox; str: string;
                              data: Boolean);
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TCheckBox) then
    SetCheckValue(TCheckBox(ctrl), data);
end;

procedure GetComboValueByName(grp: TGroupBox; str: string;
                              var data: Integer);
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TComboBox) then
    GetComboValue(TComboBox(ctrl), data);
end;

procedure SetComboValueByName(grp: TGroupBox; str: string;
                              data: Integer);
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TComboBox) then
    SetComboValue(TComboBox(ctrl), data);
end;

procedure GetRadioValueByName(grp: TGroupBox; str: string;
                              var data: Integer);
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TRadioGroup) then
    GetRadioValue(TRadioGroup(ctrl), data);
end;

procedure SetRadioValueByName(grp: TGroupBox; str: string;
                              data: Integer);
var
  ctrl: TControl;
begin
  ctrl := FindCtrlByName(grp, str);
  if Assigned(ctrl) and (ctrl is TRadioGroup) then
    SetRadioValue(TRadioGroup(ctrl), data);
end;

procedure NextPos(var ret_code: Integer;
                  var x1, y1: Integer;
                  var x2, y2: Integer;
                  // cur bounds, dynamicallly changing
                  var cur_left, cur_right: Integer;
                  yTotal, width, height: Integer;
                  margin, grp_hdr: Integer;
                  ele_gap, unit_gap, column_gap: Integer;
                  var first_time: Boolean;
                  // new a unit
                  new_unit: Boolean = False;
                  // goes down in the same unit
                  goes_down: Boolean = False;
                  // new an element
                  new_element: Boolean = True);
{ ret-code values:
  0: no problem encountered,
  1: change to another column,
  2: no room
}
begin
  if (ret_code = 2) then begin
    x1 := unit_gap;
    y1 := grp_hdr + unit_gap;
    x2 := x1 + width;
    y2 := y1 + Height;
    Exit;
  end;

  if first_time then begin
    x1 := unit_gap;
    y1 := grp_hdr + unit_gap;
    cur_left := unit_gap;
    // just assign a value
    cur_right := 0;
  end
  else if new_unit then begin
    x1 := cur_left;
    y1 := y2 + unit_gap;
  end
  else if goes_down then begin
    x1 := cur_left;
    y1 := y2 + margin;
  end
  else if new_element then begin
    x1 := x2 + ele_gap;
  end
  else begin
    x1 := x2 + margin;
  end;

  x2 := x1 + width;
  y2 := y1 + height;
  if first_time then begin
    first_time := False;
    if y2 + unit_gap > yTotal then
      ret_code := 2;
  end
  else if y2 + unit_gap > yTotal then begin
  // change into another column
    x1 := cur_right + column_gap;
    y1 := grp_hdr + unit_gap;
    x2 := x1 + width;
    y2 := y1 + height;
    ret_code := 1;
    cur_left := x1;
  end
  else begin
    ret_code := 0;
  end;
  cur_right := Max(cur_right, x2);
end;

//===== form functions/procedures go from here =====

procedure TActReport.FormClose(Sender: TObject; var Action: TCloseAction);
var
  nUserAction: Integer;
begin
  nUserAction := Application.MessageBox('是否重新生成报表?', '提问', MB_YESNOCANCEL+MB_DEFBUTTON1);
  case nUserAction of
    IDYES: begin
             Make;
             Action := caHide;
           end;
    IDNO: begin
            ParamsFromForm;
            Action := caHide;
          end;
    IDCANCEL: begin
                Action := caNone;
              end;
  end;
end;

procedure TActReport.cmbPageOrientationChange(Sender: TObject);
var
  index: Integer;
  curr1, curr2: Currency;
  str: string;
begin
  GetComboValue(cmbPageOrientation, index);
  GetEditValue(edtPaperWidth, curr1);
  GetEditValue(edtPaperHeight, curr2);
  if (index = 0) xor (curr1 < curr2) then begin
    str := edtPaperWidth.Text;
    edtPaperWidth.Text := edtPaperHeight.Text;
    edtPaperHeight.Text := str;
  end;
end;

procedure TActReport.btnMakeClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  // load parameters from the form and construct the report
  ParamsFromForm;
  BuildRep;
  ParamsFromReport;
  Screen.Cursor := crDefault;
end;

procedure TActReport.btnPreviewClick(Sender: TObject);
begin
  PreviewRep;
end;

procedure TActReport.btnPrintClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  PrintRep;
  Screen.Cursor := crDefault;
end;

procedure TActReport.btnLoadClick(Sender: TObject);
begin
  dlgOpen.FileName := m_strFileName;
  if not dlgOpen.Execute then
    Exit;
  SetFileName(dlgOpen.FileName);

  Screen.Cursor := crHourGlass;
  // load parameters and reconstruct the report
  LoadRep;
  Screen.Cursor := crDefault;
end;

procedure TActReport.btnSaveClick(Sender: TObject);
begin
  dlgSave.FileName := m_strFileName;
  if not dlgSave.Execute then
    Exit;
  SetFileName(dlgSave.FileName);

  Screen.Cursor := crHourGlass;
  // just save the parameters displayed on the form
  ParamsFromForm;