Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 70. - Spolupráce komponenty Edit se schránkou Windows

Jan Šindelář - 11.12.2002

Spolupráce komponenty Edit se schránkou Windows

Jistě si teď říkáte, o jaké "spolupráci se schránkou" bude vlastně řeč? Vlastně se nebude jednat ani tak o spolupráci komponenty samotné, protože aktivním je v tomto případě spíše uživatel. Jakýkoliv text, který si tak v komponentě Edit uživatel označí, může běžným způsobem, tedy klávesovou zkratkou nebo přes kontextové menu, zkopírovat či vyjmout do schránky a zrovna tak může text do komponenty ze schránky vložit. To je standard a uživatel je na to zvyklý. Co když ale chceme z nějakého důvodu (a nechme teď stranou z jakých důvodů) kopírování z nebo do schránky zakázat ? Samozřejmě to lze a pokud tedy tuto funkci chcete v programu mít, ukážeme si jak.

Poprvé v historii tohoto seriálu nebude zdrojovým kódem běžný unit nebo jeho část, ale příklad si uvedeme jako celou komponentu, čímž se usnadní používání tohoto příkladu v různých aplikacích. Proto bude možná zdrojový kód poněkud delší než obvykle, ale o to snazší bude jeho používání. Nebudeme si však vysvětlovat princip tvorby komponent, protože to by chtělo spíše malý samostatný seriál, ale řekneme si pouze o tom hlavním, tedy jak samotné zakazování a povolování práce se schránkou funguje.

Určitě vás asi už nepřekvapí, že všechno mají na svědomí opět zprávy Windows. Všechny činnosti, které se týkají práce se schránkou, tedy Cut & Copy & Paste doplněné ještě o funkci Clear, kterou rovněž v kontextovém menu najdeme, si v naší malé komponentě obsloužíme sami zachycením příslušné zprávy a naprogramováním dané funkce. Ve vlastnostech komponenty budou pouze logické přepínače, které budou zapínat či vypínat jednotlivé funkce schránky. V těle samotných procedur na obsluhu jednotlivých činností pak bude na začátku pouze jednoduchý test, zda má být daná funkce povolena či zakázána. Pokud bude funkce na základě vlastností daných v Object Inspectoru nebo za běhu programu zakázána, neprovede se nic. V opačném případě bude činnost provedena běžným způsobem a ke kopírování či vložení textu do Editu dojde.

Zde je tedy kompletní zdrojový kód naší předělané komponenty Edit, která se jmenuje jednoduše XEdit:

unit XEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, stdctrls, Clipbrd;

type
  TPreventNotifyEvent = procedure(Sender: TObject; Text: string; var Accept: Boolean) of object;

type
  TXEdit = class(TCustomEdit)
  private
    FPreventCut: Boolean;
    FPreventCopy: Boolean;
    FPreventPaste: Boolean;
    FPreventClear: Boolean;
    FOnCut: TPreventNotifyEvent;
    FOnCopy: TPreventNotifyEvent;
    FOnPaste: TPreventNotifyEvent;
    FOnClear: TPreventNotifyEvent;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMCopy(var Message: TMessage); message WM_COPY;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMClear(var Message: TMessage); message WM_CLEAR;
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    property PreventCut: Boolean read FPreventCut write FPreventCut default False;
    property PreventCopy: Boolean read FPreventCopy write FPreventCopy default False;
    property PreventPaste: Boolean read FPreventPaste write FPreventPaste default False;
    property PreventClear: Boolean read FPreventClear write FPreventClear default False;
    property OnCut: TPreventNotifyEvent read FOnCut write FOnCut;
    property OnCopy: TPreventNotifyEvent read FOnCopy write FOnCopy;
    property OnPaste: TPreventNotifyEvent read FOnPaste write FOnPaste;
    property OnClear: TPreventNotifyEvent read FOnClear write FOnClear;
  end;

procedure Register;

implementation

procedure TXEdit.WMCut(var Message: TMessage);
var
  Accept: Boolean;
  Handle: THandle;
  HandlePtr: Pointer;
  CText: string;
