prdesigner.pas

是 delphi6的函数库

try
  if OpenPictureDialog1.Execute then
  begin
    PRClass1.SaveBmp(CellSelected,OpenPictureDialog1.FileName);
        IsSaveFlag:=false;
  end;
except
   //
end;
end
else
  MessageDlg('请先选择单元格', mtInformation,[mbOk], 0);
end;  
procedure TfrmPRDesigner.btnClearPicClick(Sender: TObject);
var Acanvas:Tcanvas;
    LTempRect:Trect;
begin
if CellSelected <>nil then
begin
  PRClass1.FreeBmp(CellSelected);
    IsSaveFlag:=false;

  ShowWindow(PRClass1.Handle, SW_HIDE);
  ScrollBox1Resize(Self);
  ShowWindow(PRClass1.Handle, SW_SHOW);
end
else
  MessageDlg('请先选择单元格', mtInformation,[mbOk], 0);
end;
procedure TfrmPRDesigner.cboFormatChange(Sender: TObject);
begin
if CellSelected <> nil then
begin
   PRClass1.SetCellDispFormt(cboFormat.items[cboFormat.itemindex]);
   IsSaveFlag:=false;
end; 
end;



procedure TfrmPRDesigner.btnInsertCellClick(Sender: TObject);
begin
  PRClass1.InsertCell;
  IsSaveFlag:=false;
end;

procedure TfrmPRDesigner.edtTextChange(Sender: TObject);
var charset:Set of char;
  sTmp1,sTmp2:string;
begin
  charset:=['0'..'9','a'..'z','A'..'Z'];
  if CellSelected <> nil then
  begin
   CellSelected.CellText:=edtText.Text;
   sTmp1:= copy(CellSelected.CellText,pos('.',CellSelected.CellText)+1,length(CellSelected.CellText)-pos('.',CellSelected.CellText));
   sTmp2:=CellSelected.CellDef;
   if (pos('.',CellSelected.CellText)>0) then
   begin
    if (sTmp2<>'') and (sTmp2[1] in charset) then CellSelected.CellDef:=sTmp1;
   end else CellSelected.CellDef:=CellSelected.CellText;
    
   cboFontChange(Sender);
   IsSaveFlag:=false;
  end;
end;
procedure TfrmPRDesigner.PRClass1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
   PRScale1.HairLinePos:=x;
   PRScale2.HairLinePos:=y;
end;

procedure TfrmPRDesigner.FormShow(Sender: TObject);
var h,i,j,k:integer;
  tmpDs: TDatasetDef;
  tmpFieldName:TStringList;
  tmpFieldLabel:TStringList;
  s2, s3: String;
begin
//
  if PRClass1.PrintLine then btnPrintLine.Down :=false  else btnPrintLine.Down := true;
  if PRClass1.AncientStyle then btnAncientStyle.Down :=false  else btnAncientStyle.Down := true;

//
  cboVF.ItemIndex :=0;
  cboFormat.itemIndex:=0;
  //
   myDatasets:=TList.Create;
   //cboVF.Items :=DSDefine;
for h:=0 to DSDefine.Count-1 do
begin
    s2 := copy(DSDefine[h], 1,pos(':', DSDefine[h])-1);
    s3:=trim(copy(DSDefine[h],pos(':', DSDefine[h])+1,length(DSDefine[h])-pos(':', DSDefine[h]))) ;
    If Pos(':', DSDefine[h])>0 Then //符合定义格式
    Begin
      tmpDs:=TDatasetDef.Create;
      tmpDs.sDefine :=s2; //定义后
      tmpDs.sDataset :=s3; //定义前
      //字段
      for i:=0 to Screen.FormCount-1 do
      for j:=0 to Screen.Forms[i].ComponentCount-1 do
       if (Screen.Forms[i].Components[j] is TDataSet) and (Screen.Forms[i].Components[j].Name=s3 ) then
       begin
         tmpFieldName:=TStringList.Create;
         tmpFieldLabel:=TStringList.Create;
          for k:=0 to  TDataSet(Screen.Forms[i].Components[j]).FieldCount-1 do
          begin
            tmpFieldName.Add(TDataSet(Screen.Forms[i].Components[j]).Fields[k].FieldName);
            tmpFieldLabel.Add(TDataSet(Screen.Forms[i].Components[j]).Fields[k].DisplayLabel);
          end;
          tmpDS.slFieldName:=tmpFieldName;
          tmpDS.slFieldLabel:=tmpFieldLabel;
        end;
      //
      myDatasets.Add(tmpDS);
    end;   //If uppercase(s1) = 'DEFINE
