From f4c7cd3cf21a008f18bebc65f9ff3433713413e4 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 22 Sep 2010 16:50:16 +0200 Subject: memo: implemented clipboard support with default popup menu support. --- src/gui/fpg_edit.pas | 2 +- src/gui/fpg_memo.pas | 323 +++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 274 insertions(+), 51 deletions(-) (limited to 'src') 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; -- cgit v1.2.3-70-g09d2