MMMainFrm.pas
上传用户:daoqigc
上传日期:2021-04-20
资源大小:2795k
文件大小:5k
- 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.