ariched.pas

来自「delphi编程控件」· PAS 代码 · 共 2,114 行 · 第 1/5 页

  SetAttributes(Paragraph);
end;

function TAutoParaAttributes.GetNumbering: TNumberingStyle;
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := TNumberingStyle(Paragraph.wNumbering);
end;

procedure TAutoParaAttributes.SetNumbering(Value: TNumberingStyle);
var
  Paragraph: TParaFormat2;
begin
  case Value of
    nsBullet: if LeftIndent < 10 then LeftIndent := 10;
    nsNone: LeftIndent := 0;
  end;
  InitParagraph(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_NUMBERING;
    wNumbering := Ord(Value);
  end;
  SetAttributes(Paragraph);
end;

function TAutoParaAttributes.GetRightIndent: Longint;
begin
  Result := RightIndentInTwips div 20;
end;

function TAutoParaAttributes.GetRightIndentInTwips: Longint;
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.dxRightIndent;
end;

procedure TAutoParaAttributes.SetRightIndent(Value: Longint);
begin
  RightIndentInTwips := Value * 20;
end;

procedure TAutoParaAttributes.SetRightIndentInTwips(Value: Longint);
var
  Paragraph: TParaFormat2;
begin
  InitParagraph(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_RIGHTINDENT;
    dxRightIndent := Value;
  end;
  SetAttributes(Paragraph);
end;

function TAutoParaAttributes.GetSpaceAfter: Longint;
begin
  Result := SpaceAfterInTwips div 20;
end;

function TAutoParaAttributes.GetSpaceAfterInTwips: Longint;
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.dySpaceAfter;
end;

procedure TAutoParaAttributes.SetSpaceAfter(Value: Longint);
begin
  SpaceAfterInTwips := Value * 20;
end;

procedure TAutoParaAttributes.SetSpaceAfterInTwips(Value: Longint);
var
  Paragraph: TParaFormat2;
begin
  InitParagraph(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_SPACEAFTER;
    dySpaceAfter := Value;
  end;
  SetAttributes(Paragraph);
end;

function TAutoParaAttributes.GetSpaceBefore: Longint;
begin
  Result := SpaceBeforeInTwips div 20;
end;

function TAutoParaAttributes.GetSpaceBeforeInTwips: Longint;
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.dySpaceBefore;
end;

procedure TAutoParaAttributes.SetSpaceBefore(Value: Longint);
begin
  SpaceBeforeInTwips := Value * 20;
end;

procedure TAutoParaAttributes.SetSpaceBeforeInTwips(Value: Longint);
var
  Paragraph: TParaFormat2;
begin
  InitParagraph(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_SPACEBEFORE;
    dySpaceBefore := Value;
  end;
  SetAttributes(Paragraph);
end;

function TAutoParaAttributes.GetTab(Index: Byte): Longint;
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.rgxTabs[Index] div 20;
end;

procedure TAutoParaAttributes.SetTab(Index: Byte; Value: Longint);
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  with Paragraph do
  begin
    rgxTabs[Index] := Value * 20;
    dwMask := PFM_TABSTOPS;
    if cTabCount < Index then cTabCount := Index;
    SetAttributes(Paragraph);
  end;
end;

function TAutoParaAttributes.GetTabCount: Integer;
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.cTabCount;
end;

procedure TAutoParaAttributes.SetTabCount(Value: Integer);
var
  Paragraph: TParaFormat2;
begin
  GetAttributes(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_TABSTOPS;
    cTabCount := Value;
    SetAttributes(Paragraph);
  end;
end;

procedure TAutoParaAttributes.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TAutoParaAttributes then
  begin
    Alignment := TAutoParaAttributes(Source).Alignment;
    FirstIndent := TAutoParaAttributes(Source).FirstIndent;
    LeftIndent := TAutoParaAttributes(Source).LeftIndent;
    RightIndent := TAutoParaAttributes(Source).RightIndent;
    Numbering := TAutoParaAttributes(Source).Numbering;
    for I := 0 to MAX_TAB_STOPS - 1 do
      Tab[I] := TAutoParaAttributes(Source).Tab[I];
  end
  else inherited Assign(Source);
end;

{ TAutoRichEditStrings }

type
  PStream = ^TStream;

  TAutoRichEditStrings = class(TStrings)
  private
    RichEdit: TCustomAutoRichEdit;
    procedure EnableChange(const Value: Boolean);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure SetUpdateState(Updating: Boolean); override;
    procedure SetTextStr(const Value: string); override;
  public
    procedure AddStrings(Strings: TStrings); override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
  end;

procedure TAutoRichEditStrings.EnableChange(const Value: Boolean);
var
  EventMask: Longint;
begin
  with RichEdit do
  begin
    if Value then
      EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) or ENM_CHANGE
    else
      EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) and not ENM_CHANGE;
    SendMessage(Handle, EM_SETEVENTMASK, 0, EventMask);
  end;
end;

procedure TAutoRichEditStrings.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('Data', LoadFromStream, SaveToStream, True);
end;

function TAutoRichEditStrings.Get(Index: Integer): string;
var
  Text: array[0..4095] of Char;
  L: Integer;
begin
  Word((@Text)^) := SizeOf(Text);
  L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text));
  if Text[L - 1] = #13 then Dec(L);
  SetString(Result, Text, L);
end;

function TAutoRichEditStrings.GetCount: Integer;
begin
  Result := SendMessage(RichEdit.Handle, EM_GETLINECOUNT, 0, 0);
  if SendMessage(RichEdit.Handle, EM_LINELENGTH, SendMessage(RichEdit.Handle,
    EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
end;

procedure TAutoRichEditStrings.Put(Index: Integer; const S: string);
var
  Selection: TCharRange;
begin
  if Index >= 0 then
  begin
    Selection.cpMin := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
    if Selection.cpMin <> -1 then
    begin
      Selection.cpMax := Selection.cpMin +
        SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.cpMin, 0);
      SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
      SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
    end;
  end;
end;

procedure TAutoRichEditStrings.SetUpdateState(Updating: Boolean);
begin
  SendMessage(RichEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  if not Updating then
  begin
    RichEdit.Refresh;
    RichEdit.Perform(CM_TEXTCHANGED, 0, 0);
  end;
end;

procedure TAutoRichEditStrings.SetTextStr(const Value: string);
begin
  EnableChange(False);
  try
    inherited SetTextStr(Value);
  finally
    EnableChange(True);
  end;
end;

procedure TAutoRichEditStrings.AddStrings(Strings: TStrings);
var
  SelChange: TNotifyEvent;
begin
  SelChange := RichEdit.OnSelectionChange;
  RichEdit.OnSelectionChange := nil;
  try
    inherited AddStrings(Strings);
  finally
    RichEdit.OnSelectionChange := SelChange;
  end;
end;

procedure TAutoRichEditStrings.Clear;
begin
  RichEdit.Clear;
end;

procedure TAutoRichEditStrings.Delete(Index: Integer);
const
  Empty: PChar = '';
var
  Selection: TCharRange;
begin
  if Index < 0 then Exit;
  Selection.cpMin := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
  if Selection.cpMin <> -1 then
  begin
    Selection.cpMax := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index + 1, 0);
    if Selection.cpMax = -1 then
      Selection.cpMax := Selection.cpMin +
        SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.cpMin, 0);
    SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
    SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(Empty));
  end;
