cxhyperlinkedit.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 611 行 · 第 1/2 页

begin
  Result := FPrefix <> cxGetResourceString(@scxSHyperLinkPrefix);
end;

procedure TcxCustomHyperLinkEditProperties.ReadPrefix(Reader: TReader);
begin
  Prefix := Reader.ReadString;
end;

procedure TcxCustomHyperLinkEditProperties.SetAutoComplete(Value: Boolean);
begin
  if Value then
    UsePrefix := upAlways
  else
    UsePrefix := upNever;
end;

procedure TcxCustomHyperLinkEditProperties.SetLinkColor(
  const Value: TColor);
begin
  if FLinkColor <> Value then
  begin
    FLinkColor := Value;
    Changed;
  end;
end;

procedure TcxCustomHyperLinkEditProperties.SetSingleClick(Value: Boolean);
begin
  if Value <> FSingleClick then
  begin
    FSingleClick := Value;
    Changed;
  end;
end;

procedure TcxCustomHyperLinkEditProperties.WritePrefix(Writer: TWriter);
begin
  Writer.WriteString(Prefix);
end;

procedure TcxCustomHyperLinkEditProperties.Assign(Source: TPersistent);
begin
  if Source is TcxCustomHyperLinkEditProperties then
  begin
    BeginUpdate;
    try
      inherited Assign(Source);
      with TcxCustomHyperLinkEditProperties(Source) do
      begin
        Self.LinkColor := LinkColor;
        Self.Prefix := Prefix;
        Self.SingleClick := SingleClick;
        Self.StartKey := StartKey;
        Self.UsePrefix := UsePrefix;
        Self.OnStartClick := OnStartClick;
      end;
    finally
      EndUpdate
    end
  end
  else
    inherited Assign(Source);
end;

class function TcxCustomHyperLinkEditProperties.GetContainerClass: TcxContainerClass;
begin
  Result := TcxHyperLinkEdit;
end;

class function TcxCustomHyperLinkEditProperties.GetStyleClass: TcxCustomEditStyleClass;
begin
  Result := TcxHyperLinkStyle;
end;

function TcxCustomHyperLinkEditProperties.GetSupportedOperations: TcxEditSupportedOperations;
begin
  Result := inherited GetSupportedOperations;
  if SingleClick then
   Include(Result, esoAlwaysHotTrack);
end;

class function TcxCustomHyperLinkEditProperties.GetViewInfoClass: TcxContainerViewInfoClass;
begin
  Result := TcxHyperLinkEditViewInfo;
end;

procedure TcxCustomHyperLinkEditProperties.ValidateDisplayValue(
  var ADisplayValue: TcxEditValue; var AErrorText: TCaption; var Error: Boolean;
    AEdit: TcxCustomEdit);
begin
  if UsePrefix = upAlways then
    ADisplayValue := AddPrefixTo(VarToStr(ADisplayValue));
  inherited ValidateDisplayValue(ADisplayValue, AErrorText, Error, AEdit);
end;

procedure TcxCustomHyperLinkEditProperties.DefineProperties(AFiler: TFiler);
begin
  inherited DefineProperties(AFiler);
  AFiler.DefineProperty('Prefix', ReadPrefix, WritePrefix, GetPrefixStored);
end;

function TcxCustomHyperLinkEditProperties.AddPrefixTo(AStr: string): string;
begin
  Result := Trim(AStr);
  if (Prefix <> '') and (Result <> '') and (Pos(Prefix, Result) <> 1) then
    Result := Trim(Prefix + Result);
end;

{ TcxHyperLinkStyle }

function TcxHyperLinkStyle.GetTextColor: TColor;
begin
  if DirectAccessMode then
    Result := inherited GetTextColor
  else
  begin
    if (Container = nil) or (TcxCustomHyperLinkEdit(Container).ActiveProperties = nil) then
      Result := cxHyperLinkEditDefaultLinkColor
    else
      Result := TcxCustomHyperLinkEdit(Container).ActiveProperties.LinkColor;
  end;
end;

function TcxHyperLinkStyle.GetTextStyle: TFontStyles;
begin
  Result := inherited GetTextStyle + [fsUnderline];
end;

{ TcxCustomHyperLinkEdit }

function TcxCustomHyperLinkEdit.DoOnStartClick: Boolean;
begin
  Result := Assigned(Properties.OnStartClick) or
    Assigned(ActiveProperties.OnStartClick);
  with Properties do
    if Assigned(OnStartClick) then
      OnStartClick(Self);
  if RepositoryItem <> nil then
    with ActiveProperties do
      if Assigned(OnStartClick) then
        OnStartClick(Self);
end;

procedure TcxCustomHyperLinkEdit.DoStart;
var
  AText: string;
