tntstdctrls.pas

TNT Components Source

begin
  Result := TntCustomEdit_GetSelText(Self);
end;

procedure TTntCustomEdit.SetSelText(const Value: WideString);
begin
  TntCustomEdit_SetSelText(Self, Value);
end;

function TTntCustomEdit.GetPasswordChar: WideChar;
begin
  Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar);
end;

procedure TTntCustomEdit.SetPasswordChar(const Value: WideChar);
begin
  TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
end;

function TTntCustomEdit.GetText: WideString;
begin
  Result := TntControl_GetText(Self);
end;

procedure TTntCustomEdit.SetText(const Value: WideString);
begin
  TntControl_SetText(Self, Value);
end;

function TTntCustomEdit.IsHintStored: Boolean;
begin
  Result := TntControl_IsHintStored(Self);
end;

function TTntCustomEdit.GetHint: WideString;
begin
  Result := TntControl_GetHint(Self)
end;

procedure TTntCustomEdit.SetHint(const Value: WideString);
begin
  TntControl_SetHint(Self, Value);
end;

procedure TTntCustomEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
  inherited;
end;

function TTntCustomEdit.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;

{ TTntMemoStrings }

constructor TTntMemoStrings.Create;
begin
  inherited;
  FLineBreakStyle := tlbsCRLF;
end;

function TTntMemoStrings.GetCount: Integer;
begin
  Result := FMemoLines.Count;
end;

function TntMemo_LineStart(Handle: THandle; Index: Integer): Integer;
begin
  Assert(Win32PlatformIsUnicode);
  Result := SendMessageW(Handle, EM_LINEINDEX, Index, 0);
end;

function TntMemo_LineLength(Handle: THandle; Index: Integer; StartPos: Integer = -1): Integer;
begin
  Assert(Win32PlatformIsUnicode);
  if StartPos = -1 then
    StartPos := TntMemo_LineStart(Handle, Index);
  if StartPos < 0 then
    Result := 0
  else
    Result := SendMessageW(Handle, EM_LINELENGTH, StartPos, 0);
end;

function TTntMemoStrings.Get(Index: Integer): WideString;
var
  Len: Integer;
begin
  if (not IsWindowUnicode(FMemo.Handle)) then
    Result := FMemoLines[Index]
  else begin
    SetLength(Result, TntMemo_LineLength(FMemo.Handle, Index));
    if Length(Result) > 0 then begin
      if Length(Result) > High(Word) then
        raise EOutOfResources.Create(SOutlineLongLine);
      Word((PWideChar(Result))^) := Length(Result);
      Len := SendMessageW(FMemo.Handle, EM_GETLINE, Index, Longint(PWideChar(Result)));
      SetLength(Result, Len);
    end;
  end;
end;

procedure TTntMemoStrings.Put(Index: Integer; const S: WideString);
var
  StartPos: Integer;
begin
  if (not IsWindowUnicode(FMemo.Handle)) then
    FMemoLines[Index] := S
  else begin
    StartPos := TntMemo_LineStart(FMemo.Handle, Index);
    if StartPos >= 0 then
    begin
      SendMessageW(FMemo.Handle, EM_SETSEL, StartPos, StartPos + TntMemo_LineLength(FMemo.Handle, Index));
      SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(S)));
    end;
  end;
end;

procedure TTntMemoStrings.Insert(Index: Integer; const S: Widestring);

  function RichEditSelStartW: Integer;
  var
    CharRange: TCharRange;
  begin
    SendMessageW(FMemo.Handle, EM_EXGETSEL, 0, Longint(@CharRange));
    Result := CharRange.cpMin;
  end;

var
  StartPos, LineLen: Integer;
  Line: WideString;
begin
  if (not IsWindowUnicode(FMemo.Handle)) then
    FMemoLines.Insert(Index, S)
  else begin
    if Index >= 0 then
    begin
      StartPos := TntMemo_LineStart(FMemo.Handle, Index);
      if StartPos >= 0 then
        Line := S + CRLF
      else begin
        StartPos := TntMemo_LineStart(FMemo.Handle, Index - 1);
        LineLen := TntMemo_LineLength(FMemo.Handle, Index - 1);
        if LineLen = 0 then
          Exit;
        Inc(StartPos, LineLen);
        Line := CRLF + s;
      end;
      SendMessageW(FMemo.Handle, EM_SETSEL, StartPos, StartPos);

      if (FRichEditMode)
      and (FLineBreakStyle <> tlbsCRLF) then begin
        Line := TntAdjustLineBreaks(Line, FLineBreakStyle);
        if Line = CR then
          Line := CRLF; { This helps a ReadOnly RichEdit 4.1 control to insert a blank line. }
        SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));
        if Line = CRLF then
          Line := CR;
      end else
        SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));

      if (FRichEditMode)
      and (RichEditSelStartW <> (StartPos + Length(Line))) then
        raise EOutOfResources.Create(sRichEditInsertError);
    end;
  end;
end;

procedure TTntMemoStrings.Delete(Index: Integer);
begin
  FMemoLines.Delete(Index);
end;

procedure TTntMemoStrings.Clear;
begin
  FMemoLines.Clear;
end;

type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});

procedure TTntMemoStrings.SetUpdateState(Updating: Boolean);
begin
  TAccessStrings(FMemoLines).SetUpdateState(Updating);
end;

function TTntMemoStrings.GetTextStr: WideString;
begin
  if (not FRichEditMode) then
    Result := TntControl_GetText(FMemo)
  else
    Result := inherited GetTextStr;
