793 lines
26 KiB
ObjectPascal
793 lines
26 KiB
ObjectPascal
unit Unit1;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
|
StdCtrls, Spin, ComCtrls, BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes,
|
|
BGRATextBidi, BGRAFreeType, EasyLazFreeType, LazFreeTypeFontCollection,
|
|
fgl, Types;
|
|
|
|
const
|
|
CaretBlinkTimeMs = 500;
|
|
ssShortcut = {$IFDEF DARWIN}ssMeta{$ELSE}ssCtrl{$ENDIF};
|
|
|
|
type
|
|
TRenderedBrokenLineList = specialize TFPGObjectList<TBGRABitmap>;
|
|
|
|
{ TForm1 }
|
|
|
|
TForm1 = class(TForm)
|
|
BGRAVirtualScreen1: TBGRAVirtualScreen;
|
|
CheckBox_ClearType: TCheckBox;
|
|
CheckBox_FreeType: TCheckBox;
|
|
ImageList1: TImageList;
|
|
Label2: TLabel;
|
|
Panel1: TPanel;
|
|
ScrollBar1: TScrollBar;
|
|
SpinEdit_FontSize: TSpinEdit;
|
|
TimerBlinkCaret: TTimer;
|
|
ToolBar1: TToolBar;
|
|
ToolButtonLeftAlign: TToolButton;
|
|
ToolButtonCenterAlign: TToolButton;
|
|
ToolButtonRightAlign: TToolButton;
|
|
procedure BGRAVirtualScreen1MouseDown(Sender: TObject;
|
|
Button: TMouseButton; {%H-}Shift: TShiftState; X, Y: Integer);
|
|
procedure BGRAVirtualScreen1MouseMove(Sender: TObject; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
procedure BGRAVirtualScreen1MouseWheel(Sender: TObject; Shift: TShiftState;
|
|
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
|
|
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
|
|
procedure CheckBox_ClearTypeChange(Sender: TObject);
|
|
procedure CheckBox_FreeTypeChange(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
procedure FormKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
|
|
procedure FormKeyPress(Sender: TObject; var Key: char);
|
|
procedure ScrollBar1Change(Sender: TObject);
|
|
procedure SpinEdit_FontSizeChange(Sender: TObject);
|
|
procedure TimerBlinkCaretTimer(Sender: TObject);
|
|
procedure ToolButtonCenterAlignClick(Sender: TObject);
|
|
procedure ToolButtonLeftAlignClick(Sender: TObject);
|
|
procedure ToolButtonRightAlignClick(Sender: TObject);
|
|
private
|
|
FFontRenderer: TBGRACustomFontRenderer;
|
|
FTextLayout: TBidiTextLayout;
|
|
FRenderedParagraphs: array of TRenderedBrokenLineList;
|
|
FBlinkCaretTime: TDateTime;
|
|
FBlinkCaretState: boolean;
|
|
FSelStart,FSelLength: integer;
|
|
FSelFirstClick,FSelLastClick: integer;
|
|
FCurFirstParagraph,FCurLastParagraph: integer;
|
|
FTestText: string;
|
|
FInUnicode: boolean;
|
|
FUnicodeValue: LongWord;
|
|
function GetLayoutReady: boolean;
|
|
function GetSelLastClick: integer;
|
|
procedure LayoutBrokenLinesChanged({%H}ASender: TObject;
|
|
AParagraphIndex: integer; ASubBrokenStart, ASubBrokenChangedCountBefore,
|
|
ASubBrokenChangedCountAfter: integer; ASubBrokenTotalCountBefore,
|
|
{%H}ASubBrokenTotalCountAfter: integer);
|
|
procedure LayoutParagraphDeleted({%H}ASender: TObject; AParagraphIndex: integer);
|
|
procedure LayoutParagraphMergedWithNext(ASender: TObject;
|
|
AParagraphIndex: integer);
|
|
procedure LayoutParagraphSplit({%H}ASender: TObject; AParagraphIndex: integer;
|
|
ASubBrokenIndex, {%H-}ACharIndex: integer);
|
|
procedure SetSelLastClick(AValue: integer);
|
|
procedure SetSelLength(AValue: integer);
|
|
procedure SetSelStart(AValue: integer);
|
|
procedure FlushUnicode;
|
|
procedure DiscardRenderedBrokenLines;
|
|
procedure LayoutCompletelyChanged;
|
|
public
|
|
procedure UpdateCurrentParagraph;
|
|
procedure UpdateSelectionFromFirstLastClick;
|
|
procedure SetCurrentParagraphAlign(AAlign: TAlignment);
|
|
procedure DeleteSelection;
|
|
procedure InsertText(AText: string);
|
|
procedure ShowCaret;
|
|
property SelStart: integer read FSelStart write SetSelStart;
|
|
property SelLength: integer read FSelLength write SetSelLength;
|
|
property SelLastClick: integer read GetSelLastClick write SetSelLastClick;
|
|
property LayoutReady: boolean read GetLayoutReady;
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
uses BGRAText, LCLType, BGRAUTF8, Clipbrd, LCLIntf, math;
|
|
|
|
{$R *.lfm}
|
|
|
|
procedure SetClipboardAsText(Value: string);
|
|
var
|
|
strStream: TStringStream;
|
|
begin
|
|
strStream := TStringStream.Create(Value);
|
|
Clipboard.SetFormat(PredefinedClipboardFormat(pcfText), strStream);
|
|
strStream.Free;
|
|
end;
|
|
|
|
{ TForm1 }
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
FTextLayout := nil;
|
|
FFontRenderer := nil;
|
|
FSelStart:= 0;
|
|
FSelLength:= 0;
|
|
FSelFirstClick := -1;
|
|
FSelLastClick:= -1;
|
|
TimerBlinkCaret.Interval := CaretBlinkTimeMs;
|
|
FCurFirstParagraph:= -1;
|
|
FCurLastParagraph:= -1;
|
|
|
|
BGRAVirtualScreen1.OnKeyDown:= @FormKeyDown;
|
|
BGRAVirtualScreen1.OnKeyUp:= @FormKeyUp;
|
|
BGRAVirtualScreen1.OnKeyPress:= @FormKeyPress;
|
|
BGRAVirtualScreen1.Cursor := crIBeam;
|
|
BGRAVirtualScreen1.BitmapAutoScale:= false;
|
|
|
|
FTestText := 'تحتوي العربية على 28 حرفاً مكتوباً. ويرى بعض اللغويين أنه يجب إضافة حرف الهمزة إلى حروف العربية، ليصبح عدد الحروف 29. تُكتب العربية من اليمين إلى اليسار - ومثلها اللغة الفارسية والعبرية على عكس كثير من اللغات العالمية - ومن أعلى الصفحة إلى أسفلها.'+LineEnding+
|
|
'Arabic reversed "' + UTF8OverrideDirection('صباح الخير',false)+'". Arabic marks: "لاٍُ لٍُإ بًٍّ ةُِ ںْ رُ ٮَ بٔ".'+ LineEnding +
|
|
#9'Le français est une langue indo-européenne de la famille des langues romanes. Le français s''est formé en France (variété de la « langue d''oïl », qui est la langue de la partie septentrionale du pays).'+LineEnding+
|
|
'Glorious finds itself reversed as '+ UTF8OverrideDirection('"glorious"',True) + '. ' +
|
|
'"Hello!" is '+ UTF8EmbedDirection('"مرحبا!"',True) + ' in arabic.' + LineEnding +
|
|
'देवनागरी एक भारतीय लिपि है जिसमें अनेक भारतीय भाषाएँ तथा कई विदेशी भाषाएँ लिखी जाती हैं। यह बायें से दायें लिखी जाती है।' + LineEnding +
|
|
'对于汉语的分支语言，学界主要有两种观点，一种观点将汉语定义为语言，并将官话、贛語、闽语、粤语、客家语、吴语、湘语七大语言定义为一级方言.'+LineEnding+
|
|
'עִבְרִית היא שפה שמית, ממשפחת השפות האפרו-אסיאתיות, הידועה כשפתם של היהודים ושל השומרונים, אשר ניב מודרני שלה (עברית ישראלית) משמש כשפה הרשמית והעיקרית של מדינת ישראל.';
|
|
|
|
end;
|
|
|
|
procedure TForm1.FormDestroy(Sender: TObject);
|
|
begin
|
|
DiscardRenderedBrokenLines;
|
|
FTextLayout.Free;
|
|
FFontRenderer.Free;
|
|
end;
|
|
|
|
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
|
procedure MoveTo(ANewPos: integer);
|
|
begin
|
|
if ssShift in Shift then
|
|
begin
|
|
if ANewPos <> -1 then
|
|
SelLastClick := ANewPos;
|
|
end else
|
|
begin
|
|
if ANewPos <> -1 then
|
|
SelStart := ANewPos;
|
|
SelLength:= 0;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
idxPara, newPos: Integer;
|
|
begin
|
|
if not LayoutReady then exit;
|
|
|
|
if (Key = VK_U) and ([ssCtrl,ssShift] <= Shift) then
|
|
begin
|
|
FlushUnicode;
|
|
FInUnicode := true;
|
|
FUnicodeValue:= 0;
|
|
Key := 0;
|
|
end else
|
|
if FInUnicode then
|
|
begin
|
|
case Key of
|
|
VK_DELETE: begin
|
|
FUnicodeValue := FUnicodeValue shr 4;
|
|
end;
|
|
VK_0..VK_9: begin
|
|
FUnicodeValue := (FUnicodeValue shl 4) + (Key - VK_0);
|
|
end;
|
|
VK_NUMPAD0..VK_NUMPAD9: begin
|
|
FUnicodeValue := (FUnicodeValue shl 4) + (Key - VK_NUMPAD0);
|
|
end;
|
|
VK_A..VK_F: begin
|
|
FUnicodeValue := (FUnicodeValue shl 4) + (Key - VK_A + 10);
|
|
end;
|
|
else
|
|
FlushUnicode;
|
|
end;
|
|
if (FUnicodeValue >= $10FFF0) or
|
|
(FUnicodeValue >= $11000) then
|
|
FlushUnicode;
|
|
Key := 0;
|
|
end else
|
|
if KEY = VK_DELETE then
|
|
begin
|
|
if SelLength > 0 then DeleteSelection
|
|
else
|
|
begin
|
|
FTextLayout.DeleteText(SelStart, 1);
|
|
SelStart := SelStart + FTextLayout.IncludeNonSpacingChars(SelStart, 0);
|
|
ShowCaret;
|
|
end;
|
|
Key := 0;
|
|
end else
|
|
if (Key = VK_LEFT) or (Key = VK_RIGHT) then
|
|
begin
|
|
if (Key = VK_LEFT) xor FTextLayout.ParagraphRightToLeft[FTextLayout.GetParagraphAt(SelLastClick)] then
|
|
begin
|
|
if SelLastClick > 0 then
|
|
newPos := SelLastClick - FTextLayout.IncludeNonSpacingCharsBefore(SelLastClick,1)
|
|
else newPos := -1;
|
|
|
|
MoveTo(newPos);
|
|
end else
|
|
begin
|
|
if SelLastClick < FTextLayout.CharCount then
|
|
newPos := SelLastClick + FTextLayout.IncludeNonSpacingChars(SelLastClick,1)
|
|
else newPos := -1;
|
|
|
|
MoveTo(newPos);
|
|
end;
|
|
Key := 0;
|
|
end else
|
|
if (Key = VK_UP) or (Key = VK_DOWN) then
|
|
begin
|
|
if Key = VK_UP then
|
|
newPos := FTextLayout.FindTextAbove(SelLastClick)
|
|
else
|
|
newPos := FTextLayout.FindTextBelow(SelLastClick);
|
|
|
|
MoveTo(newPos);
|
|
Key := 0;
|
|
end else
|
|
if Key = VK_HOME then
|
|
begin
|
|
idxPara := FTextLayout.GetParagraphAt(SelLastClick);
|
|
if ssCtrl in Shift then newPos := 0 else
|
|
newPos := FTextLayout.ParagraphStartIndex[idxPara];
|
|
MoveTo(newPos);
|
|
Key := 0;
|
|
end else
|
|
if Key = VK_END then
|
|
begin
|
|
idxPara := FTextLayout.GetParagraphAt(SelLastClick);
|
|
if ssCtrl in Shift then newPos := FTextLayout.CharCount else
|
|
newPos := FTextLayout.ParagraphEndIndexBeforeParagraphSeparator[idxPara];
|
|
MoveTo(newPos);
|
|
Key := 0;
|
|
end else
|
|
if Key = VK_RETURN then
|
|
begin
|
|
if SelLength > 0 then DeleteSelection;
|
|
if ssShift in Shift then
|
|
begin
|
|
SelStart := SelStart + FTextLayout.InsertLineSeparator(SelStart);
|
|
end else
|
|
InsertText(LineEnding);
|
|
Key := 0;
|
|
end else
|
|
if Key = VK_TAB then
|
|
begin
|
|
if SelLength > 0 then DeleteSelection;
|
|
InsertText(#9);
|
|
Key := 0;
|
|
end else
|
|
If (Key = VK_C) and (ssShortcut in Shift) then
|
|
begin
|
|
if SelLength> 0 then
|
|
SetClipboardAsText(FTextLayout.CopyText(SelStart, SelLength));
|
|
Key := 0;
|
|
end else
|
|
If (Key = VK_X) and (ssShortcut in Shift) then
|
|
begin
|
|
if SelLength > 0 then
|
|
begin
|
|
SetClipboardAsText(FTextLayout.CopyText(SelStart, SelLength));
|
|
DeleteSelection;
|
|
end;
|
|
Key := 0;
|
|
end else
|
|
If (Key = VK_V) and (ssShortcut in Shift) then
|
|
begin
|
|
InsertText(Clipboard.AsText);
|
|
Key := 0;
|
|
end else
|
|
If (Key = VK_A) and (ssShortcut in Shift) then
|
|
begin
|
|
SelStart:= 0;
|
|
SelLength:= FTextLayout.CharCount;
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if FInUnicode then
|
|
begin
|
|
if (Key = VK_CONTROL) or (Key = VK_SHIFT) then
|
|
FlushUnicode;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.FormKeyPress(Sender: TObject; var Key: char);
|
|
var
|
|
delCount: Integer;
|
|
begin
|
|
if not LayoutReady then exit;
|
|
|
|
if Key = #8 then
|
|
begin
|
|
if SelLength > 0 then DeleteSelection
|
|
else
|
|
begin
|
|
if SelStart > 0 then
|
|
begin
|
|
delCount := FTextLayout.DeleteTextBefore(SelStart, 1);
|
|
SelStart := SelStart - delCount;
|
|
SelStart := SelStart + FTextLayout.IncludeNonSpacingChars(SelStart, 0);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if Key = #13 then
|
|
InsertText(LineEnding)
|
|
else
|
|
InsertText(Key);
|
|
Key := #0
|
|
end;
|
|
|
|
procedure TForm1.ScrollBar1Change(Sender: TObject);
|
|
begin
|
|
BGRAVirtualScreen1.DiscardBitmap;
|
|
end;
|
|
|
|
procedure TForm1.SpinEdit_FontSizeChange(Sender: TObject);
|
|
begin
|
|
LayoutCompletelyChanged;
|
|
end;
|
|
|
|
procedure TForm1.TimerBlinkCaretTimer(Sender: TObject);
|
|
begin
|
|
BGRAVirtualScreen1.DiscardBitmap;
|
|
end;
|
|
|
|
procedure TForm1.ToolButtonCenterAlignClick(Sender: TObject);
|
|
begin
|
|
SetCurrentParagraphAlign(taCenter);
|
|
end;
|
|
|
|
procedure TForm1.ToolButtonLeftAlignClick(Sender: TObject);
|
|
begin
|
|
SetCurrentParagraphAlign(taLeftJustify);
|
|
end;
|
|
|
|
procedure TForm1.ToolButtonRightAlignClick(Sender: TObject);
|
|
begin
|
|
SetCurrentParagraphAlign(taRightJustify);
|
|
end;
|
|
|
|
function TForm1.GetLayoutReady: boolean;
|
|
begin
|
|
result := Assigned(FTextLayout) and Assigned(FFontRenderer);
|
|
end;
|
|
|
|
function TForm1.GetSelLastClick: integer;
|
|
begin
|
|
if FSelLastClick = -1 then
|
|
result := FSelStart + FSelLength
|
|
else
|
|
result := FSelLastClick;
|
|
end;
|
|
|
|
procedure TForm1.LayoutBrokenLinesChanged(ASender: TObject;
|
|
AParagraphIndex: integer; ASubBrokenStart, ASubBrokenChangedCountBefore,
|
|
ASubBrokenChangedCountAfter: integer; ASubBrokenTotalCountBefore,
|
|
ASubBrokenTotalCountAfter: integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (AParagraphIndex < 0) or (AParagraphIndex > high(FRenderedParagraphs)) or
|
|
(FRenderedParagraphs[AParagraphIndex] = nil) then exit;
|
|
if ASubBrokenTotalCountBefore <> FRenderedParagraphs[AParagraphIndex].Count then
|
|
FreeAndNil(FRenderedParagraphs[AParagraphIndex])
|
|
else
|
|
begin
|
|
for i := 0 to ASubBrokenChangedCountBefore-1 do
|
|
FRenderedParagraphs[AParagraphIndex].Delete(ASubBrokenStart);
|
|
for i := 0 to ASubBrokenChangedCountAfter-1 do
|
|
FRenderedParagraphs[AParagraphIndex].Insert(ASubBrokenStart, nil);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.DiscardRenderedBrokenLines;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to high(FRenderedParagraphs) do
|
|
FreeAndNil(FRenderedParagraphs[i]);
|
|
end;
|
|
|
|
procedure TForm1.LayoutCompletelyChanged;
|
|
begin
|
|
if Assigned(FTextLayout) then FTextLayout.InvalidateLayout;
|
|
DiscardRenderedBrokenLines;
|
|
BGRAVirtualScreen1.DiscardBitmap;
|
|
end;
|
|
|
|
procedure TForm1.LayoutParagraphDeleted(ASender: TObject;
|
|
AParagraphIndex: integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (AParagraphIndex >= 0) and (AParagraphIndex <= high(FRenderedParagraphs)) then
|
|
begin
|
|
FreeAndNil(FRenderedParagraphs[AParagraphIndex]);
|
|
for i := AParagraphIndex to high(FRenderedParagraphs)-1 do
|
|
FRenderedParagraphs[i] := FRenderedParagraphs[i+1];
|
|
setlength(FRenderedParagraphs, length(FRenderedParagraphs)-1);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.LayoutParagraphMergedWithNext(ASender: TObject;
|
|
AParagraphIndex: integer);
|
|
var
|
|
i, insertIndex: Integer;
|
|
renderedBrokenLine: TBGRABitmap;
|
|
begin
|
|
insertIndex := FRenderedParagraphs[AParagraphIndex].Count;
|
|
for i := FRenderedParagraphs[AParagraphIndex+1].Count-1 downto 0 do
|
|
begin
|
|
renderedBrokenLine := FRenderedParagraphs[AParagraphIndex+1].Items[i];
|
|
FRenderedParagraphs[AParagraphIndex].Insert(insertIndex, renderedBrokenLine);
|
|
FRenderedParagraphs[AParagraphIndex+1].Extract(renderedBrokenLine);
|
|
end;
|
|
LayoutParagraphDeleted(ASender, AParagraphIndex+1);
|
|
end;
|
|
|
|
procedure TForm1.LayoutParagraphSplit(ASender: TObject;
|
|
AParagraphIndex: integer; ASubBrokenIndex, ACharIndex: integer);
|
|
var
|
|
i, j: Integer;
|
|
renderedBrokenLine: TBGRABitmap;
|
|
begin
|
|
if (AParagraphIndex >= 0) and (AParagraphIndex <= high(FRenderedParagraphs)) then
|
|
begin
|
|
setlength(FRenderedParagraphs, length(FRenderedParagraphs)+1);
|
|
for i := high(FRenderedParagraphs) downto AParagraphIndex+2 do
|
|
FRenderedParagraphs[i] := FRenderedParagraphs[i-1];
|
|
FRenderedParagraphs[AParagraphIndex+1] := TRenderedBrokenLineList.Create;
|
|
for j := FRenderedParagraphs[AParagraphIndex].Count-1 downto ASubBrokenIndex+1 do
|
|
begin
|
|
renderedBrokenLine := FRenderedParagraphs[AParagraphIndex].Items[j];
|
|
FRenderedParagraphs[AParagraphIndex+1].Insert(0, renderedBrokenLine);
|
|
FRenderedParagraphs[AParagraphIndex].Extract(renderedBrokenLine);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.SetSelLastClick(AValue: integer);
|
|
begin
|
|
if FSelFirstClick = -1 then
|
|
FSelFirstClick := FSelStart;
|
|
FSelLastClick:= AValue;
|
|
UpdateSelectionFromFirstLastClick;
|
|
end;
|
|
|
|
procedure TForm1.SetSelLength(AValue: integer);
|
|
begin
|
|
if FSelLength=AValue then Exit;
|
|
FSelLength:=AValue;
|
|
FSelFirstClick:=-1;
|
|
FSelLastClick:=-1;
|
|
ShowCaret;
|
|
end;
|
|
|
|
procedure TForm1.SetSelStart(AValue: integer);
|
|
begin
|
|
if FSelStart=AValue then Exit;
|
|
FSelStart:=AValue;
|
|
if FSelStart + FSelLength > FTextLayout.CharCount then
|
|
FSelLength := FTextLayout.CharCount - FSelStart;
|
|
FSelFirstClick:=-1;
|
|
FSelLastClick:=-1;
|
|
ShowCaret;
|
|
end;
|
|
|
|
procedure TForm1.FlushUnicode;
|
|
begin
|
|
if not FInUnicode then exit;
|
|
FInUnicode := false;
|
|
InsertText(UnicodeCharToUTF8(FUnicodeValue));
|
|
end;
|
|
|
|
procedure TForm1.UpdateCurrentParagraph;
|
|
var curAlign: TAlignment;
|
|
begin
|
|
if not LayoutReady then exit;
|
|
|
|
FCurFirstParagraph:= FTextLayout.GetParagraphAt(SelStart);
|
|
FCurLastParagraph:= FTextLayout.GetParagraphAt(SelStart+SelLength);
|
|
case FTextLayout.ParagraphAlignment[FCurFirstParagraph] of
|
|
btaCenter: curAlign := taCenter;
|
|
btaLeftJustify: curAlign := taLeftJustify;
|
|
btaRightJustify: curAlign:= taRightJustify;
|
|
btaOpposite: if FTextLayout.ParagraphRightToLeft[FCurFirstParagraph] then
|
|
curAlign:= taLeftJustify else curAlign:= taRightJustify;
|
|
else
|
|
if FTextLayout.ParagraphRightToLeft[FCurFirstParagraph] then
|
|
curAlign:= taRightJustify else curAlign:= taLeftJustify;
|
|
end;
|
|
ToolButtonLeftAlign.Down := curAlign = taLeftJustify;
|
|
ToolButtonCenterAlign.Down := curAlign = taCenter;
|
|
ToolButtonRightAlign.Down := curAlign = taRightJustify;
|
|
end;
|
|
|
|
procedure TForm1.UpdateSelectionFromFirstLastClick;
|
|
begin
|
|
if FSelLastClick < FSelFirstClick then
|
|
begin
|
|
FSelStart := FSelLastClick;
|
|
FSelLength:= FSelFirstClick-FSelLastClick;
|
|
end else
|
|
begin
|
|
FSelStart:= FSelFirstClick;
|
|
FSelLength:= FSelLastClick-FSelFirstClick;
|
|
end;
|
|
ShowCaret;
|
|
end;
|
|
|
|
procedure TForm1.SetCurrentParagraphAlign(AAlign: TAlignment);
|
|
var
|
|
i: Integer;
|
|
newAlign: TBidiTextAlignment;
|
|
begin
|
|
if LayoutReady and (FCurFirstParagraph <> -1) then
|
|
begin
|
|
for i := FCurFirstParagraph to FCurLastParagraph do
|
|
begin
|
|
case AALign of
|
|
taLeftJustify: if FTextLayout.ParagraphRightToLeft[i] then
|
|
newAlign := btaOpposite
|
|
else newAlign := btaNatural;
|
|
taRightJustify: if FTextLayout.ParagraphRightToLeft[i] then
|
|
newAlign := btaNatural
|
|
else newAlign := btaOpposite;
|
|
else {taCenter:} newAlign := btaCenter;
|
|
end;
|
|
FTextLayout.ParagraphAlignment[i] := newAlign;
|
|
end;
|
|
|
|
BGRAVirtualScreen1.DiscardBitmap;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.DeleteSelection;
|
|
begin
|
|
if SelLength <> 0 then
|
|
begin
|
|
FTextLayout.DeleteText(SelStart, SelLength);
|
|
SelStart := SelStart + FTextLayout.IncludeNonSpacingChars(SelStart, 0);
|
|
SelLength:= 0;
|
|
ShowCaret;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.InsertText(AText: string);
|
|
var
|
|
insertCount: Integer;
|
|
begin
|
|
if not LayoutReady then exit;
|
|
DeleteSelection;
|
|
insertCount := FTextLayout.InsertText(AText, SelStart);
|
|
SelStart := SelStart + insertCount;
|
|
SelStart := SelStart + FTextLayout.IncludeNonSpacingChars(SelStart, 0);
|
|
ShowCaret;
|
|
end;
|
|
|
|
procedure TForm1.ShowCaret;
|
|
begin
|
|
FBlinkCaretState := true;
|
|
FBlinkCaretTime:= Now;
|
|
BGRAVirtualScreen1.DiscardBitmap;
|
|
TimerBlinkCaret.Enabled := false;
|
|
TimerBlinkCaret.Enabled := true;
|
|
end;
|
|
|
|
procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
|
|
var
|
|
zoom, prevAvailWidth: single;
|
|
caretColor, selectionColor: TBGRAPixel;
|
|
newTime: TDateTime;
|
|
oldTopLeft: TPointF;
|
|
i: Integer;
|
|
startBroken, endBroken, j, countBroken: LongInt;
|
|
renderedBroken: TBGRABitmap;
|
|
renderRect: TRect;
|
|
begin
|
|
zoom := BGRAVirtualScreen1.BitmapScale * Screen.PixelsPerInch / 96;
|
|
if FFontRenderer = nil then
|
|
begin
|
|
if CheckBox_FreeType.Checked then
|
|
begin
|
|
FFontRenderer := TBGRAFreeTypeFontRenderer.Create;
|
|
FFontRenderer.FontName := 'Liberation Serif';
|
|
end else
|
|
begin
|
|
FFontRenderer := TLCLFontRenderer.Create;
|
|
FFontRenderer.FontName := {$IFDEF LINUX}'Liberation Serif'{$ELSE}'serif'{$ENDIF};
|
|
End;
|
|
end;
|
|
if CheckBox_ClearType.Checked then
|
|
begin
|
|
//force ClearType to RGB if disabled on the system
|
|
if fqFineClearType() = fqFineAntialiasing then
|
|
FFontRenderer.FontQuality:= fqFineClearTypeRGB
|
|
else
|
|
FFontRenderer.FontQuality:= fqSystemClearType;
|
|
end
|
|
else
|
|
begin
|
|
if CheckBox_FreeType.Checked then
|
|
FFontRenderer.FontQuality:= fqFineAntialiasing
|
|
else
|
|
FFontRenderer.FontQuality:= fqSystem;
|
|
end;
|
|
FFontRenderer.FontEmHeightF:= SpinEdit_FontSize.Value * zoom;
|
|
|
|
if FTextLayout = nil then
|
|
begin
|
|
FTextLayout:= TBidiTextLayout.Create(FFontRenderer, FTestText);
|
|
FTextLayout.ParagraphSpacingBelow:= 0.25;
|
|
FTextLayout.ParagraphSpacingAbove:= 0.25;
|
|
FTextLayout.OnParagraphDeleted:=@LayoutParagraphDeleted;
|
|
FTextLayout.OnParagraphMergedWithNext:=@LayoutParagraphMergedWithNext;
|
|
FTextLayout.OnParagraphSplit:=@LayoutParagraphSplit;
|
|
FTextLayout.OnBrokenLinesChanged:=@LayoutBrokenLinesChanged;
|
|
end else
|
|
FTextLayout.FontRenderer := FFontRenderer;
|
|
|
|
prevAvailWidth := FTextLayout.AvailableWidth;
|
|
FTextLayout.AvailableWidth := Bitmap.Width - 8*zoom;
|
|
FTextLayout.TopLeft := PointF(4*zoom,4*zoom);
|
|
if prevAvailWidth <> FTextLayout.AvailableWidth then
|
|
DiscardRenderedBrokenLines;
|
|
FTextLayout.ComputeLayoutIfNeeded;
|
|
|
|
oldTopLeft := FTextLayout.TopLeft;
|
|
ScrollBar1.Min:= 0;
|
|
ScrollBar1.Max:= round(FTextLayout.TotalTextHeight + 8*zoom);
|
|
ScrollBar1.PageSize:= Bitmap.Height;
|
|
ScrollBar1.LargeChange:= Bitmap.Height*2 div 3;
|
|
ScrollBar1.SmallChange:= round(FTextLayout.LineHeight);
|
|
if ScrollBar1.Position > max(0, ScrollBar1.Max - ScrollBar1.PageSize) then
|
|
ScrollBar1.Position := max(0, ScrollBar1.Max - ScrollBar1.PageSize);
|
|
|
|
caretColor := BGRA(0,0,255);
|
|
selectionColor := BGRA(0,0,255,128);
|
|
|
|
newTime := Now;
|
|
if newTime > FBlinkCaretTime + (CaretBlinkTimeMs/1000/24/60/60) then
|
|
begin
|
|
FBlinkCaretTime:= newTime;
|
|
FBlinkCaretState:= not FBlinkCaretState;
|
|
end;
|
|
|
|
FTextLayout.TopLeft := oldTopLeft + PointF(0, -ScrollBar1.Position);
|
|
if FBlinkCaretState and (SelLength = 0) and BGRAVirtualScreen1.Focused then
|
|
FTextLayout.DrawCaret(Bitmap, SelStart, BGRA(caretColor.red,caretColor.green,caretColor.blue,140), BGRA(caretColor.red,caretColor.green,caretColor.blue,100));
|
|
|
|
for i := FTextLayout.ParagraphCount to high(FRenderedParagraphs) do
|
|
FreeAndNil(FRenderedParagraphs[i]);
|
|
setlength(FRenderedParagraphs, FTextLayout.ParagraphCount);
|
|
|
|
for i := 0 to FTextLayout.ParagraphCount-1 do
|
|
begin
|
|
if FRenderedParagraphs[i] = nil then
|
|
FRenderedParagraphs[i] := TRenderedBrokenLineList.Create;
|
|
startBroken := FTextLayout.ParagraphStartBrokenLine[i];
|
|
endBroken := FTextLayout.ParagraphEndBrokenLine[i];
|
|
for j := startBroken to endBroken - 1 do
|
|
begin
|
|
if j - startBroken >= FRenderedParagraphs[i].Count then
|
|
FRenderedParagraphs[i].Add(nil);
|
|
if j - startBroken < FRenderedParagraphs[i].Count then
|
|
begin
|
|
renderRect := RectWithSize(0, round(oldTopLeft.y + FTextLayout.BrokenLineRectF[j].Top) - ScrollBar1.Position,
|
|
Bitmap.Width, ceil(FTextLayout.BrokenLineRectF[j].Height));
|
|
if renderRect.IntersectsWith(Bitmap.ClipRect) then
|
|
begin
|
|
if FRenderedParagraphs[i].Items[j - startBroken] = nil then
|
|
begin
|
|
renderedBroken := TBGRABitmap.Create(Bitmap.Width,
|
|
ceil(FTextLayout.BrokenLineRectF[j].Height), BGRAVirtualScreen1.Color);
|
|
FTextLayout.TopLeft := PointF(oldTopLeft.x, -FTextLayout.BrokenLineRectF[j].Top);
|
|
FTextLayout.DrawBrokenLines(renderedBroken, j, j+1);
|
|
FRenderedParagraphs[i].Items[j - startBroken] := renderedBroken;
|
|
end;
|
|
Bitmap.PutImage(renderRect.Left, renderRect.Top,
|
|
FRenderedParagraphs[i].Items[j - startBroken], dmSet);
|
|
end else
|
|
FRenderedParagraphs[i].Items[j - startBroken] := nil;
|
|
end;
|
|
end;
|
|
countBroken := endBroken - startBroken;
|
|
while FRenderedParagraphs[i].Count > countBroken do
|
|
FRenderedParagraphs[i].Delete(countBroken);
|
|
end;
|
|
FTextLayout.TopLeft := oldTopLeft + PointF(0, -ScrollBar1.Position);
|
|
|
|
FTextLayout.DrawSelection(Bitmap, SelStart, SelStart+SelLength, selectionColor, BGRA(0,0,192),1);
|
|
|
|
if FBlinkCaretState and (SelLength = 0) then
|
|
FTextLayout.DrawCaret(Bitmap, SelStart, BGRA(caretColor.red,caretColor.green,caretColor.blue,140), BGRA(caretColor.red,caretColor.green,caretColor.blue,100));
|
|
|
|
UpdateCurrentParagraph;
|
|
FTextLayout.TopLeft := oldTopLeft;
|
|
//let some time for events
|
|
TimerBlinkCaret.Enabled := false;
|
|
TimerBlinkCaret.Enabled := true;
|
|
end;
|
|
|
|
procedure TForm1.CheckBox_ClearTypeChange(Sender: TObject);
|
|
begin
|
|
LayoutCompletelyChanged;
|
|
end;
|
|
|
|
procedure TForm1.CheckBox_FreeTypeChange(Sender: TObject);
|
|
begin
|
|
LayoutCompletelyChanged;
|
|
FreeAndNil(FFontRenderer);
|
|
end;
|
|
|
|
procedure TForm1.BGRAVirtualScreen1MouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
index: Integer;
|
|
begin
|
|
BGRAVirtualScreen1.SetFocus;
|
|
if Button = mbLeft then
|
|
begin
|
|
index := FTextLayout.GetCharIndexAt(PointF(X, Y) * BGRAVirtualScreen1.BitmapScale
|
|
+ PointF(0,ScrollBar1.Position));
|
|
FSelFirstClick:= index;
|
|
FSelLastClick:= index;
|
|
UpdateSelectionFromFirstLastClick;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.BGRAVirtualScreen1MouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
index: Integer;
|
|
begin
|
|
if (FSelFirstClick <> -1) and (ssLeft in Shift) then
|
|
begin
|
|
index := FTextLayout.GetCharIndexAt(PointF(X,Y) * BGRAVirtualScreen1.BitmapScale
|
|
+ PointF(0,ScrollBar1.Position));
|
|
FSelLastClick:= index;
|
|
UpdateSelectionFromFirstLastClick;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.BGRAVirtualScreen1MouseWheel(Sender: TObject;
|
|
Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
|
|
var Handled: Boolean);
|
|
begin
|
|
ScrollBar1.Position := ScrollBar1.Position - (WheelDelta * ScrollBar1.SmallChange div 120);
|
|
end;
|
|
|
|
initialization
|
|
|
|
EasyLazFreeType.FontCollection := TFreeTypeFontCollection.Create;
|
|
EasyLazFreeType.FontCollection.AddFolder(ExtractFilePath(Application.ExeName)
|
|
{$IFDEF DARWIN} + '../../../' {$ENDIF});
|
|
|
|
finalization
|
|
|
|
FreeAndNil(EasyLazFreeType.FontCollection);
|
|
|
|
end.
|
|
|