紧急求助，小弟献不了身，只好...

[openui]

跪求了，可有高人

[openui]

我滴神，自己顶，召唤救世主！

[iamduo]

[Quote=引用 10 楼 openui 的回复:]
谢谢大家的解答，有没更好的办法
就是我粘贴的时候同时以这种超链接形式加入数据库
[/Quote]
看了一下它的Event，没有。
你只能设置Font。
然后在用到的时候，补充完整。
不就是<a href='XXXX'>XXXX</a>嘛。
数据库多加一个字段，把实际的URL保存进去。

[贝隆]

帮你顶

[亮剑_]

超链接写个事件处理函数，打开地址不就OK了？

还有问题标题最好直接一些，不一定非要搞“标题党”

[openui]

[Quote=引用 11 楼 iamduo 的回复:]
引用 10 楼 openui 的回复:
谢谢大家的解答，有没更好的办法
就是我粘贴的时候同时以这种超链接形式加入数据库

看了一下它的Event，没有。
你只能设置Font。
然后在用到的时候，补充完整。
不就是 <a href='XXXX'>XXXX </a>嘛。
数据库多加一个字段，把实际的URL保存进去。
[/Quote]
先前我也是这样想的，发现要这个软件偏要这种形式，太郁闷了
我用的是DEV系列控件

[liuyashao]

最好还是从那个dxDBEdit控件，派生出一个控件去专门处理这种情况，在显示时不要显示<a href='XXXX'>这些内容。

[IVC2009]

帮顶

[pengxuan]

Dev Express套件里有cxHyperLinkEdit1实现超链接

[winstonbonaparte]

用个EDIT显示好了，字体改下，显示成超链接的就行。再处理一下单击事件啊

[openui]

哎...泪奔.....

[fenshm]

oo

[liuyashao]

我在delphi2010，和修改Dev Express v4.7组件内的TcxDBTextEdit控件，实现了楼主要的功能
实现方法是从TcxDBTextEdit派生出TMyDBHyperLinkTextEdit，源码看下方

unit MyDBHyperLinkEdit;

interface
uses Variants, Windows, SysUtils, Messages, Controls, Forms, Classes, Dialogs,
     Graphics, DB, cxDBEdit, cxEdit, cxDataUtils;

type
  TMyDBHyperLinkEditDataBinding = class(TcxDBTextEditDataBinding)
  private
    FHyperLinkText,
    FHyperLink,
    FText: string;
    FRecNo: integer;
    FColor: TColor;
    FCursor: TCursor;
    FTextStyle: TFontStyles;
    FOnDblClick: TNotifyEvent;
    function IsvalidHyperLink(const aHyperLink: string): boolean;
    function ParseHyperLink(const aHyperLink: string; var HyperLink, Text: string): boolean;
    procedure OnDblClick(Sender: TObject);
  protected
    procedure SetDisplayValue(const Value: TcxEditValue); override;
    procedure DataChanged; override;
    procedure UpdateData; override;
  public
    constructor Create(AEdit: TcxCustomEdit); override;
    property HyperLink: string read FHyperLink;
    property HyperLinkAndText: string read FHyperLinkText;
  end;

  TMyDBHyperLinkTextEdit = class(TcxDBTextEdit)
  private
  protected
    class function GetDataBindingClass: TcxEditDataBindingClass; override;
  public
  end;

implementation

uses ShellAPI;

type
  TcxCustomEditAccess = class(TcxCustomEdit);

{ TMyDBHyperLinkEditDataBinding }

constructor TMyDBHyperLinkEditDataBinding.Create(AEdit: TcxCustomEdit);
begin
  inherited;
  FColor := AEdit.Style.TextColor;
  FTextStyle := AEdit.Style.TextStyle;
  FCursor := AEdit.Cursor;
  FOnDblClick := AEdit.OnDblClick;
  AEdit.OnDblClick := OnDblClick;
end;

procedure TMyDBHyperLinkEditDataBinding.DataChanged;
begin
  if IsRefreshDisabled then
    Exit;
  if Edit.IsDesigning and not IsDataAvailable then
    UpdateNotConnectedDBEditDisplayValue
  else
  begin
    if not TcxCustomEditAccess(Edit).Focused and
      Edit.ActiveProperties.IsValueEditorWithValueFormatting then
    begin
      if not IsDataAvailable or IsNull then
        TcxCustomEditAccess(Edit).FEditValue := Null
      else
        TcxCustomEditAccess(Edit).FEditValue := Field.Value;
      Edit.LockClick(True);
      try
        SetInternalDisplayValue(StoredValue);
      finally
        Edit.LockClick(False);
      end;
    end
    else begin
      FHyperLink := '';
      if StoredValue=null then
        FText := ''
      else
        FText := StoredValue;
      if not (StoredValue=null) and IsvalidHyperLink(StoredValue) then
        ParseHyperLink(Field.Value, FHyperLink, FText);
      if FHyperLink='' then
        Edit.EditValue := Format('<a href="http://">%s</a>', [FText])
      else
        Edit.EditValue := FText;
    end;
  end;

  Edit.Hint := Format('http://%s', [FHyperLink]);
  Edit.Style.TextColor := FColor;
  Edit.Cursor := FCursor;
  Edit.Style.TextStyle := FTextStyle;
  if FHyperLink<>'' then
  begin
    Edit.Style.TextColor := clBlue;
    Edit.Style.TextStyle := FTextStyle + [fsUnderline];
    Edit.Cursor := crHandPoint;
  end;