begin
  if FPreventCut or (SelLength = 0) then Exit;
  CText := Copy(Text, SelStart + 1, SelLength);
  try
    OpenClipBoard(Self.Handle);
    Accept := True;
    if Assigned(FOnCut) then FOnCut(Self, CText, Accept);
    if not Accept then Exit;
    Handle := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, Length(CText) + 1);
    if Handle = 0 then Exit;
    HandlePtr := GlobalLock(Handle);
    Move((PChar(CText))^, HandlePtr^, Length(CText));
    SetClipboardData(CF_TEXT, Handle);
    GlobalUnlock(Handle);
    CText := Text;
    Delete(CText, SelStart + 1, SelLength);
    Text := CText;
  finally
    CloseClipBoard;
  end;
end;

procedure TXEdit.WMCopy(var Message: TMessage);
var
  Accept: Boolean;
  Handle: THandle;
  HandlePtr: Pointer;
  CText: string;
begin
  if FPreventCopy or (SelLength = 0) then Exit;
  CText := Copy(Text, SelStart + 1, SelLength);
  try
    OpenClipBoard(Self.Handle);
    Accept := True;
    if Assigned(FOnCopy) then FOnCopy(Self, CText, Accept);
    if not Accept then Exit;
    Handle := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, Length(CText) + 1);
    if Handle = 0 then Exit;
    HandlePtr := GlobalLock(Handle);
    Move((PChar(CText))^, HandlePtr^, Length(CText));
    SetClipboardData(CF_TEXT, Handle);
    GlobalUnlock(Handle);
  finally
    CloseClipBoard;
  end;
end;

procedure TXEdit.WMPaste(var Message: TMessage);
var
  Accept: Boolean;
  Handle: THandle;
  CText: string;
  LText: string;
  AText: string;
begin
  if FPreventPaste then Exit;
  if IsClipboardFormatAvailable(CF_TEXT) then
  begin
    try
      OpenClipBoard(Self.Handle);
      Handle := GetClipboardData(CF_TEXT);
      if Handle = 0 then Exit;
      CText := StrPas(GlobalLock(Handle));
      GlobalUnlock(Handle);
      Accept := True;
      if Assigned(FOnPaste) then FOnPaste(Self, CText, Accept);
      if not Accept then Exit;
      LText := ``;
      if SelStart > 0 then LText := Copy(Text, 1, SelStart);
      LText := LText + CText;
      AText := ``;
      if (SelStart + 1) < Length(Text) then AText := Copy(Text, SelStart + SelLength + 1, Length(Text) - SelStart + SelLength + 1);
      Text := LText + AText;
    finally
      CloseClipBoard;
    end;
  end;
end;

procedure TXEdit.WMClear(var Message: TMessage);
var
  Accept: Boolean;
  CText: string;
begin
  if FPreventClear or (SelStart = 0) then Exit;
  CText  := Copy(Text, SelStart + 1, SelLength);
  Accept := True;
  if Assigned(FOnClear) then FOnClear(Self, CText, Accept);
  if not Accept then Exit;
  CText := Text;
  Delete(CText, SelStart + 1, SelLength);
  Text := CText;
end;

procedure Register;
begin
  RegisterComponents(`Samples`, [TXEdit]);
end;

end.

Ve vlastnostech komponenty v Object Inspectoru naleznete 4 nové vlastnosti - PreventClear, PreventCopy, PreventPaste a PreventCut. Pomocí nich můžete zakázat či povolit jednotlivé funkce. Instalace komponenty je obvyklá jako vždy. Zdrojový kód nakopírujete do adresáře s knihovnami (nebo libovolné jiné složky, kterou mají Delphi uloženu ve svých "prohledávaných" cestách), z menu Component vyberete položku Install Component a zde nalistujete přes tlačítko Browse příslušný soubor s komponentou. Buď komponentu nainstalujete do existujícího balíčku a nebo si vytvoříte nový a po kompilaci je vše hotovo. Naleznete ji na záložce Samples, ale jednoduchou úpravou zdrojového kódu ji můžete umístit kam budete chtít.