prdesigner.pas

是 delphi6的函数库

end;

procedure TfrmPRDesigner.RecentFile1(sender: tobject);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(SysIni);
  TempFileName := inifile.readstring('Oldies', '1', '');
  if TempFileName <> '' then FileOpen1(sender);
end;

procedure TfrmPRDesigner.RecentFile2(sender: tobject);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(SysIni);
  TempFileName := inifile.readstring('Oldies', '2', '');
  if TempFileName <> '' then FileOpen1(sender);
end;

procedure TfrmPRDesigner.RecentFile3(sender: tobject);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(SysIni);
  TempFileName := inifile.readstring('Oldies', '3', '');
  if TempFileName <> '' then FileOpen1(sender);
end;

procedure TfrmPRDesigner.RecentFile4(sender: tobject);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(SysIni);
  TempFileName := inifile.readstring('Oldies', '4', '');
  if TempFileName <> '' then FileOpen1(sender);
end;

procedure TfrmPRDesigner.RecentFile5(sender: tobject);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(SysIni);
  TempFileName := inifile.readstring('Oldies', '5', '');
  if TempFileName <> '' then FileOpen1(sender);
end;

procedure TfrmPRDesigner.RecentFile6(sender: tobject);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(SysIni);
  TempFileName := inifile.readstring('Oldies', '6', '');
  if TempFileName <> '' then FileOpen1(sender);
end;

procedure TfrmPRDesigner.RecentFile7(sender: tobject);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(SysIni);
  TempFileName := inifile.readstring('Oldies', '7', '');
  if TempFileName <> '' then FileOpen1(sender);
end;

procedure TfrmPRDesigner.RecentFile8(sender: tobject);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(SysIni);
  TempFileName := inifile.readstring('Oldies', '8', '');
  if TempFileName <> '' then FileOpen1(sender);
end;

procedure TfrmPRDesigner.RecentFile9(sender: tobject);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(SysIni);
  TempFileName := inifile.readstring('Oldies', '9', '');
  if TempFileName <> '' then FileOpen1(sender);
end;

procedure TfrmPRDesigner.T1Click(Sender: TObject);
var
  NewItem: TMenuItem;
  count, A, B, wipe: string;
  n, m: integer;
  IniFile: TIniFile;
label
  redo;
begin
  IniFile := TIniFile.create(SysIni);
  while file1.count > 0 do
    file1.Delete(0);
  for n := 1 to 9 do
  begin
    count := inttostr(n);
    redo: //循环开始
    A := inifile.readstring('Oldies', count, '');
    if A = '' then exit;
    if not fileexists(A) then
    begin
      for m := strtoint(count) to 10 do
      begin
        B := inifile.readstring('Oldies', inttostr(m + 1), '');
        inifile.writestring('Oldies', inttostr(m), B);
        wipe := inttostr(m + 1);
      end;
      inifile.writestring('Oldies', wipe, '');
      goto redo; //循环结束
    end;
    NewItem := TMenuItem.Create(Self);
    NewItem.Caption := '&' + count + ' ' + A;
    case n of
      1: newitem.onclick := RecentFile1;
      2: newitem.onclick := RecentFile2;
      3: newitem.onclick := RecentFile3;
      4: newitem.onclick := RecentFile4;
      5: newitem.onclick := RecentFile5;
      6: newitem.onclick := RecentFile6;
      7: newitem.onclick := RecentFile7;
      8: newitem.onclick := RecentFile8;
      9: newitem.onclick := RecentFile9;
    end;
//    File1.Insert(n-1, NewItem);
    File1.Add(NewItem);
  end;

end;

procedure TfrmPRDesigner.ScrollBox1Resize(Sender: TObject);
begin
   PRClass1.Left := 24;
   PRClass1.top:=24;
end;

procedure TfrmPRDesigner.left1Click(Sender: TObject);
var
  h, v: byte;
begin
  h := 3;
  v := 3;
  if btnAlignLeft.Down then h := 0;
  if btnAlignCenter.down then h := 1;
  if btnAlignRight.down then h := 2;
  if btnVertTop.Down then v := 0;
  if btnVertCenter.Down then v := 1;
  if btnVertBottom.down then v := 2;
  PRClass1.SetCellAlign(H, v);
  IsSaveFlag:=false;