end;  //for h:=0 to DSDefine.
 //创建表
  frmDataFields:=TfrmDataFields.create(self);
   // frmDataFields.df:=myDatasets;
end;
procedure TfrmPRDesigner.btnDataFieldClick(Sender: TObject);
var i:integer;
  sTmp1,sTmp2:string;
begin
  if (frmDataFields.showmodal=mrOK) and (CellSelected <> nil) then
  begin
    edtText.Text:=TDatasetDef(frmDataFields.df[frmDataFields.lstDatasets.ItemIndex]).sDefine+'.'+
      TDatasetDef(frmDataFields.df[frmDataFields.lstDatasets.ItemIndex]).slFieldName[frmDataFields.lsbFields.ItemIndex];
    sTmp2:=CellSelected.CellDef;
    CellSelected.CellDef:='['+
      TDatasetDef(frmDataFields.df[frmDataFields.lstDatasets.ItemIndex]).slFieldLabel[frmDataFields.lsbFields.ItemIndex]+']';
  end;
end;
procedure TfrmPRDesigner.btnOpenClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    TempFileName := OpenDialog1.Filename;
    PRClass1.LoadFromFile(TempFileName);
    frmPRDesigner.caption := TempFileName ;
    savefilename := TempFileName;
    updateOldies(TempFileName, sender);
    TempFileName := '';
    ZoomRate:=100;
    ShowWindow(PRClass1.Handle, SW_HIDE);
    PRClass1.ReportScale := ZoomRate;
    ScrollBox1Resize(Self);
    ShowWindow(PRClass1.Handle, SW_SHOW);
  end;
end;

procedure TfrmPRDesigner.btnSaveClick(Sender: TObject);
var
  t: string;
begin
  if SaveFileName = '' then
  begin
    if SaveDialog1.Execute then
    begin
      PRClass1.SaveToFile(SaveDialog1.FileName);
      TempFileName := SaveDialog1.Filename;
      updateOldies(TempFileName, sender);
      frmPRDesigner.caption := TempFileName ;
      SaveFileName := TempFileName;
      TempFileName := '';
      IsSaveFlag:=true;
    end;
  end
  else
  begin
    PRClass1.SaveToFile(SaveFileName);
    TempFileName := SaveFileName;
    updateOldies(TempFileName, sender);
    TempFileName := '';
    IsSaveFlag:=true;

  end;
//  statusbar1.Panels[3].text := t;
end;

procedure TfrmPRDesigner.ToolButton13Click(Sender: TObject);
begin
  ZoomRate:=ZoomRate-10;
  PRClass1.FreeEdit;
  ShowWindow(PRClass1.Handle, SW_HIDE);
  PRClass1.ReportScale := ZoomRate;
  ScrollBox1Resize(Self);
  ShowWindow(PRClass1.Handle, SW_SHOW);
end;

procedure TfrmPRDesigner.ToolButton14Click(Sender: TObject);
begin
  ZoomRate:=ZoomRate+10;
  PRClass1.FreeEdit;
  ShowWindow(PRClass1.Handle, SW_HIDE);
  PRClass1.ReportScale := ZoomRate;
  ScrollBox1Resize(Self);
  ShowWindow(PRClass1.Handle, SW_SHOW);
