unit MainForm;
{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, QStatusBar, QThemeColors, QTheme,
DWSharedTypes, QLanguages, QRTFImage, QScrollBar, QRTFSaver;
Const
CM_DELAYED_INIT = WM_USER + 200;// for UpdateCaption at the first run
type
{ TForm1 }
TForm1 = class(TForm)
Button1, Button2: TButton;
Button10: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
ColorButton1: TColorButton;
Label1: TLabel;
Panel1: TPanel;
procedure Button10Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure ColorButton1ColorChanged(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(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
FFirstShow: Boolean;
Procedure InitStatusBar;
procedure UpdateCaption;
procedure CMDelayedInit(var {%H-}Message: TMessage); message CM_DELAYED_INIT;
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;
QStatusBar1.BidiMode:=bdLeftToRight;
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
FFirstShow := True;
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;
//PaperSize:=ppsHalf_Letter;
PaperSize:=ppsLetter;
GridVisible := True;
GridSize := Point(20, 20);
GridColor := clLightBlue;
GridStyle := gsLines;//gsDots;
GridOpacity := 0.4;
ZoomFactor:=0.7;
end;
InitStatusBar;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
if FFirstShow then
begin
FFirstShow := False;
ColorButton1.ButtonColor := $00FF0000;//pure blue
ApplyTheme(CurrentTheme, ColorButton1.ButtonColor);
DWEdit1.SetTheme(CurrentTheme, ColorButton1.ButtonColor);
Label1.Font.Color:=ColorButton1.ButtonColor;
DWEdit1.BeginUpdate;
try
SetupInitialText;
ApplyCharacterFormatting;
ApplySpecialFormatting;
EmbedSampleImage;
ApplyParagraphFormatting;
DWEdit1.SelStart := 0;
DWEdit1.SelLength := 0;
DWEdit1.SetFocus;
finally
DWEdit1.EndUpdate;
end;
DWEdit1.ClearUndoHistory;
// Queue the final layout/caption update for the next CPU cycle.
// This ensures it runs AFTER the form has physically resized to the screen.
PostMessage(Handle, CM_DELAYED_INIT, 0, 0);
end;//FFirstShow
end;
procedure TForm1.Button1Click(Sender: TObject);
var // SAVE to RTF
FS: TFileStream;
FN: String;
begin
FN := ExpandFileName('sample.rtf');
FS := TFileStream.Create(FN, fmCreate);
try
DWEdit1.SaveToRTFStream(FS);
finally
FS.Free;
end;
ShowMessage(FN + LineEnding + 'Has been Saved!');
DWEdit1.SetFocus;
end;
procedure TForm1.Button10Click(Sender: TObject);
var
FS: TFileStream;
FN: String;
OldReductionState: Boolean;
begin
if DWEdit1.ViewLayout = vmWebLayout then
begin
DWEdit1.ViewLayout := vmPaperLayout;
Button3.Caption := 'Web Layout';
UpdateCaption;
//Allow the engine to recalculate metrics before saving
Application.ProcessMessages;
end;
FN := ExpandFileName('sample.pdf');
try
FS := TFileStream.Create(FN, fmCreate);
except
on E: Exception do
begin
ShowMessage('Error creating file. Check if it is open in another app.');
Exit;
end;
end;
OldReductionState := DWEdit1.DWESizeReduction;
try
try
DWEdit1.DWESizeReduction := True;
Screen.Cursor := crHourGlass;
try
DWEdit1.SaveToPDFStream(FS);
finally
Screen.Cursor := crDefault;
end;
ShowMessage('PDF Saved Successfully:' + sLineBreak + FN);
except
on E: Exception do
ShowMessage('Export Failed: ' + E.Message);
end;
finally
DWEdit1.DWESizeReduction := OldReductionState;
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;
UpdateCaption;
DWEdit1.SetFocus;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
// Switching TO Web Layout
if DWEdit1.ViewLayout = vmPaperLayout then
begin
DWEdit1.ViewLayout := vmWebLayout;
// Web Layout: "Infinite" horizontal canvas
DWEdit1.WordWrap := wwNoWrap;
Button3.Caption := 'Web Layout';
end
// Switching TO Paper Layout
else if DWEdit1.ViewLayout = vmWebLayout then
begin
DWEdit1.ViewLayout := vmPaperLayout;
// Paper Layout: Standard document wrapping
DWEdit1.WordWrap := wwWrap;
Button3.Caption := 'Paper Layout';
end;
UpdateCaption;
DWEdit1.SetFocus;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
NewAccentColor: TColor;
begin
NewAccentColor := ColorButton1.ButtonColor;
if CurrentTheme = tmDark then
begin
Button4.Caption := 'Light Mode';
CurrentTheme := tmLight;
end else
begin
Button4.Caption := 'Dark Mode';
CurrentTheme := tmDark;
end;
ApplyTheme(CurrentTheme, NewAccentColor);
DWEdit1.SetTheme(CurrentTheme, NewAccentColor);
DWEdit1.SetFocus;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if DWEdit1.PaperSize = ppsLetter then
begin
DWEdit1.PaperSize := ppsHalf_Letter;
Button5.Caption := 'To Letter';
end
else
begin
DWEdit1.PaperSize := ppsLetter;
Button5.Caption := 'To Half Letter';
end;
UpdateCaption;
DWEdit1.SetFocus;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
if DWEdit1.PaperOrientation = ppoPortrait then
begin
// Switch to Landscape
DWEdit1.PaperOrientation := ppoLandscape;
Button6.Caption := 'To Portrait';
end
else
begin
// Switch back to Portrait
DWEdit1.PaperOrientation := ppoPortrait;
Button6.Caption := 'To Landscape';
end;
UpdateCaption;
DWEdit1.SetFocus;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
if DWEdit1.PaperMargin = mgNormal then
begin
DWEdit1.PaperMargin := mgCustom;
Button7.Caption := 'Margin: Custom';
end
else
begin
DWEdit1.PaperMargin := mgNormal;
Button7.Caption := 'Margin: Normal';
end;
UpdateCaption;
DWEdit1.SetFocus;
end;
procedure TForm1.Button8Click(Sender: TObject);
var
FS: TFileStream;
begin // Load DWE native format
if FileExists('sample.dwe') then
begin
FS := TFileStream.Create('sample.dwe', fmOpenRead);
try
DWEdit1.LoadFromNativeStream(FS);
finally
FS.Free;
end;
UpdateCaption;
DWEdit1.SetFocus;
end;
end;
procedure TForm1.Button9Click(Sender: TObject);
var
FS: TFileStream;
FN: String;
OldReductionState: Boolean;
begin // Save DWE native format
FN := ExpandFileName('sample.dwe');
FS := TFileStream.Create(FN, fmCreate);
OldReductionState := DWEdit1.DWESizeReduction;
try
DWEdit1.DWESizeReduction := True; // Use JPEG for file compactness
DWEdit1.SaveToNativeStream(FS);
finally
DWEdit1.DWESizeReduction := OldReductionState;
FS.Free;
end;
ShowMessage(FN + LineEnding + 'Has been Saved!');
DWEdit1.SetFocus;
end;
procedure TForm1.ColorButton1ColorChanged(Sender: TObject);
var
NewAccentColor: TColor;
begin
NewAccentColor := ColorButton1.ButtonColor;
ApplyTheme(CurrentTheme, NewAccentColor);
DWEdit1.SetTheme(CurrentTheme, NewAccentColor);
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(bdRightToLeft);
DWEdit1.Alignment := paRight;
end;
procedure TForm1.UpdateCaption;
var
Line, Col: Integer;
PP, PD: 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(PP);
DWEdit1.GetCaretPosDIP(PD);
// Format the caption
Self.Caption := Format(
'SelStart: %d (Line: %d, Col: %d) — DIPs[X: %d, Y: %d] — Pixels[X: %d, Y: %d] — Zoom: %d%% — Page: %d of %d',
[DWEdit1.SelStart, Line+1, Col+1 , PD.X, PD.Y, PP.X, PP.Y, Round(DWEdit1.ZoomFactor * 100), CurrentPage, TotalPage]
);
end;
procedure TForm1.CMDelayedInit(var Message: TMessage);
begin
// 1. Tell the component to recalculate
DWEdit1.ResetLayout;
// 2. Tell the form to refresh the title
UpdateCaption;
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
