📄 mmmainfrm.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 + -