⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mmmainfrm.pas

📁 与Action相结合,可以解决中文件显示乱码
💻 PAS
字号:
unit MMMainFrm;
{------------------------------------------------------------------------------}
{
  Very simple "mail merging" application.
  It loads a template from TEMPLATE.RVF, and data from CUSTOMERS.TXT.
  Template can be modified with another application in this directory:
  TEMPLATEEDITOR.

  Main settings:
  - since field names are stored in tags (see the help topic about tags)
    as strings, rvoTagsArePChars is included in Options of rvTemplate and
    rvOutput.
  - this demo uses a predefined set of styles (right click richviews,
    choose "Settings" from the context menu, choose "Use a predefined
    set of styles"). That means - only two text styles (see below) will be used.
  - rvOutput.Style = rvsOutput, rvTemplate.Style = rvsTemplate.
  - rvsTemplate has absolutely the same set of TextStyles as in template editor
    (0th style - normal text, 1th - field code)
  - rvsOutput has a similar set of styles, but 1th text style looks like
    normal text.
}
{------------------------------------------------------------------------------}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, RVScroll, RichView, StdCtrls, RVStyle, RVTable, CRVData;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    rvOutput: TRichView;
    rvsOutput: TRVStyle;
    rvsTemplate: TRVStyle;
    rvTemplate: TRichView;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    Codes: TStringList;
    procedure LoadCustomers;
    function GetFieldValueFromDatabase(const FieldName: String): String;
    procedure FillFields(RVData: TCustomRVData);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

{------------------------------------------------------------------------------}
{
  This procedure loads file CUSTOMERS.TXT into:
  - ListBox1.Items (<- names of customers)
  - Codes (<- codes of customers)

  In real applications data can be stored in some database
}
procedure TForm1.LoadCustomers;
var F: TextFile;
    i, Count: Integer;
    s: String;
begin
  AssignFile(F, ExtractFilePath(Application.ExeName)+'Customers.txt');
  Reset(F);
  try
    Readln(F, Count);
    for i := 0 to Count-1 do
    begin
      Readln(F, s);
      Codes.Add(s);
      Readln(F, s);
      ListBox1.Items.Add(Trim(s))
    end;
  finally
    CloseFile(F);
  end;
end;
{------------------------------------------------------------------------------}
{
  Initialization: loading template into rvOutput, loading customers data.
}
procedure TForm1.FormCreate(Sender: TObject);
begin
  Codes := TStringList.Create;
  LoadCustomers;
  rvTemplate.LoadRVF(ExtractFilePath(Application.ExeName)+'template.rvf');
  rvTemplate.Format;
  if ListBox1.Items.Count>0 then
  begin
    ListBox1.ItemIndex := 0;
    ListBox1.OnClick(nil);
  end;
end;
{------------------------------------------------------------------------------}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Codes.Free;
  Codes := nil;
end;
{------------------------------------------------------------------------------}
{
  This function returns a current field value by the field name.
  In this example, we have two fields: "name" and "code"
}
function TForm1.GetFieldValueFromDatabase(const FieldName: String): String;
var Index: Integer;
begin
  Index := ListBox1.ItemIndex;
  if FieldName='name' then
    Result := ListBox1.Items[Index]
  else if FieldName='code' then
    Result := Codes[Index]
  else
    Result := '{error: illegal field code}';
end;
{------------------------------------------------------------------------------}
{
  This function iterates through all items in RVData, and if tag of
  some text contains non-empty text, it calls GetFieldValueFromDatabase(tag) and
  replace this text with returned value.
  You can move this function to your application unchanged.
  Initial call: FillFields(RichView.RVData);
}
procedure TForm1.FillFields(RVData: TCustomRVData);
var i,r,c: Integer;
    table: TRVTableItemInfo;
    FieldName: String;
begin
  for i := 0 to RVData.ItemCount-1 do
    if RVData.GetItemStyle(i)=rvsTable then
    begin
      table := TRVTableItemInfo(RVData.GetItem(i));
      for r := 0 to table.Rows.Count-1 do
        for c := 0 to table.Rows[r].Count-1 do
          if table.Cells[r,c]<>nil then
            FillFields(table.Cells[r,c].GetRVData);
      table.Changed;
    end
    else if RVData.GetItemStyle(i)>=0 then
    begin
      FieldName := PChar(RVData.GetItemTag(i));
      if FieldName<>'' then
        RVData.SetItemText(i, GetFieldValueFromDatabase(FieldName));
    end;
end;
{------------------------------------------------------------------------------}
{
  On highlighting a new list box item: updating document in rvOutput.
}
procedure TForm1.ListBox1Click(Sender: TObject);
begin
  rvOutput.Clear;
  if ListBox1.ItemIndex>=0 then
  begin
    rvOutput.LoadRVF(ExtractFilePath(Application.ExeName)+'template.rvf');
    FillFields(rvOutput.RVData);
    rvOutput.Format;
  end;
end;



end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -