wplabelfrm.pas

wptools5 pro 完整源代码 Msword界面的文本编辑器源代码

unit WPLabelFrm;
{ Label printing with WPTools 5
  This form uses the XMLTree of the shared library to store the
  label definitions }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, WPRTEDefs, WPCTRMemo, WPCTRRich, StdCtrls, ExtCtrls, WPCTRPrint,
  WPUtil, ComCtrls, Printers, WPXMLint, WPRuler;

type
  TWPLabelForm = class(TForm)
    PageControl1: TPageControl;
    AddressTab: TTabSheet;
    LabelDef: TTabSheet;
    grpMarginsPages: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    TopMargin: TWPValueEdit;
    LeftMargin: TWPValueEdit;
    RightMargin: TWPValueEdit;
    BottomMargin: TWPValueEdit;
    HorzMargin: TWPValueEdit;
    VertMargin: TWPValueEdit;
    labColCount: TLabel;
    ColCount: TWPValueEdit;
    labRowCount: TLabel;
    RowCount: TWPValueEdit;
    Label3: TLabel;
    Bevel1: TBevel;
    WPSuperPrint1: TWPSuperPrint;
    Panel1: TPanel;
    PaintBox1: TPaintBox;
    SelectLabelName: TComboBox;
    NewLabelDef: TButton;
    DeleteLabelDef: TButton;
    WPRichText1: TWPRichText;
    PrinterSetupDialog1: TPrinterSetupDialog;
    Label6: TLabel;
    Label7: TLabel;
    PageWidth: TWPValueEdit;
    PageHeight: TWPValueEdit;
    Panel2: TPanel;
    Button2: TButton;
    Button1: TButton;
    Button3: TButton;
    WPRuler1: TWPRuler;
    Panel3: TPanel;
    Button4: TButton;
    Copies: TWPValueEdit;
    Label8: TLabel;
    StartRow: TWPValueEdit;
    Label5: TLabel;
    StartCol: TWPValueEdit;
    Label4: TLabel;
    procedure PaintBox1Paint(Sender: TObject);
    procedure ColCountChange(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure NewLabelDefClick(Sender: TObject);
    procedure SelectLabelNameClick(Sender: TObject);
    procedure DeleteLabelDefClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    FLocked: Boolean;
    path: string;
    WPXMLTree1: TWPXMLTree;
    procedure UpdateSelectLabelName;
  public
    {:: This procedure uses the first lines in the editor }
    procedure LoadAddress(Source: TWPCustomRichText);
    function LoadLabel(const labname: string): Boolean;
    procedure SaveLabel(const labname: string);
  end;

var
  WPLabelForm: TWPLabelForm;

implementation

{$R *.dfm}

procedure TWPLabelForm.LoadAddress(Source: TWPCustomRichText);
var par, apar: TParagraph;
  i, c: Integer;
  b: Boolean;
begin
  WPRichText1.Clear;
  par := Source.BodyText.FirstPar;
  b := FALSE;
  c := 0;
  while par <> nil do
  begin
    if (c<8) and not par.IsEmpty then
    begin
      apar := WPRichText1.BodyText.AppendNewPar;
      apar.SetText(Trim(par.ANSIText));
      apar.ASet(WPAT_IndentLeft, 72);
      apar.ASet(WPAT_IndentRight, 72);
      inc(c);
      b := TRUE;
    end else if b then break;
    par := par.next;
  end;
  ColCountChange(nil);
  WPRichText1.SelectAll;
  WPRichText1.TextCursor.SelectedTextAttr.SetFontName('Arial');
  WPRichText1.TextCursor.SelectedTextAttr.SetFontSize(11);
  WPRichText1.HideSelection;
  WPRichText1.Refresh;
end;

procedure TWPLabelForm.PaintBox1Paint(Sender: TObject);
begin
  WPSuperPrint1.PaintPreview;
end;

procedure TWPLabelForm.FormCreate(Sender: TObject);
var dc: Cardinal;
begin
  WPXMLTree1 := TWPXMLTree.Create(Self);
  path := ExtractFilePath(Application.EXEName) + '\labeldef.xml';
  if FileExists(path) then
  begin
    WPXMLTree1.LoadFromFile(path);
    UpdateSelectLabelName;
  end;

  if not LoadLabel('current') then
  begin
    FLocked := TRUE;
    dc := Printer.Handle;
    GlobalValueUnit := euCm;
    PageWidth.Value := MulDiv(GetDeviceCaps(dc, PHYSICALWIDTH), 1440, GetDeviceCaps(dc, LOGPIXELSX));
    PageHeight.Value := MulDiv(GetDeviceCaps(dc, PHYSICALHEIGHT), 1440, GetDeviceCaps(dc, LOGPIXELSY));

    LeftMargin.Value := MulDiv(GetDeviceCaps(dc, PHYSICALOFFSETX), 1440, GetDeviceCaps(dc, LOGPIXELSX));
    TopMargin.Value := MulDiv(GetDeviceCaps(dc, PHYSICALOFFSETY), 1440, GetDeviceCaps(dc, LOGPIXELSY));
    RightMargin.Value := LeftMargin.Value;
    BottomMargin.Value := TopMargin.Value;
    FLocked := FALSE;
    ColCountChange(nil);
  end;
end;

procedure TWPLabelForm.FormDestroy(Sender: TObject);
begin
  SaveLabel('current');
  WPXMLTree1.SaveToFile(path);
  WPXMLTree1.Free;
end;


procedure TWPLabelForm.ColCountChange(Sender: TObject);
begin
  if FLocked then exit;
  WPSuperPrint1.PageWidth := PageWidth.Value;
  WPSuperPrint1.PageHeight := PageHeight.Value;

  WPSuperPrint1.Rows := RowCount.IntValue;
  WPSuperPrint1.Columns := ColCount.IntValue;
  WPSuperPrint1.MarginTop := TopMargin.Value;
  WPSuperPrint1.MarginLeft := LeftMargin.Value;
  WPSuperPrint1.MarginRight := RightMargin.Value;
  WPSuperPrint1.MarginBottom := BottomMargin.Value;
  WPSuperPrint1.InbetweenHorz := HorzMargin.Value;
  WPSuperPrint1.InbetweenVert := VertMargin.Value;

  WPSuperPrint1.LabelStartRow := StartRow.Value;
  WPSuperPrint1.LabelStartColumn := StartCol.Value;
  WPSuperPrint1.Copies := Copies.Value;

  WPRichText1.Header.SetPageWH(
    WPSuperPrint1.Width,
    WPSuperPrint1.Height,
    0, 0, 0, 0);
  WPRichText1.ReformatAll;
end;

procedure TWPLabelForm.Button2Click(Sender: TObject);
var dc: Cardinal;
begin
  PrinterSetupDialog1.Execute;
  dc := Printer.Handle;
  PageWidth.Value := MulDiv(GetDeviceCaps(dc, PHYSICALWIDTH), 1440, GetDeviceCaps(dc, LOGPIXELSX));
  PageHeight.Value := MulDiv(GetDeviceCaps(dc, PHYSICALHEIGHT), 1440, GetDeviceCaps(dc, LOGPIXELSY));
end;

procedure TWPLabelForm.Button1Click(Sender: TObject);
begin
  Printer.Title := 'Label';
  Printer.BeginDoc;
  WPSuperPrint1.Paint(
    Printer.Canvas,
    -GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX), // Offset in pixels
    -GetDeviceCaps(Printer.Handle, PHYSICALOFFSETy), // Offset in pixels
    GetDeviceCaps(Printer.Handle, LOGPIXELSY) / 1440, // Multiplicator for Parameters (twips->Canvas)
    [wpDoNotScalePage]); // Options
  Printer.EndDoc;