end;

procedure TAutoRichEditStrings.Insert(Index: Integer; const S: string);
var
  L: Integer;
  Selection: TCharRange;
  Fmt: PChar;
  Str: string;
begin
  if Index >= 0 then
  begin
    Selection.cpMin := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
    if Selection.cpMin >= 0 then
      if Count = 0 then Fmt := '%s'
      else Fmt := '%s'#13
    else
    begin
      Selection.cpMin :=
        SendMessage(RichEdit.Handle, EM_LINEINDEX, Index - 1, 0);
      if Selection.cpMin < 0 then Exit;
      L := SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.cpMin, 0);
      if L = 0 then Exit;
      Inc(Selection.cpMin, L);
      Fmt := #13'%s';
    end;
    Selection.cpMax := Selection.cpMin;
    SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
    Str := Format(Fmt, [S]);
    SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(Str)));
{    if RichEdit.SelStart <> (Selection.cpMax + Length(Str)) then
      raise EOutOfResources.Create(sRichEditInsertError);}
  end;
end;

function StreamLoad(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): Longint; stdcall;
begin
  Result := 0;
  try
    pcb := PStream(Pointer(dwCookie))^.Read(pbBuff^, cb);
  except
    Result := 1;
  end;
end;

procedure TAutoRichEditStrings.LoadFromStream(Stream: TStream);
const
  TextModes: array[Boolean] of Longint = (SF_RTF, SF_TEXT);
var
  EditStream: TEditStream;
  CharsRead: Integer;
begin
  with EditStream do
  begin
    dwCookie := Longint(@Stream);
    pfnCallBack := @StreamLoad;
  end;
  Screen.Cursor := crHourglass;
  CharsRead := SendMessage(RichEdit.Handle, EM_STREAMIN,
    TextModes[RichEdit.PlainText], Longint(@EditStream));
  Screen.Cursor := crDefault;
  if (EditStream.dwError <> 0) and (CharsRead < RichEdit.MaxLength) then
    ShowMessage(sRichEditLoadFail);
end;

function StreamSave(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): Longint; stdcall;
begin
  Result := 0;
  try
    pcb := PStream(Pointer(dwCookie))^.Write(pbBuff^, cb);
  except
    Result := 1;
  end;
end;

procedure TAutoRichEditStrings.SaveToStream(Stream: TStream);
const
  TextModes: array[Boolean] of Longint = (SF_RTF, SF_TEXT);
var
  EditStream: TEditStream;
  CharsWrite: Integer;
begin
  with EditStream do
  begin
    dwCookie := Longint(@Stream);
    pfnCallBack := @StreamSave;
  end;
  Screen.Cursor := crHourglass;
  CharsWrite := SendMessage(RichEdit.Handle, EM_STREAMOUT,
    TextModes[RichEdit.PlainText], Longint(@EditStream));
  Screen.Cursor := crDefault;
  if (EditStream.dwError <> 0) and (CharsWrite < RichEdit.MaxLength) then
    ShowMessage(sRichEditSaveFail);
end;

{ TCustomAutoRichEdit }

constructor TCustomAutoRichEdit.Create(AOwner: TComponent);
var
  DC: HDC;
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csCaptureMouse];
  ParentColor := False;
  Width := 185;
  Height := 89;