EBarsDemoRating.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:2k
源码类别:

Email服务器

开发平台:

Delphi

  1. unit EBarsDemoRating;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, StdCtrls, Controls, Classes,
  5.   Graphics, Forms, Dialogs, ExtCtrls;
  6. type
  7.   TEBarsDemoRatingForm = class(TForm)
  8.     Label1: TLabel;
  9.     Label2: TLabel;
  10.     Label3: TLabel;
  11.     Label4: TLabel;
  12.     memRateDescrip: TMemo;
  13.     btnSend: TButton;
  14.     rgRate: TRadioGroup;
  15.     procedure rgRateChange(Sender: TObject);
  16.     procedure btnSendClick(Sender: TObject);
  17.   end;
  18. const
  19.   OurEmail = 'Support@devexpress.com';
  20.   EmailSubj = 'EBars6.Demos.';
  21. var
  22.   EBarsDemoRatingForm: TEBarsDemoRatingForm;
  23. implementation
  24. uses
  25.   ShellAPI;
  26. {$R *.dfm}
  27. procedure TEBarsDemoRatingForm.rgRateChange(
  28.   Sender: TObject);
  29. begin
  30.   if rgRate.ItemIndex  <> -1 then
  31.     btnSend.Enabled := True;
  32. end;
  33. procedure TEBarsDemoRatingForm.btnSendClick(Sender: TObject);
  34. var
  35.   ABody, ASubj: string;
  36.   procedure AdjustMessageBody(ASearchStr, AReplaceStr: string);
  37.   var
  38.     APos: integer;
  39.   begin
  40.     APos := Pos(ASearchStr,ABody);
  41.     while APos <> 0 do
  42.     begin
  43.       Delete(ABody,APos, Length(ASearchStr));
  44.       Insert(AReplaceStr,ABody, APos);
  45.       APos := Pos(ASearchStr,ABody);
  46.     end;
  47.   end;
  48. begin
  49.   Screen.Cursor := crHourGlass;
  50.   try
  51.     ASubj := EmailSubj + ChangeFileExt(ExtractFileName(Application.ExeName),'')+'-user rating';
  52.     ABody := 'Rate: ' + IntToStr(rgRate.ItemIndex + 1);
  53.     if memRateDescrip.Text <> '' then
  54.       ABody := ABody + #13#10#13#10 +'Description:'#13#10 + memRateDescrip.Text;
  55.     AdjustMessageBody('%', '$prc$');
  56.     AdjustMessageBody('$prc$', '%25');
  57.     AdjustMessageBody(#13#10, '%0D%0A');
  58.     AdjustMessageBody('&', '%26');
  59.     AdjustMessageBody(' ', '%20');
  60.     ShellExecute(Handle, PChar('OPEN'), PChar('mailto:' + OurEmail + '?subject=' +
  61.       ASubj + '&body=' + ABody) , nil, nil, SW_SHOWMAXIMIZED);
  62.   finally
  63.     Screen.Cursor := crDefault;
  64.     Close;
  65.   end;
  66. end;
  67. end.