end;

procedure TfrmPRDesigner.ToolButton12Click(Sender: TObject);
var z1,z2:integer;
begin
    if (height-160) < cp_pgh then    z1:=trunc(((height-160) / cp_pgh)*100)
  else   z1:=100;

  if (width-171) < cp_pgw then    z2:=trunc(((width-171) / cp_pgw)*100)
  else   z2:=100;

 if z1 <= z2 then   ZoomRate:=z1
 else    ZoomRate:=z2;

  PRClass1.FreeEdit;
  ShowWindow(PRClass1.Handle, SW_HIDE);
  PRClass1.ReportScale := ZoomRate;
  ScrollBox1Resize(Self);
  ShowWindow(PRClass1.Handle, SW_SHOW);
end;

procedure TfrmPRDesigner.btnSettingClick(Sender: TObject);
var
  MarginRect: TRect;
begin
  frmSetting:=TfrmSetting.create(self);

  MarginRect := PRClass1.GetMargin;
  with frmSetting do
  begin
    edtDataLine.Text:=IntToStr(PRClass1.Dataline);
    chkAddSpace.Checked:=PRClass1.AddEmptyLine;
    chkPrintLine.Checked:=not PRClass1.PrintLine;
    //
    LeftMargin.Value := MarginRect.Left;
    TopMargin.Value := MarginRect.Top;
    RightMargin.Value := MarginRect.Right;
    BottomMargin.Value := MarginRect.Bottom;
  end;
  //
  if frmSetting.showmodal=mrOK then
  with frmSetting do
  begin
    PRClass1.DataLine :=StrToInt(frmSetting.edtDataLine.Text);
    PRClass1.AddEmptyLine :=chkAddSpace.Checked;
    PRClass1.PrintLine :=not chkPrintLine.Checked;

    PRClass1.SetMargin(LeftMargin.Value,TopMargin.Value, RightMargin.Value,BottomMargin.Value);
    IsSaveFlag:=false;
    cp_pgw:=0;
    PRClass1.CalcWndSize;
  end;
end;

procedure TfrmPRDesigner.btnPrintClick(Sender: TObject);
begin
  if isprint <> 1 then PRClass1.PrintIt
     else Application.Messagebox('未安装打印机', '警告', MB_OK + MB_iconwarning);
end;

procedure TfrmPRDesigner.btnInsertLineClick(Sender: TObject);
begin
  PRClass1.InsertLine;
      IsSaveFlag:=false;
end;

procedure TfrmPRDesigner.btnAddLineClick(Sender: TObject);
begin
if CellSelected <> nil then
begin
  PRClass1.AddLine;
      IsSaveFlag:=false;
end;
end;

procedure TfrmPRDesigner.btnDeleteLineClick(Sender: TObject);
begin
  PRClass1.DeleteLine;
      IsSaveFlag:=false;

end;

procedure TfrmPRDesigner.btnAddCellClick(Sender: TObject);
begin
  PRClass1.AddCell;
      IsSaveFlag:=false;
end;

procedure TfrmPRDesigner.btnDeleteCellClick(Sender: TObject);
begin
  PRClass1.DeleteCell;
  IsSaveFlag:=false;
end;

procedure TfrmPRDesigner.btnCellSetClick(Sender: TObject);
begin
 if cellline_d <> nil then
  begin
    frmBorder.LeftLine.Checked:=CellSelected.LeftLine;
    frmBorder.TopLine.Checked:=CellSelected.TopLine;
    frmBorder.RightLine.Checked:=CellSelected.RightLine;
    frmBorder.BottomLine.Checked:=CellSelected.BottomLine;

    frmBorder.SpinEdit1.Value:=CellSelected.LeftLineWidth;
    frmBorder.SpinEdit2.Value:=CellSelected.TopLineWidth;
    frmBorder.SpinEdit3.Value:=CellSelected.RightLineWidth;
    frmBorder.SpinEdit4.Value:=CellSelected.BottomLineWidth;

    if frmBorder.ShowModal = mrOK then
      with frmBorder do
      PRClass1.SetCellLines(LeftLine.Checked,
        TopLine.Checked,
        RightLine.Checked,
        BottomLine.Checked,
        SpinEdit1.Value, SpinEdit2.Value, SpinEdit3.Value, SpinEdit4.Value);
    IsSaveFlag:=false;
  end else Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