begin
  if not DoOnStartClick then
  begin
    AText := Trim(DisplayValue);
    if ActiveProperties.UsePrefix <> upNever then
      AText := ActiveProperties.AddPrefixTo(AText);
    if AText <> '' then
      ShellExecute(0, 'OPEN', PChar(AText),
        nil, nil, SW_SHOWMAXIMIZED);
  end;
end;

function TcxCustomHyperLinkEdit.GetActiveProperties: TcxCustomHyperLinkEditProperties;
begin
  Result := TcxCustomHyperLinkEditProperties(InternalGetActiveProperties);
end;

function TcxCustomHyperLinkEdit.GetProperties: TcxCustomHyperLinkEditProperties;
begin
  Result := TcxCustomHyperLinkEditProperties(FProperties);
end;

function TcxCustomHyperLinkEdit.GetStyle: TcxHyperLinkStyle;
begin
  Result := TcxHyperLinkStyle(FStyles.Style);
end;

procedure TcxCustomHyperLinkEdit.InternalSetCursor(ACursor: TCursor);
begin
  InnerTextEdit.Control.Cursor := ACursor;
  Cursor := ACursor;
  SetCursor(Screen.Cursors[ACursor]);
end;

procedure TcxCustomHyperLinkEdit.SetProperties(
  const Value: TcxCustomHyperLinkEditProperties);
begin
  FProperties.Assign(Value);
end;

procedure TcxCustomHyperLinkEdit.SetStyle(Value: TcxHyperLinkStyle);
begin
  FStyles.Style := Value;
end;

procedure TcxCustomHyperLinkEdit.KeyDown(var Key: Word;
  Shift: TShiftState);
begin
  if (ShortCut(Key, Shift) <> 0) and (ActiveProperties.StartKey = ShortCut(Key, Shift)) then
  begin
    DoStart;
    Key := 0;
  end
  else
    inherited KeyDown(Key, Shift);
end;

procedure TcxCustomHyperLinkEdit.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and PtInRect(ViewInfo.ClientRect, Point(X, Y)) and
    (not ActiveProperties.SingleClick and (ssDouble in Shift)) then
      DoStart;
end;

procedure TcxCustomHyperLinkEdit.MouseEnter(AControl: TControl);
begin
  inherited MouseEnter(AControl);
  if ActiveProperties.SingleClick and (Cursor = crDefault) then
  begin
    FSaveCursor := Cursor;
    InternalSetCursor(crcxHandPoint);
  end;
end;

procedure TcxCustomHyperLinkEdit.MouseLeave(AControl: TControl);
begin
  inherited MouseLeave(AControl);
  if ActiveProperties.SingleClick then
    InternalSetCursor(FSaveCursor);
end;

procedure TcxCustomHyperLinkEdit.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if (Button = mbLeft) and PtInRect(ViewInfo.ClientRect, Point(X, Y)) and
    ActiveProperties.SingleClick and (SelLength = 0) then
      DoStart;
end;

procedure TcxCustomHyperLinkEdit.PropertiesChanged(Sender: TObject);
begin
  inherited PropertiesChanged(Sender);
  ContainerStyleChanged(Style);
end;

class function TcxCustomHyperLinkEdit.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxCustomHyperLinkEditProperties;
end;

procedure TcxCustomHyperLinkEdit.ActivateByMouse(Shift: TShiftState; X, Y: Integer;
  var AEditData: TcxCustomEditData);
begin
  if IsInplace and ActiveProperties.SingleClick and (Cursor = crDefault) then
  begin
    FSaveCursor := Cursor;
    InternalSetCursor(crcxHandPoint);
  end;
  inherited;
end;

procedure TcxCustomHyperLinkEdit.SelectAll;
begin
  if not (IsInplace and ActiveProperties.SingleClick) then
    inherited SelectAll;
end;

{ TcxHyperLinkEdit }

class function TcxHyperLinkEdit.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxHyperLinkEditProperties;
end;

function TcxHyperLinkEdit.GetActiveProperties: TcxHyperLinkEditProperties;
begin
  Result := TcxHyperLinkEditProperties(InternalGetActiveProperties);
end;

function TcxHyperLinkEdit.GetProperties: TcxHyperLinkEditProperties;
begin
  Result := TcxHyperLinkEditProperties(FProperties);
end;

procedure TcxHyperLinkEdit.SetProperties(Value: TcxHyperLinkEditProperties);
begin
  FProperties.Assign(Value);
end;

{ TcxFilterHyperLinkEditHelper }

class function TcxFilterHyperLinkEditHelper.GetFilterEditClass: TcxCustomEditClass;
begin
  Result := TcxHyperLinkEdit;
end;

initialization
  GetRegisteredEditProperties.Register(TcxHyperLinkEditProperties, scxSEditRepositoryHyperLinkItem);
  FilterEditsController.Register(TcxHyperLinkEditProperties, TcxFilterHyperLinkEditHelper);

finalization
  FilterEditsController.Unregister(TcxHyperLinkEditProperties, TcxFilterHyperLinkEditHelper);
  
end.