fr_rich.pas

FreeReport 2.34 consists of the report engine, designer and previewer, with capabilities comparable

var
  b: Byte;
  n, o: Integer;
  re: TRichEdit;
begin
  inherited SaveToStream(Stream);
  re := RichEdit;
  if StreamMode = smPrinting then
    re := SRichEdit;
  b := 0;
  if re.Lines.Count <> 0 then b := 1;
  Stream.Write(b, 1);
  n := Stream.Position;
  Stream.Write(n, 4);
  if b <> 0 then re.Lines.SaveToStream(Stream);
  o := Stream.Position;
  Stream.Seek(n, soFromBeginning);
  Stream.Write(o, 4);
  Stream.Seek(0, soFromEnd);
end;

procedure TfrRichView.GetBlob(b: TfrTField);
var
  s: TMemoryStream;
begin
  s := TMemoryStream.Create;
{$IFDEF IBO}
  TfrTBlobField(b).AssignTo(s);
{$ELSE}
  TfrTBlobField(b).SaveToStream(s);
{$ENDIF}
  s.Position := 0;
  RichEdit.Lines.LoadFromStream(s);
  s.Free;
end;


{------------------------------------------------------------------------}
procedure TfrRichForm.ShowEditor(t: TfrView);
begin
  AssignRich(RichEdit1, (t as TfrRichView).RichEdit);
  if ShowModal = mrOk then AssignRich((t as TfrRichView).RichEdit, RichEdit1);
  RichEdit1.Lines.Clear;
end;

procedure TfrRichForm.SelectionChange(Sender: TObject);
begin
  with RichEdit1.Paragraph do
  try
    FUpdating := True;
    FirstInd.Left := Trunc(FirstIndent * RulerAdj) - 4 + GutterWid;
    LeftInd.Left := Trunc((LeftIndent + FirstIndent) * RulerAdj) - 4 + GutterWid;
    RightInd.Left := Ruler.ClientWidth - 6 - Trunc((RightIndent + GutterWid) * RulerAdj);
    BoldButton.Down := fsBold in RichEdit1.SelAttributes.Style;
    ItalicButton.Down := fsItalic in RichEdit1.SelAttributes.Style;
    UnderlineButton.Down := fsUnderline in RichEdit1.SelAttributes.Style;
    BulletsButton.Down := Boolean(Numbering);
    E1.Text := IntToStr(RichEdit1.SelAttributes.Size);
    FontName.ItemIndex := FontName.Items.IndexOf(RichEdit1.SelAttributes.Name);
    case Ord(Alignment) of
      0: LeftAlign.Down := True;
      1: RightAlign.Down := True;
      2: CenterAlign.Down := True;
    end;
  finally
    FUpdating := False;
  end;
end;

function TfrRichForm.CurrText: TTextAttributes;
begin
  if RichEdit1.SelLength > 0 then
    Result := RichEdit1.SelAttributes else
    Result := RichEdit1.DefAttributes;
end;

procedure TfrRichForm.GetFontNames;
begin
  FontName.Items := Screen.Fonts;
  FontName.Sorted := True;
end;

procedure TfrRichForm.SetupRuler;
var
  I: Integer;
  S: String;
begin
  SetLength(S, 201);
  I := 1;
  while I < 200 do
  begin
    S[I] := #9;
    S[I+1] := '|';
    Inc(I, 2);
  end;
  Ruler.Caption := S;
end;

procedure TfrRichForm.SetEditRect;
var
  R: TRect;
begin
  with RichEdit1 do
  begin
    R := Rect(GutterWid, 0, ClientWidth - GutterWid, ClientHeight);
    SendMessage(Handle, EM_SETRECT, 0, Longint(@R));
  end;
end;

{ Event Handlers }

procedure TfrRichForm.FormResize(Sender: TObject);
begin
  SetEditRect;
  SelectionChange(Sender);
end;

procedure TfrRichForm.FormPaint(Sender: TObject);
begin
  SetEditRect;
end;

procedure TfrRichForm.FileOpen(Sender: TObject);
begin
  OpenDialog.Filter := LoadStr(SRTFFile) + ' (*.rtf)|*.rtf';
  if OpenDialog.Execute then
  begin
    RichEdit1.Lines.LoadFromFile(OpenDialog.FileName);
    RichEdit1.SetFocus;
    SelectionChange(Self);
  end;
end;

