DBR Delphi-Ecke

// Es wird verhindert, dass Text in ein TMemo eingefügt werden kann.

// Getestet mit D4 unter XP

// Methode 1
// Nachteil: Wenn das Memo den Fokus hat, steht in der Regel
// der Inhalt der Zwischenablage systemweit nicht zur Verfügung.

uses clipbrd; 
 
var 
  CBuf: string; 
 
procedure TForm1.Memo1Enter(Sender: TObject); 
begin 
  if Clipboard.HasFormat(CF_TEXT) then begin 
    CBuf := ClipBoard.asText; 
    Clipboard.clear; 
  end else CBuf := ''; 
end; 
 
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  Clipboard.clear; 
end; 
 
procedure TForm1.Memo1Exit(Sender: TObject); 
begin 
  if (CBuf <> '') and (Clipboard.asText = '') 
    then Clipboard.asText := CBuf; 
end; 
 
procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if Clipboard.asText <> '' then CBuf := Clipboard.asText; 
  Clipboard.clear; 
end;

//---------------------------------------------------------------------

// Methode 2
// Nachteil: Durch Unterdrücken des Popup-Menüs können im Memo mit der Maus
// keine Funktionen wie "Kopieren" oder "Rückgängig" ausgeführt werden.

uses clipbrd, menus; 
 
var 
  dummy: TPopupMenu; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  dummy := TPopupMenu.create(self); 
  Memo1.PopupMenu := Dummy; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  dummy.free; 
end; 
 
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
var s: string; 
begin 
  if ((Key = Ord('V')) and (ssCtrl in Shift)) and 
    Clipboard.hasformat(cf_text) then begin 
    s := Clipboard.asText; 
    Clipboard.Clear; 
    Application.Processmessages; 
    Clipboard.asText := s; 
  end; 
end;

//---------------------------------------------------------------------

// Methode 3
// Um den Nachteil der vorigen Methode abzustellen wird ein eigenes Popup-Menü
// erstellt, dem einfach der Punkt "Einfügen" fehlt.

... 
type 
  TForm1 = class(TForm) 
    Memo1: TMemo; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
  private 
    { Private-Deklarationen } 
  public 
    procedure pop(Sender: TObject); 
    procedure rueck(Sender: TObject); 
    procedure ausschn(Sender: TObject); 
    procedure kopie(Sender: TObject); 
    procedure loesch(Sender: TObject); 
    procedure alles(Sender: TObject); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses clipbrd, menus; 
 
var 
  MPop: TPopupMenu; 
  itms: array[0..6] of string = ('Rü&ckgängig', '-', '&Ausschneiden', 
    '&Kopieren', '&Löschen', '-', 'Alles &markieren'); 
  tm: array[0..6] of TMenuItem; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  x: integer; 
begin 
  MPop := TPopupMenu.create(self); 
  for x := 0 to 6 do begin 
    tm[x] := TMenuItem.Create(MPop); 
    tm[x].caption := itms[x]; 
    MPop.items.add(tm[x]); 
  end; 
  tm[0].OnClick := rueck; 
  tm[2].OnClick := ausschn; 
  tm[3].OnClick := kopie; 
  tm[4].OnClick := loesch; 
  tm[6].OnClick := alles; 
  MPop.OnPopup := pop; 
  Memo1.PopupMenu := MPop; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
var 
  x: integer; 
begin 
  for x := 0 to 6 do tm[x].free; 
  MPop.free; 
end; 
 
procedure TForm1.pop(Sender: TObject); 
begin 
  tm[0].enabled := Memo1.Perform(EM_CANUNDO, 0, 0) <> 0; 
  tm[2].enabled := Memo1.sellength > 0; 
  tm[3].enabled := tm[2].enabled; 
  tm[4].enabled := tm[2].enabled; 
  tm[6].enabled := Memo1.sellength < length(Memo1.Text); 
end; 
 
procedure TForm1.rueck(Sender: TObject); 
begin 
  Memo1.Perform(EM_UNDO, 0, 0); 
end; 
 
procedure TForm1.ausschn(Sender: TObject); 
begin 
  kopie(sender); 
  loesch(sender); 
end; 
 
procedure TForm1.kopie(Sender: TObject); 
begin 
  Clipboard.asText := Memo1.seltext; 
end; 
 
procedure TForm1.loesch(Sender: TObject); 
begin 
  Memo1.perform(EM_REPLACESEL, 1, integer(nil)); 
end; 
 
procedure TForm1.alles(Sender: TObject); 
begin 
  with Memo1 do begin 
    selstart := 0; 
    sellength := length(Text); 
  end; 
end; 
 
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
var s: string; 
begin 
  if ((Key = Ord('V')) and (ssCtrl in Shift)) and 
    Clipboard.hasformat(cf_text) then begin 
    s := Clipboard.asText; 
    Clipboard.Clear; 
    Application.Processmessages; 
    Clipboard.asText := s; 
  end; 
end;