end;

procedure TfrmPRDesigner.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  key: integer;
begin
  canclose:=false;
  if (SaveFileName <> '') then
  begin
    key := Application.Messagebox('保存文件按“是”，不保存文件按“否”，取消本次操作按“取消”', '注意', MB_YESNOCANCEL + MB_ICONEXCLAMATION); //+MB_ICONQUESTION);
    if key = Mryes then btnSaveclick(sender);
    if key <> MrCancel then canclose:=true;
  end   else canclose:=true;
end;

procedure TfrmPRDesigner.PRClass1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);// update 
var
  hTempDC: HDC;
  pt, ptOrg: TPoint;
  i: integer;
begin
if ssright in shift then
begin
   pt:=(Sender as TWinControl).ClienttoScreen(point(x,y));
   PopupMenu1.Popup(pt.X,pt.Y);
end;

if ssleft in shift then
try
 Panel3.Enabled:=false;
 Panel4.Enabled:=false;
 if CellSelected <> nil then
  begin

    if CellSelected.HorzAlign = 0 then btnAlignLeft.Down := true;
    if CellSelected.HorzAlign = 1 then btnAlignCenter.Down := true;
    if CellSelected.HorzAlign = 2 then btnAlignRight.Down := true;
    if CellSelected.vertAlign = 0 then btnVertTop.Down := true;
    if CellSelected.vertAlign = 1 then btnVertCenter.Down := true;
    if CellSelected.vertAlign = 2 then btnVertBottom.Down := true;
    if CellSelected.LogFont.lfItalic = 1 then btnItalic.Down := true else btnItalic.Down := false;
    if CellSelected.LogFont.lfUnderline = 1 then btnUnderline.Down := true else btnUnderline.Down := false;
    if CellSelected.LogFont.lfWeight = 700 then btnBold.Down := true else btnBold.Down := false;
    for i := 0 to cboFont.items.Count do
    begin
      if CellSelected.LogFont.lfFaceName = cboFont.Items[i] then
      begin
        cboFont.ItemIndex := i;
        break;
      end;
    end;
    hTempDC := GetDC(0);
    pt.y := abs(CellSelected.LogFont.lfheight) * 720 div GetDeviceCaps(hTempDC, LOGPIXELSY);
    DPtoLP(hTempDC, pt, 1);
    ptOrg.x := 0;
    ptOrg.y := 0;
    DPtoLP(hTempDC, ptOrg, 1);
    cboFontSize.Text := inttostr((pt.y - ptOrg.y) div 10);
    edtText.Text:=CellSelected.CellText;
    cboFormat.Text:= CellSelected.CellDispformat;
    edtText.SelStart:=Length(edtText.Text);
  end;
  except
  end;

  Panel3.Enabled:=true;
  Panel4.Enabled:=true;
end;

procedure TfrmPRDesigner.PRClass1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ZoomRate:=100; // add
end;

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

procedure TfrmPRDesigner.FormResize(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;

  ShowWindow(PRClass1.Handle, SW_HIDE);
  PRClass1.ReportScale := ZoomRate;
  ScrollBox1Resize(Self);
  ShowWindow(PRClass1.Handle, SW_SHOW);
end;
//以下均为增加
procedure TfrmPRDesigner.ListBoxDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);           // 
begin
   Accept:=true;
end;

procedure TfrmPRDesigner.PRClass1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);  
begin
 Accept:=true;
end;

procedure TfrmPRDesigner.PRClass1DragDrop(Sender, Source: TObject; X, Y: Integer); 
begin
  if Source is Tlistbox then
  begin
    PRClass1.FreeEdit;
    CellSelected:=nil;
    mouse_event( MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 );
    mouse_event( MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 );
    Application.ProcessMessages;
    if CellSelected <> nil then
    begin
       CellSelected.CellText:='#T1.'+tlistbox(Source).Items[tlistbox(Source).ItemIndex];
       PRClass1.UpdateLines;
       mouse_event( MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 );
       mouse_event( MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 );
    end;
  end;
end;