procedure TfrRichForm.FileSaveAs(Sender: TObject);
begin
  SaveDialog.Filter := LoadStr(SRTFFile) + ' (*.rtf)|*.rtf|' +
                       LoadStr(STextFile) + ' (*.txt)|*.txt';
  if SaveDialog.Execute then
    RichEdit1.Lines.SaveToFile(SaveDialog.FileName);
end;

procedure TfrRichForm.EditUndo(Sender: TObject);
begin
  with RichEdit1 do
    if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
end;

procedure TfrRichForm.SelectFont(Sender: TObject);
begin
  FontDialog1.Font.Assign(RichEdit1.SelAttributes);
  if FontDialog1.Execute then
    CurrText.Assign(FontDialog1.Font);
  RichEdit1.SetFocus;
end;

procedure TfrRichForm.RulerResize(Sender: TObject);
begin
  RulerLine.Width := Ruler.ClientWidth - RulerLine.Left * 2;
end;

procedure TfrRichForm.BoldButtonClick(Sender: TObject);
var
  s: TFontStyles;
begin
  if FUpdating then Exit;
  s := [];
  if BoldButton.Down then s := s + [fsBold];
  if ItalicButton.Down then s := s + [fsItalic];
  if UnderlineButton.Down then s := s + [fsUnderline];
  CurrText.Style := s;
end;

procedure TfrRichForm.AlignButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  case TControl(Sender).Tag of
    312: RichEdit1.Paragraph.Alignment := taLeftJustify;
    313: RichEdit1.Paragraph.Alignment := taCenter;
    314: RichEdit1.Paragraph.Alignment := taRightJustify;
  end;
end;

procedure TfrRichForm.FontNameChange(Sender: TObject);
begin
  if FUpdating then Exit;
  CurrText.Name := FontName.Items[FontName.ItemIndex];
end;

procedure TfrRichForm.BulletsButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  RichEdit1.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
end;

{ Ruler Indent Dragging }

procedure TfrRichForm.RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragOfs := (TLabel(Sender).Width div 2);
  TLabel(Sender).Left := TLabel(Sender).Left + X - FDragOfs;
  FDragging := True;
end;

procedure TfrRichForm.RulerItemMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if FDragging then
    TLabel(Sender).Left :=  TLabel(Sender).Left + X - FDragOfs
end;

procedure TfrRichForm.FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  RichEdit1.Paragraph.FirstIndent :=
    Trunc((FirstInd.Left + FDragOfs - GutterWid) / RulerAdj);
  LeftIndMouseUp(Sender, Button, Shift, X, Y);
end;

procedure TfrRichForm.LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  RichEdit1.Paragraph.LeftIndent :=
    Trunc((LeftInd.Left + FDragOfs - GutterWid) / RulerAdj) - RichEdit1.Paragraph.FirstIndent;
  SelectionChange(Sender);
end;

procedure TfrRichForm.RightIndMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  RichEdit1.Paragraph.RightIndent :=
    Trunc((Ruler.ClientWidth - RightInd.Left + FDragOfs - 2) / RulerAdj) - 2 * GutterWid;
  SelectionChange(Sender);
end;

procedure TfrRichForm.CancBtnClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TfrRichForm.OkBtnClick(Sender: TObject);
begin
  ModalResult := mrOk;
end;

procedure TfrRichForm.SpeedButton2Click(Sender: TObject);
begin
  frVarForm := TfrVarForm.Create(nil);
  with frVarForm do
  if ShowModal = mrOk then
    if SelectedItem <> '' then
    begin
      ClipBoard.Clear;
      ClipBoard.AsText := '[' + SelectedItem + ']';
      RichEdit1.PasteFromClipboard;
    end;
  frVarForm.Free;
end;

procedure TfrRichForm.SB1Click(Sender: TObject);
var
  i: Integer;
begin
  i := StrToInt(E1.Text);
  Inc(i);
  E1.Text := IntToStr(i);
  CurrText.Size := i;
end;

procedure TfrRichForm.SB2Click(Sender: TObject);
var
  i: Integer;
begin
  i := StrToInt(E1.Text);
  Dec(i);
  if i <= 0 then i := 1;
  E1.Text := IntToStr(i);
  CurrText.Size := i;
end;

procedure TfrRichForm.FormActivate(Sender: TObject);
begin
  RichEdit1.SetFocus;
end;

