MMMainFrm.pas
上传用户:daoqigc
上传日期:2021-04-20
资源大小:2795k
文件大小:5k
源码类别:

RichEdit

开发平台:

Delphi

  1. unit MMMainFrm;
  2. {------------------------------------------------------------------------------}
  3. {
  4.   Very simple "mail merging" application.
  5.   It loads a template from TEMPLATE.RVF, and data from CUSTOMERS.TXT.
  6.   Template can be modified with another application in this directory:
  7.   TEMPLATEEDITOR.
  8.   Main settings:
  9.   - since field names are stored in tags (see the help topic about tags)
  10.     as strings, rvoTagsArePChars is included in Options of rvTemplate and
  11.     rvOutput.
  12.   - this demo uses a predefined set of styles (right click richviews,
  13.     choose "Settings" from the context menu, choose "Use a predefined
  14.     set of styles"). That means - only two text styles (see below) will be used.
  15.   - rvOutput.Style = rvsOutput, rvTemplate.Style = rvsTemplate.
  16.   - rvsTemplate has absolutely the same set of TextStyles as in template editor
  17.     (0th style - normal text, 1th - field code)
  18.   - rvsOutput has a similar set of styles, but 1th text style looks like
  19.     normal text.
  20. }
  21. {------------------------------------------------------------------------------}
  22. interface
  23. uses
  24.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  25.   Dialogs, RVScroll, RichView, StdCtrls, RVStyle, RVTable, CRVData;
  26. type
  27.   TForm1 = class(TForm)
  28.     ListBox1: TListBox;
  29.     rvOutput: TRichView;
  30.     rvsOutput: TRVStyle;
  31.     rvsTemplate: TRVStyle;
  32.     rvTemplate: TRichView;
  33.     Label1: TLabel;
  34.     Label2: TLabel;
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure ListBox1Click(Sender: TObject);
  37.     procedure FormDestroy(Sender: TObject);
  38.   private
  39.     { Private declarations }
  40.     Codes: TStringList;
  41.     procedure LoadCustomers;
  42.     function GetFieldValueFromDatabase(const FieldName: String): String;
  43.     procedure FillFields(RVData: TCustomRVData);
  44.   public
  45.     { Public declarations }
  46.   end;
  47. var
  48.   Form1: TForm1;
  49. implementation
  50. {$R *.dfm}
  51. { TForm1 }
  52. {------------------------------------------------------------------------------}
  53. {
  54.   This procedure loads file CUSTOMERS.TXT into:
  55.   - ListBox1.Items (<- names of customers)
  56.   - Codes (<- codes of customers)
  57.   In real applications data can be stored in some database
  58. }
  59. procedure TForm1.LoadCustomers;
  60. var F: TextFile;
  61.     i, Count: Integer;
  62.     s: String;
  63. begin
  64.   AssignFile(F, ExtractFilePath(Application.ExeName)+'Customers.txt');
  65.   Reset(F);
  66.   try
  67.     Readln(F, Count);
  68.     for i := 0 to Count-1 do
  69.     begin
  70.       Readln(F, s);
  71.       Codes.Add(s);
  72.       Readln(F, s);
  73.       ListBox1.Items.Add(Trim(s))
  74.     end;
  75.   finally
  76.     CloseFile(F);
  77.   end;
  78. end;
  79. {------------------------------------------------------------------------------}
  80. {
  81.   Initialization: loading template into rvOutput, loading customers data.
  82. }
  83. procedure TForm1.FormCreate(Sender: TObject);
  84. begin
  85.   Codes := TStringList.Create;
  86.   LoadCustomers;
  87.   rvTemplate.LoadRVF(ExtractFilePath(Application.ExeName)+'template.rvf');
  88.   rvTemplate.Format;
  89.   if ListBox1.Items.Count>0 then
  90.   begin
  91.     ListBox1.ItemIndex := 0;
  92.     ListBox1.OnClick(nil);
  93.   end;
  94. end;
  95. {------------------------------------------------------------------------------}
  96. procedure TForm1.FormDestroy(Sender: TObject);
  97. begin
  98.   Codes.Free;
  99.   Codes := nil;
  100. end;
  101. {------------------------------------------------------------------------------}
  102. {
  103.   This function returns a current field value by the field name.
  104.   In this example, we have two fields: "name" and "code"
  105. }
  106. function TForm1.GetFieldValueFromDatabase(const FieldName: String): String;
  107. var Index: Integer;
  108. begin
  109.   Index := ListBox1.ItemIndex;
  110.   if FieldName='name' then
  111.     Result := ListBox1.Items[Index]
  112.   else if FieldName='code' then
  113.     Result := Codes[Index]
  114.   else
  115.     Result := '{error: illegal field code}';
  116. end;
  117. {------------------------------------------------------------------------------}
  118. {
  119.   This function iterates through all items in RVData, and if tag of
  120.   some text contains non-empty text, it calls GetFieldValueFromDatabase(tag) and
  121.   replace this text with returned value.
  122.   You can move this function to your application unchanged.
  123.   Initial call: FillFields(RichView.RVData);
  124. }
  125. procedure TForm1.FillFields(RVData: TCustomRVData);
  126. var i,r,c: Integer;
  127.     table: TRVTableItemInfo;
  128.     FieldName: String;
  129. begin
  130.   for i := 0 to RVData.ItemCount-1 do
  131.     if RVData.GetItemStyle(i)=rvsTable then
  132.     begin
  133.       table := TRVTableItemInfo(RVData.GetItem(i));
  134.       for r := 0 to table.Rows.Count-1 do
  135.         for c := 0 to table.Rows[r].Count-1 do
  136.           if table.Cells[r,c]<>nil then
  137.             FillFields(table.Cells[r,c].GetRVData);
  138.       table.Changed;
  139.     end
  140.     else if RVData.GetItemStyle(i)>=0 then
  141.     begin
  142.       FieldName := PChar(RVData.GetItemTag(i));
  143.       if FieldName<>'' then
  144.         RVData.SetItemText(i, GetFieldValueFromDatabase(FieldName));
  145.     end;
  146. end;
  147. {------------------------------------------------------------------------------}
  148. {
  149.   On highlighting a new list box item: updating document in rvOutput.
  150. }
  151. procedure TForm1.ListBox1Click(Sender: TObject);
  152. begin
  153.   rvOutput.Clear;
  154.   if ListBox1.ItemIndex>=0 then
  155.   begin
  156.     rvOutput.LoadRVF(ExtractFilePath(Application.ExeName)+'template.rvf');
  157.     FillFields(rvOutput.RVData);
  158.     rvOutput.Format;
  159.   end;
  160. end;
  161. end.