procedure TfrmPRDesigner.cboVFChange(Sender: TObject);
begin
 if CellSelected <> nil then
 if PRClass1.IsCellSelected(CellSelected) then
  begin
   edtText.Text:='['+cboVF.Items[cboVF.ItemIndex]+']';

   cboFontChange(Sender);
     IsSaveFlag:=false;
  end;
end;

procedure TfrmPRDesigner.SpeedButton16Click(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.cboFontChange(Sender: TObject);
var
  CellFont: TLogFont;
  cf: TFont;
  i, code: integer;
begin
  if CellSelected <> nil then
  begin
    cf := Tfont.Create;
    cf.Name := cboFont.items[cboFont.itemindex];
    val(cboFontSize.text, i, code);
    if i < 1 then i := 9;
    cf.Size := i;
    if btnBold.Down then cf.Style := cf.style + [fsBold];
    if btnItalic.Down then cf.Style := cf.style + [fsItalic];
    if btnUnderline.Down then cf.Style := cf.style + [fsunderline];

    Windows.GetObject(cf.Handle, SizeOf(CellFont), @CellFont);
    cf.Free;
    PRClass1.SetCellFont(CellFont);
    IsSaveFlag:=false;
  end;
end;

procedure TfrmPRDesigner.cboFontSizeChange(Sender: TObject);
var
  CellFont: TLogFont;
  cf: TFont;
  i, code: integer;
begin
  if CellSelected <> nil then
  begin

    cf := Tfont.Create;
    cf.Name := cboFont.items[cboFont.itemindex];
    val(cboFontSize.text, i, code);
    if i < 1 then i := 9;
    cf.Size := i;
    if btnBold.Down then cf.Style := cf.style + [fsBold];
    if btnItalic.Down then cf.Style := cf.style + [fsItalic];
    if btnUnderline.Down then cf.Style := cf.style + [fsunderline];
    Windows.GetObject(cf.Handle, SizeOf(CellFont), @CellFont);
    cf.Free;
    PRClass1.SetCellFont(CellFont);
        IsSaveFlag:=false;

  end;
end;


procedure TfrmPRDesigner.btnAlignLeftClick(Sender: TObject);
var
  h, v: byte;
begin
  h := 3;
  v := 3;
  if btnAlignLeft.Down then h := 0;
  if btnAlignCenter.down then h := 1;
  if btnAlignRight.down then h := 2;
  if btnVertTop.Down then v := 0;
  if btnVertCenter.Down then v := 1;
  if btnVertBottom.down then v := 2;
  PRClass1.SetCellAlign(H, v);
  IsSaveFlag:=false;
end;

procedure TfrmPRDesigner.btnBoldClick(Sender: TObject);
var
  CellFont: TLogFont;
  cf: TFont;
  i, code: integer;
begin
  if CellSelected <> nil then
  begin
    cf := Tfont.Create;
    cf.Name := cboFont.items[cboFont.itemindex];
    val(cboFontsize.text, i, code);
    if i < 1 then i := 9;
    cf.Size := i;
    if btnBold.Down then cf.Style := cf.style + [fsBold];
    if btnItalic.Down then cf.Style := cf.style + [fsItalic];
    if btnUnderline.Down then cf.Style := cf.style + [fsunderline];

    Windows.GetObject(cf.Handle, SizeOf(CellFont), @CellFont);
    cf.Free;
    PRClass1.SetCellFont(CellFont);
    IsSaveFlag:=false;  
  end;
end;

procedure TfrmPRDesigner.btnMergeClick(Sender: TObject);
begin
  PRClass1.CombineCell;
      IsSaveFlag:=false;
end;

procedure TfrmPRDesigner.btnMergeAcrossClick(Sender: TObject);
begin
if CellSelected <> nil then
  if frmSplit.ShowModal = mrOK then
  begin
    PRClass1.VSplitCell(frmSplit.VSplitCount.Value);
        IsSaveFlag:=false;
  end;
end;

procedure TfrmPRDesigner.btnUnmergeClick(Sender: TObject);
begin
//拆分单元格
  PRClass1.SplitCell;
  cboFontChange(Sender);
    IsSaveFlag:=false;
end;

procedure TfrmPRDesigner.btnAddPicClick(Sender: TObject);
begin
if CellSelected <>nil then
begin