prndbgeh.pas

来自「EHlib CN For Delphi2009」· PAS 代码 · 共 1,912 行 · 第 1/5 页

  RichEdit.OnSelectionChange := nil;
  try
    inherited AddStrings(Strings);
  finally
    RichEdit.OnSelectionChange := SelChange;
  end;
end;

function TRichEditStrings.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;

function TRichEditStrings.Get(Index: Integer): string;
var
//  Text: array[0..4095] of Char;
  Text: String;
  L: Integer;
begin
//  Word((@Text)^) := SizeOf(Text);
//  L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text));

  { TODO -cCheck : Chech that next line is not required?}
//  if (Text[L - 2] = #13) and (Text[L - 1] = #10) then Dec(L, 2);

//  SetString(Result, Text, L);

  L := SendGetTextMessage(RichEdit.Handle, EM_GETLINE, Index, Text, 4095);
  if (L >= 1) and (Result[L] = #13) then
    SetLength(Result, L - 1);
end;

procedure TRichEditStrings.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)));
      SendStructMessage(RichEdit.Handle, EM_EXSETSEL, 0, Selection);
      SendTextMessage(RichEdit.Handle, EM_REPLACESEL, 0, S);
    end;
  end;
end;

procedure TRichEditStrings.Insert(Index: Integer; const S: string);
var
  L: Integer;
  Selection: TCharRange;
{$IFDEF CIL}
  Fmt: string;
{$ELSE}
  Fmt: PChar;
{$ENDIF}
  Str: string;
begin
  if Index >= 0 then
  begin
    Selection.cpMin := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
    if Selection.cpMin >= 0 then
{$IFDEF CIL}
      Fmt := '%s'#13
{$ELSE}
      Fmt := '%s'#13#10
{$ENDIF}
    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);
{$IFDEF CIL}
      Fmt := #13'%s';
{$ELSE}
      Fmt := #13#10'%s';
{$ENDIF}
    end;
    Selection.cpMax := Selection.cpMin;
//    SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
    SendStructMessage(RichEdit.Handle, EM_EXSETSEL, 0, Selection);
    Str := Format(Fmt, [S]);
//  SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, LongInt(PChar(Str)));
    SendTextMessage(RichEdit.Handle, EM_REPLACESEL, 0, Str);
    if RichEdit.SelStart <> (Selection.cpMax + Length(Str)) then
      raise EOutOfResources.Create(sRichEditInsertError);
  end;
end;

procedure TRichEditStrings.Delete(Index: Integer);
const
{$IFDEF CIL}
  REStrEmpty = '';
{$ELSE}
  REStrEmpty: PChar = '';
{$ENDIF}
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));
    SendStructMessage(RichEdit.Handle, EM_EXSETSEL, 0, Selection);
    SendTextMessage(RichEdit.Handle, EM_REPLACESEL, 0, REStrEmpty);
  end;
end;

procedure TRichEditStrings.Clear;
begin
  RichEdit.Clear;
end;

procedure TRichEditStrings.SetUpdateState(Updating: Boolean);
begin
  if RichEdit.Showing then
    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 TRichEditStrings.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 TRichEditStrings.SetTextStr(const Value: string);
begin
  EnableChange(False);
  try
    inherited SetTextStr(Value);
  finally
    EnableChange(True);
  end;
end;

{$IFDEF CIL}

//StreamSave StreamLoad TRichEditStrings.SaveToStream TRichEditStrings.SaveToStream
//AdjustLineBreaks

function AdjustLineBreaks(Dest: IntPtr; Source: TBytes; Start, Len: Integer): Integer;
var
  I, J: Integer;
begin
  I := Start; // Position in Source
  J := 0; // Position in Dest
  while I < (Len - 1) do
  begin
    if (Source[I] = 10) and (Source[I + 1] = 0) then
    begin
      // Convert #10 to #13#10
      Marshal.WriteByte(Dest, J, 13);
      Marshal.WriteByte(Dest, J + 1, 0);
      Inc(J, 2);
      Marshal.WriteByte(Dest, J, 10);
      Marshal.WriteByte(Dest, J + 1, 0);
    end
    else
    begin
      Marshal.WriteByte(Dest, J, Source[I]);
      Marshal.WriteByte(Dest, J + 1, Source[I + 1]);
      if (Source[I] = 13) and (Source[I + 1] = 0) then
      begin
        // Convert #13 to #13#10
        Inc(J, 2);
        Marshal.WriteByte(Dest, J, 10);
        Marshal.WriteByte(Dest, J + 1, 0);
        // Skip #10 if preceeded by #13
        if (Source[I + 2] = 10) and (Source[I + 3] = 0) then
          Inc(I, 2);
      end;
    end;
    Inc(I, 2);
    Inc(J, 2);
  end;
  Result := J;
end;

function StreamSave(dwCookie: Longint; pbBuff: IntPtr;
  cb: Longint; var pcb: Longint): Longint;
var
  StreamInfo: TRichEditStreamInfo;
  Buffer: TBytes;
  Handle: GCHandle;
