summaryrefslogtreecommitdiff
path: root/src/gui
diff options
context:
space:
mode:
Diffstat (limited to 'src/gui')
-rw-r--r--src/gui/fpg_edit.pas2
-rw-r--r--src/gui/fpg_memo.pas323
2 files changed, 274 insertions, 51 deletions
diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas
index 5dd25fb0..ea6fe1b2 100644
--- a/src/gui/fpg_edit.pas
+++ b/src/gui/fpg_edit.pas
@@ -1178,7 +1178,7 @@ procedure TfpgBaseEdit.DefaultPopupPaste(Sender: TObject);
begin
if ReadOnly then
Exit;
- PasteFromClipboard
+ PasteFromClipboard;
end;
procedure TfpgBaseEdit.DefaultPopupClearAll(Sender: TObject);
diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas
index 37f21a42..b3c34513 100644
--- a/src/gui/fpg_memo.pas
+++ b/src/gui/fpg_memo.pas
@@ -60,12 +60,14 @@ type
FWrapping: boolean;
FLongestLineWidth: TfpgCoord;
FPopupMenu: TfpgPopupMenu;
+ FDefaultPopupMenu: TfpgPopupMenu;
+ FReadOnly: Boolean;
function GetFontDesc: string;
procedure SetFontDesc(const AValue: string);
procedure RecalcLongestLine;
procedure DeleteSelection;
procedure DoCopy;
- procedure DoPaste;
+ procedure DoPaste(const AText: TfpgString);
procedure AdjustCursor;
function LineCount: integer;
function GetLineText(linenum: integer): string;
@@ -81,10 +83,20 @@ type
function GetText: TfpgString;
procedure SetCursorLine(aValue: integer);
procedure UpdateScrollBarCoords;
+ procedure DefaultPopupCut(Sender: TObject);
+ procedure DefaultPopupCopy(Sender: TObject);
+ procedure DefaultPopupPaste(Sender: TObject);
+ procedure DefaultPopupClearAll(Sender: TObject);
+ procedure DefaultPopupInsertFromCharmap(Sender: TObject);
+ procedure SetDefaultPopupMenuItemsState;
+ procedure ShowDefaultPopupMenu(const x, y: integer; const shiftstate: TShiftState); virtual;
+ procedure SetReadOnly(const AValue: Boolean);
+ procedure ResetSelectionVariables;
protected
procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); override;
procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
+ procedure HandleRMouseDown(x, y: integer; shiftstate: TShiftState); override;
procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override;
procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
procedure HandleResize(dwidth, dheight: integer); override;
@@ -99,6 +111,10 @@ type
destructor Destroy; override;
procedure UpdateScrollBars;
function SelectionText: string;
+ procedure CopyToClipboard;
+ procedure CutToClipboard;
+ procedure PasteFromClipboard;
+ procedure Clear;
property CursorLine: integer read FCursorLine write SetCursorLine;
property Font: TfpgFont read FFont;
property LineHeight: integer read FLineHeight;
@@ -113,6 +129,7 @@ type
property Hint;
property Lines: TStringList read FLines;
property ParentShowHint;
+ property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TextColor;
@@ -130,7 +147,19 @@ function CreateMemo(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgMemo;
implementation
uses
- fpg_stringutils;
+ fpg_stringutils
+ ,fpg_constants
+ ,fpg_dialogs
+ ;
+
+const
+ // internal popupmenu item names
+ ipmCut = 'miDefaultCut';
+ ipmCopy = 'miDefaultCopy';
+ ipmPaste = 'miDefaultPaste';
+ ipmClearAll = 'miDefaultClearAll';
+ ipmCharmap = 'miDefaultCharmap';
+
type
// custom stringlist that will notify the memo of item changes
@@ -280,6 +309,128 @@ begin
FHScrollBar.UpdateWindowPosition;
end;
+procedure TfpgMemo.DefaultPopupCut(Sender: TObject);
+begin
+ if ReadOnly then
+ Exit;
+ CutToClipboard;
+end;
+
+procedure TfpgMemo.DefaultPopupCopy(Sender: TObject);
+begin
+ if ReadOnly then
+ Exit;
+ CopyToClipboard;
+end;
+
+procedure TfpgMemo.DefaultPopupPaste(Sender: TObject);
+begin
+ if ReadOnly then
+ Exit;
+ PasteFromClipboard;
+end;
+
+procedure TfpgMemo.DefaultPopupClearAll(Sender: TObject);
+begin
+ if ReadOnly then
+ Exit;
+ Clear;
+end;
+
+procedure TfpgMemo.DefaultPopupInsertFromCharmap(Sender: TObject);
+var
+ s: TfpgString;
+begin
+ if ReadOnly then
+ Exit;
+ s := fpgShowCharMap;
+ if s <> '' then
+ DoPaste(s);
+end;
+
+procedure TfpgMemo.SetDefaultPopupMenuItemsState;
+var
+ i: integer;
+ itm: TfpgMenuItem;
+
+ function SomethingSelected: boolean;
+ var
+ selsl: integer;
+ selsp: integer;
+ selel: integer;
+ selep: integer;
+ begin
+ Result := FSelecting;
+ //Result := (FSelStartPos <> FCursorPos)
+ // and (FSelEndPos <> 0)
+ // and (FSelStartLine <> -1)
+ // and (FSelEndLine <> -1);
+ end;
+
+begin
+ for i := 0 to FDefaultPopupMenu.ComponentCount-1 do
+ begin
+ if FDefaultPopupMenu.Components[i] is TfpgMenuItem then
+ begin
+ itm := TfpgMenuItem(FDefaultPopupMenu.Components[i]);
+ // enabled/disable menu items
+ if itm.Name = ipmCut then
+ itm.Enabled := (not ReadOnly) and SomethingSelected
+ else if itm.Name = ipmCopy then
+ itm.Enabled := SomethingSelected
+ else if itm.Name = ipmPaste then
+ itm.Enabled := (not ReadOnly) and (fpgClipboard.Text <> '')
+ else if itm.Name = ipmClearAll then
+ itm.Enabled := (not ReadOnly) and (Text <> '')
+ else if itm.Name = ipmCharmap then
+ itm.Enabled := (not ReadOnly);
+ end;
+ end;
+end;
+
+procedure TfpgMemo.ShowDefaultPopupMenu(const x, y: integer;
+ const shiftstate: TShiftState);
+var
+ itm: TfpgMenuItem;
+begin
+ if not Assigned(FDefaultPopupMenu) then
+ begin
+ FDefaultPopupMenu := TfpgPopupMenu.Create(nil);
+ itm := FDefaultPopupMenu.AddMenuItem(rsCut, '', @DefaultPopupCut);
+ itm.Name := ipmCut;
+ itm := FDefaultPopupMenu.AddMenuItem(rsCopy, '', @DefaultPopupCopy);
+ itm.Name := ipmCopy;
+ itm := FDefaultPopupMenu.AddMenuItem(rsPaste, '', @DefaultPopupPaste);
+ itm.Name := ipmPaste;
+ itm := FDefaultPopupMenu.AddMenuItem(rsDelete, '', @DefaultPopupClearAll);
+ itm.Name := ipmClearAll;
+ itm := FDefaultPopupMenu.AddMenuItem('-', '', nil);
+ itm.Name := 'N1';
+ itm := FDefaultPopupMenu.AddMenuItem(rsInsertFromCharacterMap, '', @DefaultPopupInsertFromCharmap);
+ itm.Name := ipmCharmap;
+ end;
+
+ SetDefaultPopupMenuItemsState;
+ FDefaultPopupMenu.ShowAt(self, x, y);
+end;
+
+procedure TfpgMemo.SetReadOnly(const AValue: Boolean);
+begin
+ if FReadOnly = AValue then exit;
+ FReadOnly := AValue;
+ RePaint;
+end;
+
+procedure TfpgMemo.ResetSelectionVariables;
+begin
+ FSelecting := False;
+ FSelStartPos := FCursorPos;
+ FSelEndPos := 0;
+ FSelStartLine := -1;
+ FSelEndLine := -1;
+ FMouseDragging := False;
+end;
+
constructor TfpgMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@@ -288,7 +439,6 @@ begin
FHeight := FFont.Height * 3 + 4;
FWidth := 120;
FLineHeight := FFont.Height + 2;
- FSelecting := False;
FSideMargin := 3;
FMaxLength := 0;
FWrapping := False;
@@ -299,19 +449,17 @@ begin
FTabWidth := 4;
FMinWidth := 20;
FMinHeight := 30;
+ FPopupMenu := nil;
+ FDefaultPopupMenu := nil;
+ FReadOnly := False;
FLines := TfpgMemoStrings.Create(self);
FFirstLine := 0;
FCursorLine := 0;
- FCursorPos := 0;
- FSelStartPos := FCursorPos;
- FSelEndPos := 0;
- FSelStartLine := -1;
- FSelEndLine := -1;
+ ResetSelectionVariables;
FDrawOffset := 0;
- FMouseDragging := False;
FVScrollBar := TfpgScrollBar.Create(self);
FVScrollBar.Orientation := orVertical;
@@ -327,6 +475,8 @@ end;
destructor TfpgMemo.Destroy;
begin
+ if Assigned(FDefaultPopupMenu) then
+ FDefaultPopupMenu.Free;
TfpgMemoStrings(FLines).Free;
FFont.Free;
inherited Destroy;
@@ -362,6 +512,8 @@ var
len: integer;
st: integer;
begin
+ if ReadOnly then
+ Exit;
if FSelEndLine < 0 then
Exit;
@@ -410,6 +562,9 @@ begin
FCursorPos := selsp;
FCursorLine := selsl;
+ FSelStartPos := FCursorPos;
+ FSelEndPos := FCursorPos;
+ FSelStartLine := selsl;
FSelEndLine := -1;
end;
@@ -465,29 +620,31 @@ begin
s := s + UTF8Copy(ls, st + 1, len);
end;
- //SetClipboardText(s);
+ fpgClipboard.Text := s;
end;
-procedure TfpgMemo.DoPaste;
-{
+procedure TfpgMemo.DoPaste(const AText: TfpgString);
var
- s: string;
- si: string;
- si8: string;
- lineend: string;
+ s: TfpgString;
+ si: TfpgString; { beginning of line to cursor }
+ si8: TfpgString;
+ lineend: TfpgString; { from cursor to end of line }
n: integer;
l: integer;
lcnt: integer;
-}
begin
- Exit;
- (*
+ if ReadOnly then
+ Exit;
DeleteSelection;
- s := GetClipboardText;
+ s := AText;
si := UTF8Copy(CurrentLine,1,FCursorPos);
lineend := UTF8Copy(CurrentLine,FCursorPos+1, UTF8Length(CurrentLine));
- l := FCursorLine;
+ if FCursorLine = -1 then { first time in, FLines has no data yet }
+ l := 0
+ else
+ l := FCursorLine;
+
n := 1;
lcnt := 0;
si8 := '';
@@ -495,8 +652,10 @@ begin
begin
if (s[n] = #13) or (s[n] = #10) then
begin
- if lcnt = 0 then SetLineText(l, si + si8)
- else FLines.Insert(l-1, si + si8);
+ if lcnt = 0 then
+ SetLineText(l, si + si8)
+ else
+ FLines.Insert(l-1, si + si8);
si := '';
si8 := '';
@@ -516,6 +675,8 @@ begin
si := si + si8;
FCursorPos := UTF8Length(si);
+ FSelStartPos := FCursorPos;
+ FSelEndPos := FCursorPos;
si := si + lineend;
if lcnt = 0 then
@@ -524,13 +685,16 @@ begin
end
else
begin
- FLines.Insert(l-1, si);
+ FLines.Insert(l, si);
FCursorLine := l;
end;
+ FSelStartLine := FCursorLine;
+ FSelEndLine := -1;
+
AdjustCursor;
Repaint;
-*)
+ FSelecting := False;
end;
procedure TfpgMemo.AdjustCursor;
@@ -783,7 +947,7 @@ begin
InflateRect(r, -2, -2);
Canvas.SetClipRect(r);
- if Enabled then
+ if Enabled and not ReadOnly then
Canvas.SetColor(FBackgroundColor)
else
Canvas.SetColor(clWindowBackground);
@@ -895,31 +1059,35 @@ begin
prevval := Text;
s := AText;
- // Printable characters only
- // Note: This is now UTF-8 compliant!
- if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) or (Length(AText) > 1) then
+ if (not consumed) and (not ReadOnly) then
begin
- if (FMaxLength <= 0) or (UTF8Length(FLines.Text) < FMaxLength) then
+ // Printable characters only
+ // Note: This is now UTF-8 compliant!
+ if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) or (Length(AText) > 1) then
begin
- if FCursorLine < 0 then
- FCursorLine := 0;
- DeleteSelection;
- ls := GetLineText(FCursorLine);
- UTF8Insert(s, ls, FCursorPos + 1);
- SetLineText(FCursorLine, ls);
- Inc(FCursorPos);
- FSelStartPos := FCursorPos;
- FSelStartLine := FCursorLine;
- FSelEndLine := -1;
- AdjustCursor;
+ if (FMaxLength <= 0) or (UTF8Length(FLines.Text) < FMaxLength) then
+ begin
+ if FCursorLine < 0 then
+ FCursorLine := 0;
+ DeleteSelection;
+ ls := GetLineText(FCursorLine);
+ UTF8Insert(s, ls, FCursorPos + 1);
+ SetLineText(FCursorLine, ls);
+ Inc(FCursorPos);
+ FSelStartPos := FCursorPos;
+ FSelStartLine := FCursorLine;
+ FSelEndLine := -1;
+ AdjustCursor;
+ end;
+
+ consumed := True;
end;
- consumed := True;
+ if prevval <> Text then
+ if Assigned(FOnChange) then
+ FOnChange(self);
end;
- if prevval <> Text then
- if Assigned(FOnChange) then
- FOnChange(self);
if consumed then
RePaint;
@@ -941,6 +1109,7 @@ var
end;
begin
+ fpgApplication.HideHint;
Consumed := True;
hasChanged := False;
case CheckClipBoardKey(keycode, shiftstate) of
@@ -950,14 +1119,19 @@ begin
end;
ckPaste:
begin
- DoPaste;
- hasChanged := True;
+ DoPaste(fpgClipboard.Text);
+ if not ReadOnly then
+ hasChanged := True;
end;
ckCut:
begin
DoCopy;
DeleteSelection;
- hasChanged := True;
+ if not ReadOnly then
+ begin
+ AdjustCursor;
+ hasChanged := True;
+ end;
end;
else
Consumed := False;
@@ -1078,7 +1252,7 @@ begin
end;
end;
- if not Consumed then
+ if (not Consumed) and (not ReadOnly) then
begin
consumed := True;
@@ -1190,6 +1364,7 @@ var
ls: string;
begin
inherited HandleLMouseDown(x, y, shiftstate);
+ ResetSelectionVariables;
// searching the appropriate character position
lnum := FFirstLine + (y - FSideMargin) div LineHeight;
@@ -1219,9 +1394,11 @@ begin
begin
FSelEndLine := lnum;
FSelEndpos := cp;
+ FSelecting := True;
end
else
begin
+ FSelecting := False;
FSelStartLine := lnum;
FSelStartPos := cp;
FSelEndLine := -1;
@@ -1229,11 +1406,22 @@ begin
Repaint;
end;
+procedure TfpgMemo.HandleRMouseDown(x, y: integer; shiftstate: TShiftState);
+begin
+ // keyMenu was pressed
+ if shiftstate = [ssExtra1] then
+ HandleRMouseUp(x, y, [])
+ else
+ inherited HandleRMouseDown(x, y, shiftstate);
+end;
+
procedure TfpgMemo.HandleRMouseUp(x, y: integer; shiftstate: TShiftState);
begin
inherited HandleRMouseUp(x, y, shiftstate);
if Assigned(PopupMenu) then
- PopupMenu.ShowAt(self, x, y);
+ PopupMenu.ShowAt(self, x, y)
+ else
+ ShowDefaultPopupMenu(x, y, ShiftState);
end;
procedure TfpgMemo.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState);
@@ -1276,6 +1464,7 @@ begin
FSelEndLine := lnum;
FSelEndPos := cp;
FCursorPos := cp;
+ FSelecting := True;
Repaint;
end;
@@ -1415,6 +1604,40 @@ begin
Result := '';
end;
+procedure TfpgMemo.CopyToClipboard;
+begin
+ DoCopy;
+end;
+
+procedure TfpgMemo.CutToClipboard;
+begin
+ DoCopy;
+ DeleteSelection;
+ AdjustCursor;
+ RePaint;
+end;
+
+procedure TfpgMemo.PasteFromClipboard;
+begin
+ DoPaste(fpgClipboard.Text);
+end;
+
+procedure TfpgMemo.Clear;
+begin
+ FLines.Clear;
+ { not sure if all of these are required }
+ FFirstLine := 0;
+ FCursorLine := 0;
+ FCursorPos := 0;
+ FSelStartPos := FCursorPos;
+ FSelEndPos := 0;
+ FSelStartLine := -1;
+ FSelEndLine := -1;
+ FDrawOffset := 0;
+
+ Repaint;
+end;
+
function TfpgMemo.GetText: TfpgString;
var
n: integer;
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-16 23:37:50 +0000