end;

procedure TTntMemoStrings.SetTextStr(const Value: WideString);
var
  NewText: WideString;
begin
  NewText := TntAdjustLineBreaks(Value, FLineBreakStyle);
  if NewText <> GetTextStr then begin
    FMemo.HandleNeeded;
    TntControl_SetText(FMemo, NewText);
  end;
end;

{ TTntCustomMemo }

constructor TTntCustomMemo.Create(AOwner: TComponent);
begin
  inherited;
  FLines := TTntMemoStrings.Create;
  TTntMemoStrings(FLines).FMemo := Self;
  TTntMemoStrings(FLines).FMemoLines := TCustomMemo{TNT-ALLOW TCustomMemo}(Self).Lines;
end;

destructor TTntCustomMemo.Destroy;
begin
  FreeAndNil(FLines);
  inherited;
end;

procedure TTntCustomMemo.SetLines(const Value: TTntStrings);
begin
  FLines.Assign(Value);
end;

procedure TTntCustomMemo.CreateWindowHandle(const Params: TCreateParams);
begin
  TntCustomEdit_CreateWindowHandle(Self, Params);
end;

procedure TTntCustomMemo.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;

function TTntCustomMemo.GetSelStart: Integer;
begin
  Result := TntCustomEdit_GetSelStart(Self);
end;

procedure TTntCustomMemo.SetSelStart(const Value: Integer);
begin
  TntCustomEdit_SetSelStart(Self, Value);
end;

function TTntCustomMemo.GetSelLength: Integer;
begin
  Result := TntCustomEdit_GetSelLength(Self);
end;

procedure TTntCustomMemo.SetSelLength(const Value: Integer);
begin
  TntCustomEdit_SetSelLength(Self, Value);
end;

function TTntCustomMemo.GetSelText: WideString;
begin
  Result := TntCustomEdit_GetSelText(Self);
end;

procedure TTntCustomMemo.SetSelText(const Value: WideString);
begin
  TntCustomEdit_SetSelText(Self, Value);
end;

function TTntCustomMemo.GetText: WideString;
begin
  Result := TntControl_GetText(Self);
end;

procedure TTntCustomMemo.SetText(const Value: WideString);
begin
  TntControl_SetText(Self, Value);
end;

function TTntCustomMemo.IsHintStored: Boolean;
begin
  Result := TntControl_IsHintStored(Self);
end;

function TTntCustomMemo.GetHint: WideString;
begin
  Result := TntControl_GetHint(Self)
end;

procedure TTntCustomMemo.SetHint(const Value: WideString);
begin
  TntControl_SetHint(Self, Value);
end;

procedure TTntCustomMemo.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
  inherited;
end;

function TTntCustomMemo.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;

{$IFDEF DELPHI_7} // fix for Delphi 7 only
function TD7PatchedComboBoxStrings.Get(Index: Integer): string{TNT-ALLOW string};
var
  Len: Integer;
begin
  Len := SendMessage(ComboBox.Handle, CB_GETLBTEXTLEN, Index, 0);
  if Len > 0 then
  begin
    SetLength(Result, Len);
    SendMessage(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(PChar{TNT-ALLOW PChar}(Result)));
  end
  else
    SetLength(Result, 0);
end;

function TD7PatchedComboBoxStrings.Add(const S: string{TNT-ALLOW string}): Integer;
begin
  Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar{TNT-ALLOW PChar}(S)));
  if Result < 0 then
    raise EOutOfResources.Create(SInsertLineError);
end;

procedure TD7PatchedComboBoxStrings.Insert(Index: Integer; const S: string{TNT-ALLOW string});
begin
  if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index,
    Longint(PChar{TNT-ALLOW PChar}(S))) < 0 then
    raise EOutOfResources.Create(SInsertLineError);
end;
{$ENDIF}

{ TTntComboBoxStrings }

function TTntComboBoxStrings.GetCount: Integer;
begin
  Result := ComboBox.Items.Count;
end;

function TTntComboBoxStrings.Get(Index: Integer): WideString;
var
  Len: Integer;
begin
  if (not IsWindowUnicode(ComboBox.Handle)) then
    Result := ComboBox.Items[Index]
  else begin
    Len := SendMessageW(ComboBox.Handle, CB_GETLBTEXTLEN, Index, 0);
    if Len = CB_ERR then
      Result := ''
    else begin
      SetLength(Result, Len + 1);
      Len := SendMessageW(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(PWideChar(Result)));
      if Len = CB_ERR then
        Result := ''
       else
        Result := PWideChar(Result);
    end;
  end;
end;

function TTntComboBoxStrings.GetObject(Index: Integer): TObject;
begin
  Result := ComboBox.Items.Objects[Index];
end;

procedure TTntComboBoxStrings.PutObject(Index: Integer; AObject: TObject);
begin
  ComboBox.Items.Objects[Index] := AObject;
end;

function TTntComboBoxStrings.Add(const S: WideString): Integer;
begin
  if (not IsWindowUnicode(ComboBox.Handle)) then
    Result := ComboBox.Items.Add(S)
  else begin
    Result := SendMessageW(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PWideChar(S)));
    if Result < 0 then
      raise EOutOfResources.Create(SInsertLineError);
  end;
end;

procedure TTntComboBoxStrings.Insert(Index: Integer; const S: WideString);
begin
  if (not IsWindowUnicode(ComboBox.Handle)) then