begin
  Result := NoError;
  Handle := GCHandle(IntPtr(dwCookie));
  StreamInfo := TRichEditStreamInfo(Handle.Target);
  try
    pcb := 0;
    if StreamInfo.Converter <> nil then
    begin
      SetLength(Buffer, cb);
      Marshal.Copy(pbBuff, Buffer, 0, cb);
      // Convert from Unicode to Encoding if PlainText is set
      if StreamInfo.PlainText then
      begin
        if StreamInfo.Encoding = nil then
          Buffer := Encoding.Convert(Encoding.Unicode, Encoding.Default, Buffer)
        else
        begin
          if not Encoding.Unicode.Equals(StreamInfo.Encoding) then
            Buffer := Encoding.Convert(Encoding.Unicode, StreamInfo.Encoding, Buffer);
        end;
      end;
      pcb := StreamInfo.Converter.ConvertWriteStream(StreamInfo.Stream, Buffer, Length(Buffer));
      // Length(Buffer) may be different from 'cb' if we converted the char set
      if (pcb <> cb) and (pcb = Length(Buffer)) then
        pcb := cb; // Fake the number of bytes written
    end;
  except
    Result := WriteError;
  end;
end;

function StreamLoad(dwCookie: Longint; pbBuff: IntPtr;
  cb: Longint; var pcb: Longint): Longint;
var
  Buffer, Preamble: TBytes;
  StreamInfo: TRichEditStreamInfo;
  Handle: GCHandle;
  StartIndex: Integer;
begin
  Result := NoError;
  Handle := GCHandle(IntPtr(dwCookie));
  StreamInfo := TRichEditStreamInfo(Handle.Target);
  SetLength(Buffer, cb + 1);
  cb := cb div 2;
  StartIndex := 0;
  pcb := 0;
  try
    if StreamInfo.Converter <> nil then
      pcb := StreamInfo.Converter.ConvertReadStream(StreamInfo.Stream, Buffer, cb);
    if pcb > 0 then
    begin
      Buffer[pcb] := 0;
      if Buffer[pcb - 1] = 13 then
        Buffer[pcb - 1] := 0;

      // Convert from desired Encoding to Unicode
      if StreamInfo.PlainText then
      begin
        if StreamInfo.Encoding = nil then
        begin
          Buffer := Encoding.Convert(Encoding.Default, Encoding.Unicode, Buffer, 0, pcb);
          pcb := Length(Buffer);
        end
        else
        begin
          if not Encoding.Unicode.Equals(StreamInfo.Encoding) then
          begin
            Buffer := Encoding.Convert(StreamInfo.Encoding, Encoding.Unicode, Buffer, 0, pcb);
            pcb := Length(Buffer);
          end;
          // If Unicode preamble is present, set StartIndex to skip over it
          Preamble := Encoding.Unicode.GetPreamble;
          if (pcb >= 2) and (Buffer[0] = Preamble[0]) and (Buffer[1] = Preamble[1]) then
            StartIndex := 2;
        end;
      end;
      pcb := AdjustLineBreaks(pbBuff, Buffer, StartIndex, pcb);
    end;
  except
    Result := ReadError;
  end;
end;

procedure TRichEditStrings.LoadFromStream(Stream: TStream; Encoding: System.Text.Encoding);
var
  EditStream: TEditStream;
  Position: Longint;
  TextType: Longint;
  StreamInfo: TRichEditStreamInfo;
  Converter: TConversion;
  Handle: GCHandle;
begin
  StreamInfo.Stream := Stream;
  if FConverter <> nil then
    Converter := FConverter
  else
    Converter := RichEdit.DefaultConverter.Create;
  StreamInfo.Converter := Converter;
  StreamInfo.PlainText := PlainText;
  StreamInfo.Encoding := Encoding;
  try
    Handle := GCHandle.Alloc(TObject(StreamInfo));
    try
      with EditStream do
      begin
        dwCookie := Longint(IntPtr(Handle));
        pfnCallBack := StreamLoad;
        dwError := 0;
      end;
      Position := Stream.Position;
      if PlainText then
        TextType := SF_TEXT or SF_UNICODE
      else
        TextType := SF_RTF;
      SendGetStructMessage(RichEdit.Handle, EM_STREAMIN, TextType, EditStream, True);
      if (TextType = SF_RTF) and (EditStream.dwError <> 0) then
      begin
        Stream.Position := Position;
        if PlainText then
          TextType := SF_RTF
        else
          TextType := SF_TEXT or SF_UNICODE;
        StreamInfo.PlainText := not PlainText;
        SendGetStructMessage(RichEdit.Handle, EM_STREAMIN, TextType, EditStream, True);
        if EditStream.dwError <> 0 then
          raise EOutOfResources.Create(sRichEditLoadFail);
      end;
    finally
      Handle.Free;
    end;
  finally
    if FConverter = nil then Converter.Free;
  end;
end;

procedure TRichEditStrings.SaveToStream(Stream: TStream; Encoding: System.Text.Encoding);
var
  EditStream: TEditStream;
  TextType: Longint;
  StreamInfo: TRichEditStreamInfo;
  Converter: TConversion;
  Handle: GCHandle;
  Preamble: TBytes;
begin
  if FConverter <> nil then
    Converter := FConverter
  else
    Converter := RichEdit.DefaultConverter.Create;
  StreamInfo.Stream := Stream;
  StreamInfo.Converter := Converter;
  StreamInfo.PlainText := PlainText;
  StreamInfo.Encoding := Encoding;
  try
    Handle := GCHandle.Alloc(TObject(StreamInfo));
    try
      with EditStream do
      begin
        dwCookie := LongInt(IntPtr(Handle));
        pfnCallBack := StreamSave;
        dwError := 0;
      end;
      if PlainText then
      begin
        TextType := SF_TEXT or SF_UNICODE;
        if Encoding <> nil then
        begin
          Preamble := Encoding.GetPreamble;
          if Length(Preamble) > 0 then
            Stream.WriteBuffer(Preamble, Length(Preamble));
        end;
      end