procedure TfrRichForm.FormCreate(Sender: TObject);
begin
  OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  SaveDialog.InitialDir := OpenDialog.InitialDir;
  GetFontNames;
  SetupRuler;
  SelectionChange(Self);

  Caption := LoadStr(frRes + 560);
  OpenButton.Hint := LoadStr(frRes + 561);
  SaveButton.Hint := LoadStr(frRes + 562);
  UndoButton.Hint := LoadStr(frRes + 563);
  BoldButton.Hint := LoadStr(frRes + 564);
  ItalicButton.Hint := LoadStr(frRes + 565);
  LeftAlign.Hint := LoadStr(frRes + 566);
  CenterAlign.Hint := LoadStr(frRes + 567);
  RightAlign.Hint := LoadStr(frRes + 568);
  UnderlineButton.Hint := LoadStr(frRes + 569);
  BulletsButton.Hint := LoadStr(frRes + 570);
  SpeedButton1.Hint := LoadStr(frRes + 571);
  HelpBtn.Hint := LoadStr(frRes + 032);
  CancBtn.Hint := LoadStr(frRes + 572);
  OkBtn.Hint := LoadStr(frRes + 573);
  SpeedButton2.Caption := LoadStr(frRes + 574);
  SpeedButton2.Hint := LoadStr(frRes + 575);
  FontName.Hint := LoadStr(frRes + 576);
  E1.Hint := LoadStr(frRes + 577);
  BoldButton.Glyph.Handle := LoadBitmap(hInstance, 'FR_BOLD');
  ItalicButton.Glyph.Handle := LoadBitmap(hInstance, 'FR_ITALIC');
  UnderlineButton.Glyph.Handle := LoadBitmap(hInstance, 'FR_UNDRLINE');
end;

type
  THackBtn = class(TfrSpeedButton)
  end;

procedure TfrRichForm.HelpBtnClick(Sender: TObject);
begin
  Screen.Cursor := crHelp;
  SetCapture(Handle);
  THackBtn(HelpBtn).FMouseInControl := False;
  HelpBtn.Invalidate;
end;

procedure TfrRichForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  c: TControl;
begin
  HelpBtn.Down := False;
  Screen.Cursor := crDefault;
  c := frControlAtPos(Self, Point(X, Y));
  if (c <> nil) and (c <> HelpBtn) then
    Application.HelpCommand(HELP_CONTEXTPOPUP, c.Tag);
end;


procedure TfrRichView.SaveToFR3Stream(Stream: TStream);
var
  ds: TfrTDataSet;
  fld: TfrTField;

  procedure WriteStr(const s: String);
  begin
    Stream.Write(s[1], Length(s));
  end;

  procedure WriteRich;
  var
    wr: TWriter;
    ms, temp: TMemoryStream;
    v: TValueType;
    Count: Integer;
  begin
    ms := TMemoryStream.Create;
    wr := TWriter.Create(ms, 4096);
    temp := TMemoryStream.Create;
    RichEdit.Lines.SaveToStream(temp);

    wr.WriteStr('RichEdit');
    v := vaBinary;
    wr.Write(v, SizeOf(v));
    Count := temp.Size;
    wr.Write(Count, SizeOf(Count));
    wr.Write(temp.Memory^, Count);

    wr.Free;
    WriteStr(' Propdata="' + frStreamToString(ms) + '"');
    ms.Free;
    temp.Free;
  end;

begin
  inherited;

  WriteRich;
  if (Flags and flStretched) <> 0 then
    WriteStr(' StretchMode="smMaxHeight"');
//  if (Flags and flTextOnly) <> 0 then
//    WriteStr(' AllowExpressions="False"');

  if Memo.Count <> 0 then
  begin
    frGetDataSetAndField(Memo[0], ds, fld);
    if (ds <> nil) and (fld <> nil) then
      WriteStr(' DataSet="' + ds.Owner.Name + '.' + ds.Name +
        '" DataField="' + StrToXML(fld.FieldName) + '"');
  end;
end;

initialization
  frRichForm := TfrRichForm.Create(nil);
  SRichEdit := TRichEdit.Create(nil);
  with SRichEdit do
  begin
    Parent := frRichForm;
    Visible := False;
    WordWrap := False;
    Width := 1024;
  end;
  frRegisterObject(TfrRichView, frRichForm.Image1.Picture.Bitmap,
    LoadStr(SInsRichObject), frRichForm);

finalization
  SRichEdit.Free;
  frRichForm.Free;
  frRichForm := nil;


end.