end;

procedure TfrmPRDesigner.ToolButton9Click(Sender: TObject);
var
  nDiagonal: UINT;
begin
if CellSelected <> nil then
  if frmIncline.ShowModal = mrOK then
  begin
    with frmIncline do
    begin
      nDiagonal := 0;
      if LeftDiagonal1.Checked then
        nDiagonal := nDiagonal or LINE_LEFT1;

      if LeftDiagonal2.Checked then
        nDiagonal := nDiagonal or LINE_LEFT2;

      if LeftDiagonal3.Checked then
        nDiagonal := nDiagonal or LINE_LEFT3;

      if RightDiagonal1.Checked then
        nDiagonal := nDiagonal or LINE_RIGHT1;

      if RightDiagonal2.Checked then
        nDiagonal := nDiagonal or LINE_RIGHT2;

      if RightDiagonal3.Checked then
        nDiagonal := nDiagonal or LINE_RIGHT3;
      PRClass1.SetCellDiagonal(nDiagonal);
    IsSaveFlag:=false;
    end;
  end;
end;

procedure TfrmPRDesigner.btnFontClick(Sender: TObject);
var
  CellFont: TLogFont;
  hTempDC: HDC;
  pt, ptOrg: TPoint;
begin
  if cellline_d <> nil then
  begin
    hTempDC := GetDC(0);
    pt.y := abs(PRClass1.cellFont_d.lfheight) * 720 div GetDeviceCaps(hTempDC, LOGPIXELSY);
    DPtoLP(hTempDC, pt, 1);
    ptOrg.x := 0;
    ptOrg.y := 0;
    DPtoLP(hTempDC, ptOrg, 1);

    FontDialog1.Font.Name := PRClass1.cellFont_d.lfFaceName;
    FontDialog1.Font.Size := ((pt.y - ptOrg.y) div 10);

    if FontDialog1.Execute then
    begin
      Windows.GetObject(FontDialog1.Font.Handle, SizeOf(CellFont), @CellFont);
      PRClass1.SetCellFont(CellFont);
      PRClass1.SetCellColor(FontDialog1.Font.color, ColorForm.Panel1.Color);
      IsSaveFlag:=false;
    end;
  end
  else Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
end;

procedure TfrmPRDesigner.btnColorClick(Sender: TObject);
begin
  if cellline_d <> nil then
  begin
    if ColorForm.ShowModal = mrOK then
    begin
      PRClass1.SetCellColor(ColorForm.Panel1.Font.Color, ColorForm.Panel1.Color);
    IsSaveFlag:=false;
    end;
  end
  else Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
end;

procedure TfrmPRDesigner.edtDefChange(Sender: TObject);
begin
  if CellSelected <> nil then
  begin
  // CellSelected.CellDef:=edtDef.Text;
   cboFontChange(Sender);
   IsSaveFlag:=false;
  end;
end;

procedure TfrmPRDesigner.btnExitClick(Sender: TObject);
begin
 close;
end;



procedure TfrmPRDesigner.btnPreviewClick(Sender: TObject);
begin
//TPRExcute(OWner).PrintPreview(true);
end;

procedure TfrmPRDesigner.btnPrintLineClick(Sender: TObject);
begin
  PRClass1.PrintLine:=not btnPrintLine.Down;
end;

procedure TfrmPRDesigner.btnAncientStyleClick(Sender: TObject);
begin
  PRClass1.AncientStyle:=not btnAncientStyle.Down;
end;

end.