end;

function TMyDBHyperLinkEditDataBinding.IsvalidHyperLink(const aHyperLink: string): boolean;
var
  tmp: string;
begin
  //'<a href="http://www.163.com">网易主页</a>'
  tmp := LowerCase(aHyperLink);
  result := (Copy(tmp, 1, 16)='<a href="http://') and (Copy(tmp, Length(tmp)-3, 4)='</a>') and (Pos('">', aHyperLink)>0);
end;

procedure TMyDBHyperLinkEditDataBinding.OnDblClick(Sender: TObject);
begin
  if HyperLink<>'' then
    ShellExecute(Application.Handle, 'open', PWideChar('http://'+HyperLink), nil, nil, SW_SHOWNORMAL);
  if Assigned(FOnDblClick) then
    FOnDblClick(Sender);
end;

function TMyDBHyperLinkEditDataBinding.ParseHyperLink(const aHyperLink: string;
  var HyperLink, Text: string): boolean;
var
  tmp: string;
begin
  result := false;
  if IsvalidHyperLink(aHyperLink) then
  begin
    tmp := aHyperLink;
    Delete(tmp, 1, 16);
    Delete(tmp, Pos('</a>', tmp), 4);
    HyperLink := Copy(tmp, 1, Pos('">', tmp)-1);
    text := Copy(tmp, Pos('">', tmp)+2, Length(tmp));
    result := true;
  end;
end;

procedure TMyDBHyperLinkEditDataBinding.SetDisplayValue(
  const Value: TcxEditValue);
begin
  if IsDataAvailable then
  begin
    if not Edit.Focused and self.Editing and (FHyperLink<>'') then
      SetInternalDisplayValue(Format('<a href="http://%s">%s</a>', [FHyperLink, Value]))
    else
      SetInternalDisplayValue(Value)
  end
  else
    if Edit.IsDesigning then
      SetInternalDisplayValue(Edit.Name)
    else
      SetInternalDisplayValue('');
end;

procedure TMyDBHyperLinkEditDataBinding.UpdateData;
begin
  if IsDataAvailable then
  begin
    if Edit.ValidateEdit(True) then
    begin
      StoredValue := Edit.EditValue;
      if not (Edit.EditValue=null) and not IsvalidHyperLink(Edit.EditValue) then
         StoredValue := Format('<a href="http://%s">%s</a>', [FHyperLink, Edit.EditValue]);
    end;
  end;
end;

{ TMyDBHyperLinkEdit }

class function TMyDBHyperLinkTextEdit.GetDataBindingClass: TcxEditDataBindingClass;
begin
  result := TMyDBHyperLinkEditDataBinding;
end;

end.

[liuyashao]

楼主如有疑问，可以联系我，qq：724464297

[openui]

[Quote=引用 20 楼 liuyashao 的回复:]
楼主如有疑问，可以联系我，qq：724464297
[/Quote]
谢谢这位朋友啊，你很热心，中国有你这样的人真是挺好的...我说真的
我先试试，看看

[cxlll]

RZ里面好像有这个东东啊，很方便的

[阿三]

cxHyperLinkEdit1 这个不错

[山东蓝鸟贵薪]

窗体用的什么控件呀，真漂亮呀

[openui]

[Quote=引用 24 楼 sgzhou12345 的回复:]
窗体用的什么控件呀，真漂亮呀
[/Quote]
是Dev Express控件最新版才有的一个风格
软件
[Quote=引用 20 楼 liuyashao 的回复:]
楼主如有疑问，可以联系我，qq：724464297
[/Quote]
真心想找你完善这个软件，如何？？？我薪水不多（都是中国老百姓，你也知道的），价钱给小弟大优惠下，但是你放心我是靠得住的人，以后我会找项目给你做的，不收钱的
希望你能联系我下，咱们谈下需求这块，另外软件使用的SQL Server 2000服务器在内网，不要使用路由器端口映射的方法，可以使用吗？

[haochin]

不好意思，没有看明白。。。

[ljq900]

改一下样子就行了
点击事件中打开链接地址
至于复制链接地址到里面还得查查剪切板里的格式