delphi dev LayoutControl 实现邮件的附件加载

2021-05-14 14:27

阅读:436

标签:message   free   esc   pen   ons   options   div   cut   extra   

var
  cxlayoutitemtag: Integer;
  labeltag: Integer;
  listPutFileName: TStringList;

procedure TFormTestPutFiles.cxbtn_putfilesClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    createCxLabel(ExtractFileName(OpenDialog1.FileName));
  end
  else
  begin
    exit;
  end;
end;

procedure TFormTestPutFiles.cxlayoutitemDeleteClick(Sender: TObject);
var
  i: Integer;
  dxlayoutitemtemp: TdxLayoutItem;
  cxlabel_PFzhvalue: string;
begin
  ShowMessage(listPutFileName.Text);
  dxlayoutitemtemp := (Sender as TdxLayoutItem);
  cxlabel_PFzhvalue := (dxlayoutitemtemp.Control as TcxLabel).PFzhvalue;
  dxlayoutitemtemp.Visible := False;
  for i := 0 to listPutFileName.Count - 1 do
  begin
    if pos(cxlabel_PFzhvalue, listPutFileName.Strings[i]) > 0 then
    begin
      listPutFileName.Delete(i);
    end;
  end;
end;

procedure TFormTestPutFiles.cxlbl1Click(Sender: TObject);
begin
//
end;

procedure TFormTestPutFiles.dxlytgrpdxlytcntrl1Group1CaptionClick(Sender: TObject);
begin
  ShowMessage(删除成功!!!!!);
end;

procedure TFormTestPutFiles.dxlytmdxlytcntrl1Item2CaptionClick(Sender: TObject);
begin
  ShowMessage(删除!);
end;

procedure TFormTestPutFiles.FormCreate(Sender: TObject);
begin
  cxlayoutitemtag := 0;
  labeltag := 0;
  listPutFileName := TStringList.Create;
  listPutFileName.StrictDelimiter := True;
end;

procedure TFormTestPutFiles.FormDestroy(Sender: TObject);
begin
  if Assigned(listPutFileName) then
  begin
    listPutFileName.Free;
  end;
end;

procedure TFormTestPutFiles.labelClick(Sender: TObject);
begin
//
  ShowMessage((Sender as TcxLabel).Caption);
end;

procedure TFormTestPutFiles.createCxLabel(filename: string);
var
  cxlayoutitem: TdxLayoutItem;
  tmplabel: TcxLabel;
  i: Integer;
begin
  if Pos(filename, listPutFileName.Text) > 0 then
  begin
    ShowMessage(上传的文件不能重复!);
    Exit;
  end;

  cxlayoutitem := TdxLayoutItem.Create(dxlytgrpdxlytcntrl1Group2);
  cxlayoutitem.Parent := dxlytgrpdxlytcntrl1Group2;
  tmplabel := TcxLabel.Create(cxlayoutitem);
  tmplabel.Caption := ExtractFileName(OpenDialog1.FileName);
  tmplabel.PFzhvalue := OpenDialog1.FileName;
  listPutFileName.Add(OpenDialog1.FileName);
  tmplabel.Style.Font.Style := [fsUnderline];
  tmplabel.Style.Font.Color := clBlue;
  tmplabel.Style.Font.Size := 14;
  tmplabel.Tag := labeltag + 1;
  cxlayoutitem.Control := tmplabel;
  cxlayoutitem.CaptionOptions.ImageIndex := 1;
  cxlayoutitem.CaptionOptions.Layout := clRight;
  cxlayoutitem.CaptionOptions.AlignVert := tavCenter;
  cxlayoutitem.AlignHorz := ahLeft;
  cxlayoutitem.Tag := cxlayoutitemtag + 1;
  Inc(cxlayoutitemtag);
  Inc(labeltag);
  //cxlayoutitem.ControlOptions.ShowBorder := True;
  dxlytgrpdxlytcntrl1Group2.ShowBorder := False;
  dxlytgrpdxlytcntrl1Group2.Visible := True;
  tmplabel.OnClick := labelclick;
  cxlayoutitem.OnCaptionClick := cxlayoutitemDeleteClick;
end;

 

delphi dev LayoutControl 实现邮件的附件加载

标签:message   free   esc   pen   ons   options   div   cut   extra   

原文地址:http://www.cnblogs.com/yangxuming/p/7522104.html


评论


亲,登录后才可以留言!