unit Unit1;
{Sample Application for DWEdit Component}
{$mode objfpc}{$H+}
interface
uses
Windows, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
Clipbrd, ComCtrls, ExtCtrls,
DWEdit, QColors, QPapers, QRTFParser, QLanguages, QRTFImage,
QRTFSaver, QStatusBar, QThemeColors, QTheme, DWSharedTypes, QScrollBar;
type
{ TForm1 }
TForm1 = class(TForm)
Button1, Button2: TButton;
Button3: TButton;
Button4: TButton;
ColorButton1: TColorButton;
Label1: TLabel;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure ColorButton1ColorChanged(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure DWEditSelStartChanged(Sender: TObject);
procedure DWEditZoomChanged(Sender: TObject);
procedure DWEditSelPageChanged(Sender: TObject);
procedure DWEditPageCountChanged(Sender: TObject);
private
DWEdit1:TDWEdit;// disable if installed
QStatusBar1: TQStatusBar;// disable if installed
Procedure InitStatusBar;
procedure UpdateCaption;
procedure SetupInitialText;
procedure ApplyCharacterFormatting;
procedure ApplySpecialFormatting;
procedure EmbedSampleImage;
procedure ApplyParagraphFormatting;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
Procedure TForm1.InitStatusBar;
Begin
QStatusBar1 := TQStatusBar.Create(Self);
QStatusBar1.Parent := Self;
QStatusBar1.Align := alBottom;
QStatusBar1.SimplePanel := false;
with QStatusBar1.Panels.Add do
begin
Style:=psNormal;
Width := 70; Alignment := taLeftJustify;
Text := 'Panel[0]';
end;
with QStatusBar1.Panels.Add do
begin
Style:=psSuccess;
Width := 70; Alignment := taCenter;
Text := 'Panel[1]';
end;
with QStatusBar1.Panels.Add do
begin
Style:=psWarning;
Width := 70; Alignment := taRightJustify;
Text := 'Panel[2]';
end;
with QStatusBar1.Panels.Add do
begin
Style:=psError;
Width := 70; Alignment := taLeftJustify;
Text := 'Panel[3]';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DWEdit1:=TDWEdit.Create(Self);
with DWEdit1 do
begin
Parent := Self;
Align:=alClient;
Font.Name := 'Segoe UI';
Font.Size := 12;
WordWrap:=wwCharacter;
OnSelStartChange := @DWEditSelStartChanged;
OnZoomChange := @DWEditZoomChanged;
OnSelPageChange := @DWEditSelPageChanged;
OnPageCountChange := @DWEditPageCountChanged;
GridVisible := False;
GridSize := Point(20, 20);
GridColor := QColors.clLightBlue;
GridStyle := gsLines;//gsDots;
GridOpacity := 0.2;
Theme := CurrentTheme;
end;
InitStatusBar;
ApplyTheme(CurrentTheme, GetThemeColor(tcAccentDefault));
end;
procedure TForm1.Button1Click(Sender: TObject);
var //SAVE to RTF
FS: TFileStream;
begin
FS := TFileStream.Create('sample.rtf', fmCreate);
try
DWEdit1.SaveToRTFStream(FS);
finally
FS.Free;
end;
DWEdit1.SetFocus;
end;
procedure TForm1.Button2Click(Sender: TObject);
var //LOAD from RTF
FS: TFileStream;
begin
if FileExists('sample.rtf') then
begin
FS := TFileStream.Create('sample.rtf', fmOpenRead);
try
DWEdit1.LoadFromRTFStream(FS);
finally
FS.Free;
end;
end;
DWEdit1.SetFocus;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
If DWEdit1.ViewLayout=vmPaperLayout then
Begin
With DWEdit1 do
Begin
ViewLayout:=vmWebLayout; WordWrap:=wwNoWrap;
end;
Button3.Caption:='Web Layout';
end else
If DWEdit1.ViewLayout=vmWebLayout then
Begin
With DWEdit1 do
Begin
ViewLayout:=vmPaperLayout; WordWrap:=wwCharacter;
end;
Button3.Caption:='Paper layout';
end;
DWEdit1.SetFocus;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
NewAccentColor: TColor;
begin
if CurrentTheme = tmDark then
begin
Button4.Caption := 'Light Mode';
CurrentTheme := tmLight;
end else
begin
Button4.Caption := 'Dark Mode';
CurrentTheme := tmDark;
end;
NewAccentColor := ColorButton1.ButtonColor;
ApplyTheme(CurrentTheme, NewAccentColor);
if Assigned(DWEdit1) then DWEdit1.Theme := CurrentTheme;
DWEdit1.SetFocus;
end;
procedure TForm1.ColorButton1ColorChanged(Sender: TObject);
var
NewAccentColor: TColor;
begin
NewAccentColor := ColorButton1.ButtonColor;
ApplyTheme(CurrentTheme, NewAccentColor);
if Assigned(DWEdit1) then DWEdit1.Theme := CurrentTheme;
Label1.Font.Color:=NewAccentColor;
DWEdit1.SetFocus;
end;
procedure TForm1.SetupInitialText;
var
AllText: TStringList;
begin
AllText := TStringList.Create;
try
AllText.Add('Welcome to DWEdit! 🚀 Here are some features:');
AllText.Add('Ligatures & Stylistic Alternates (in Gabriola font).');
AllText.Add('Mix colors, sizes, and styles like bold & italic.');
AllText.Add('Highlighting with background colors is easy.');
AllText.Add('Custom underlines for emphasis or spellcheck.');
AllText.Add('Formulas: H2O and E=mc2 (Superscript/Subscript).');
AllText.Add('Spacing can be adjusted per character.');
AllText.Add('You can even embed images "flowing" within text!');
AllText.Add('Paragraph''s alignment: Left, Right, Center & Justified.');
AllText.Add('Adjustable space between lines: (next three lines:)');
AllText.Add('🙂😊😃😄😆😍😘😗😉👨🏻👩🏽👧🏾👦🏿 (different skin tones)');
AllText.Add('Full copy/paste & undo/redo system....');
AllText.Add('"Old Persian": 𐎠𐎡𐎢𐎣𐎤𐎥𐎦𐎧𐎨𐎩𐎪𐎫𐎬𐎭 (A "Left-to-Right" script language)');
AllText.Add('The next line is "New Persian", which is a Right-to-Left language:');
AllText.Add('این یک جمله نمونه به زبان فارسی است.');
AllText.Add(LineEnding+LineEnding+LineEnding+LineEnding+LineEnding);
AllText.TrailingLineBreak := False;
DWEdit1.Lines.Text := AllText.Text;
finally
AllText.Free;
end;
end;
procedure TForm1.ApplyCharacterFormatting;
var
attrs: TStyleAttributes;
begin
DWEdit1.SelStart := 11; DWEdit1.SelLength := 7;
DWEdit1.SetSelectionFontStyle([fsBold, fsItalic], smAdd);
attrs := Default(TStyleAttributes);
attrs.AttributesSet := [saFontColor]; attrs.FontColor := clBlue;
DWEdit1.SelStart := 105; DWEdit1.SelLength := 6; DWEdit1.SetSelectionAttributes(attrs);
attrs.AttributesSet := [saFontSize]; attrs.FontSize := 25;
DWEdit1.SelStart := 113; DWEdit1.SelLength := 5; DWEdit1.SetSelectionAttributes(attrs);
attrs.AttributesSet := [saFontStyle]; attrs.FontStyle := [fsBold];
DWEdit1.SelStart := 136; DWEdit1.SelLength := 4; DWEdit1.SetSelectionAttributes(attrs);
attrs.FontStyle := [fsItalic];
DWEdit1.SelStart := 143; DWEdit1.SelLength := 6; DWEdit1.SetSelectionAttributes(attrs);
// Background Color (Highlighting)
DWEdit1.SelStart := 152; DWEdit1.SelLength := 12;
attrs := Default(TStyleAttributes);
attrs.AttributesSet := [saBackgroundColor, saFontColor];
attrs.BackgroundColor := GetThemeColor(tcAccentDefault);
attrs.FontColor := GetThemeColor(tcTextOnAccentPrimary);
DWEdit1.SetSelectionAttributes(attrs);
end;
procedure TForm1.ApplySpecialFormatting;
var
underline: TDecoration;
begin
// OpenType Features
DWEdit1.SelStart := 47; DWEdit1.SelLength := 52;
DWEdit1.SetSelectionFont('Gabriola');
DWEdit1.SetSelectionFeatures([ffStandardLigatures, ffStylisticSet1]);
// Custom Underline
DWEdit1.SelStart := 205; DWEdit1.SelLength := 10;
underline.Enabled := True;
underline.Style := dsDoubleWave;
underline.Color := QColors.clRed;
DWEdit1.SetSelectionUnderline(underline);
// Subscript and Superscript
DWEdit1.SetBaselineScriptForRange(256, 1, bsSubscript); // '2' in H2O
DWEdit1.SetBaselineScriptForRange(267, 1, bsSuperscript); // '2' in E=mc2
// Character Spacing
DWEdit1.SetCharacterSpacingForRange(295, 7, 5.0); // 'Spacing'
end;
procedure TForm1.EmbedSampleImage;
var
bmp: TBitmap; pic: TPicture;
begin
DWEdit1.SelStart := 354; DWEdit1.SelLength := 0;
bmp := TBitmap.Create;
pic := TPicture.Create;
try
// --- Insert Bitmap ---
bmp.SetSize(50, 30);
bmp.Canvas.Brush.Color := QColors.clRed_Pantone;
bmp.Canvas.FillRect(Rect(0, 0, 50, 30));
bmp.Canvas.Brush.Color := QColors.clWhite;
bmp.Canvas.Font.Size := 14;
bmp.Canvas.TextOut(4, 2, 'Ed78');
DWEdit1.InsertImage(bmp);
// --- Insert any pictures from file ---
DWEdit1.SelStart := 787; DWEdit1.SelLength := 1;
DWEdit1.Alignment := paCenter;
pic.LoadFromFile('Image.png');
DWEdit1.InsertImage(pic, 0.65);// scale to 65%
finally
bmp.Free;
pic.Free;
end;
end;
procedure TForm1.ApplyParagraphFormatting;
begin
DWEdit1.SelStart := 0; DWEdit1.SelLength := 100;
DWEdit1.Alignment := paLeft;
DWEdit1.SelStart := 160; DWEdit1.SelLength := 100;
DWEdit1.Alignment := paCenter;
DWEdit1.SelStart := 300; DWEdit1.SelLength := 50;
DWEdit1.Alignment := paRight;
DWEdit1.SelStart := 400; DWEdit1.SelLength := 1;
DWEdit1.Alignment := paJustified;
//lsSingle, lsOneHalf, lsDouble, lsMultiple, lsAtLeast, lsExactly
//DWEdit1.SetLineSpacing(444, 180, lsAtLeast, 15.0);
DWEdit1.SetLineSpacing(444, 180, lsDouble);
// Set BiDIMode for the R2L Persian language
DWEdit1.SelStart := 750; DWEdit1.SelLength := 1;
DWEdit1.SetSelectionBiDiMode(bdmRightToLeft);
DWEdit1.Alignment := paRight;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
DWEdit1.BeginUpdate; // Disable Undo System
try
SetupInitialText;
ApplyCharacterFormatting;
ApplySpecialFormatting;
EmbedSampleImage;
ApplyParagraphFormatting;
DWEdit1.SelStart := 0; DWEdit1.SelLength := 0;
DWEdit1.SetFocus;
finally
DWEdit1.EndUpdate; // Re-enable Undo System
end;
// This will erase any actions created during LFM loading.
DWEdit1.ClearUndoHistory;
end;
procedure TForm1.UpdateCaption;
var
Line, Col: Integer;
P: TPoint;
CurrentPage, TotalPage: Integer;
begin
if not Assigned(DWEdit1) then Exit;
// Get all the info
DWEdit1.GetSelPage(CurrentPage);
DWEdit1.GetPageCount(TotalPage);
DWEdit1.GetCaretLocation(Line, Col);
DWEdit1.GetCaretPos(P);
// Format the caption
Self.Caption := Format(
'SelStart: %d (Line: %d, Col: %d) or in Pixels[X: %d, Y: %d] — Zoom: %d%% — Page: %d of %d',
[DWEdit1.SelStart, Line + 1, Col + 1, P.X, P.Y, Round(DWEdit1.ZoomFactor * 100), CurrentPage, TotalPage]
);
end;
procedure TForm1.DWEditSelStartChanged(Sender: TObject);
begin
UpdateCaption;
end;
procedure TForm1.DWEditZoomChanged(Sender: TObject);
begin
UpdateCaption;
end;
procedure TForm1.DWEditSelPageChanged(Sender: TObject);
begin
UpdateCaption;
end;
procedure TForm1.DWEditPageCountChanged(Sender: TObject);
begin
UpdateCaption;
end;
end.
Recent