end;

procedure TWPLabelForm.Button4Click(Sender: TObject);
begin
  if not WPRichText1.IsSelected then WPRichText1.SelectAll;
  WPRichText1.FontSelect;
end;


procedure TWPLabelForm.NewLabelDefClick(Sender: TObject);
var s : string;
begin
  s := SelectLabelName.Text;
  if InputQuery('Label Name', 'Name', s) and (s<>'') then
    SaveLabel(s);
end;

// Load and save label to and from XML:

function TWPLabelForm.LoadLabel(const labname: string): Boolean;
var lab: TWPXMLOneLevel;
  i: Integer;
  function EleValue(const EleName: string; Def: Integer): Integer;
  var ele: TWPXMLOneLevel;
  begin
    ele := lab.Find(EleName);
    if ele <> nil then Result := StrToIntDef(ele.Content, Def)
    else Result := Def;
  end;
begin
  lab := WPXMLTree1.FindParName('Labels' , labname);
  if lab = nil then Result := FALSE else
  begin
    for i := 0 to grpMarginsPages.ControlCount - 1 do
      if grpMarginsPages.Controls[i] is TWPValueEdit then
        TWPValueEdit(grpMarginsPages.Controls[i]).Value :=
          EleValue(TWPValueEdit(grpMarginsPages.Controls[i]).Name,
          TWPValueEdit(grpMarginsPages.Controls[i]).Value);
  end;
end;

procedure TWPLabelForm.UpdateSelectLabelName;
var lab: TWPXMLOneLevel;
  i: Integer;
begin
  lab := WPXMLTree1.Tree.AddTag('Labels');
  SelectLabelName.Items.Clear;
  if lab <> nil then
    for i := 0 to lab.Count - 1 do
      SelectLabelName.Items.Add(lab.Elements[i].ParamValue['Name']);
end;

procedure TWPLabelForm.SaveLabel(const labname: string);
var lab, ele: TWPXMLOneLevel;
  i: Integer;
begin
  lab := WPXMLTree1.FindParName('Labels' , labname);
  if lab=nil then
  begin
     lab := WPXMLTree1.Tree.AddTag('Labels');
     lab := lab.AppendTag('Def');
     lab.ParamValue['Name'] := labname;
  end;
  if lab <> nil then
    for i := 0 to grpMarginsPages.ControlCount - 1 do
      if grpMarginsPages.Controls[i] is TWPValueEdit then
        lab.AddTagValue(TWPValueEdit(grpMarginsPages.Controls[i]).Name,
          IntToStr(TWPValueEdit(grpMarginsPages.Controls[i]).Value));
  UpdateSelectLabelName;
  SelectLabelName.ItemIndex := SelectLabelName.Items.IndexOf(labname);
end;

procedure TWPLabelForm.SelectLabelNameClick(Sender: TObject);
begin
  LoadLabel(SelectLabelName.Text);
end;

procedure TWPLabelForm.DeleteLabelDefClick(Sender: TObject);
var lab: TWPXMLOneLevel;
begin
  if SelectLabelName.ItemIndex >= 0 then
  begin
    lab := WPXMLTree1.FindParName('Labels' , SelectLabelName.Text);
    if (lab <> nil) and (MessageDlg('Delete label definition "' + SelectLabelName.Text + '"',
      mtConfirmation, [mbOK, mbCancel], 0) = IDOK) then lab.Free;
    UpdateSelectLabelName;
    SelectLabelName.ItemIndex := -1;
  end;
end;

procedure TWPLabelForm.Button3Click(Sender: TObject);
begin
  Close;
end;

end.