(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTClipboard;

interface

uses Windows,SysUtils, Messages, Classes, Graphics, Controls,
     Clipbrd, Forms, StdCtrls, ExtCtrls, Menus,AHMStdClass,AHMStandardConst;

type
  TAHMClipFormat         = (fDefault, fEmpty, fUnknown, fText, fBitmap,
                            fMetafile, fOemText, fPicture, fComponent, fIcon);
  TAHMClipboard = class(TScrollBox)
  private
    PrevHwnd : Hwnd;
    FAboutStr : TAHMAboutSControlStr;
    FPaintControl: TComponent;
    FViewFormat: TAHMClipFormat;
    FOnChange: TNotifyEvent;
    function IsEmptyClipboard: Boolean;
    procedure ForwardMessage(var Msg: TMessage);
    procedure WMSize(var Msg: TMessage); message WM_SIZE;
    procedure WMDestroyClipboard(var Msg: TMessage); message WM_DESTROYCLIPBOARD;
    procedure WMChangeCBChain(var Msg: TWMChangeCBChain); message WM_CHANGECBCHAIN;
    procedure WMDrawClipboard(var Msg: TMessage); message WM_DRAWCLIPBOARD;
    procedure SetViewFormat(Value: TAHMClipFormat);
    function GetClipboardFormatNames(Index: Integer): string;
  protected
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure Change; dynamic;
    procedure CreatePaintControl; virtual;
    function GetDrawFormat: TAHMClipFormat; virtual;
    function ValidFormat(Format: TAHMClipFormat): Boolean; dynamic;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create(AOwner: TComponent); override;
    class function CanDrawFormat(ClipboardFormat: Word): Boolean;
    property ClipboardFormat[Index: Integer]: string read GetClipboardFormatNames;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    property ViewFormat: TAHMClipFormat read FViewFormat write SetViewFormat stored False;
    property Color default clWindow;
    property ParentColor default False;
    property OnStartDrag;
  end;
implementation

function ClipboardFormatName(Format: Word): string;
var
  Buffer: array[0..255] of Char;
begin
  case Format of
    CF_BITMAP: Result := ahmrcstdclipbitmap;
    CF_DIB: Result := ahmrcstdclipdibbitmap;
    CF_DIF: Result := ahmrcstdclipdif;
    CF_METAFILEPICT: Result := ahmrcstdclipmeta;
    CF_OEMTEXT: Result := ahmrcstdclipoem;
    CF_PENDATA: Result := ahmrcstdclippen;
    CF_RIFF: Result := ahmrcstdclipriff;
    CF_SYLK: Result := ahmrcstdclipsylk;
    CF_TEXT: Result := ahmrcstdcliptext;
    CF_TIFF: Result := ahmrcstdclipTag;
    CF_WAVE: Result := ahmrcstdclipWave;
    else SetString(Result, Buffer, GetClipboardFormatName(Format, Buffer, 255));
  end;
end;


function ViewToClipboardFormat(Value: TAHMClipFormat): Word;
begin
  Result:=0;
  case Value of
    fDefault, fUnknown, fEmpty: Result := 0;
    fText: Result := CF_TEXT;
    fBitmap: Result := CF_BITMAP;
    fMetafile: Result := CF_METAFILEPICT;
    fOemText: Result := CF_OEMTEXT;
    fPicture: Result := CF_PICTURE;
    fComponent: Result := CF_COMPONENT;
  end;
end;

function ClipboardFormatToView(Value: Word): TAHMClipFormat;
begin
  if Value = CF_TEXT then Result := fText
  else if Value = CF_BITMAP then Result := fBitmap
  else if Value = CF_METAFILEPICT then Result := fMetafile
  else if Value = CF_OEMTEXT then Result := fOemText
  else if Value = CF_PICTURE then Result := fPicture
  else if Value = CF_COMPONENT then Result := fComponent
  else Result := fDefault;
end;

constructor TAHMClipboard.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlState := ControlState + [csCreating];
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,csSetCaption, csDoubleClicks,
                   csDesignInteractive];
  Width := 185;
  Height := 41;
  FPaintControl := nil;
  FViewFormat := fDefault;
  ParentColor := False;
  Color := clWindow;
  Ctl3D := True;
  BorderStyle := bsSingle;
  ControlState := ControlState - [csCreating];
end;

procedure TAHMClipboard.ForwardMessage(var Msg: TMessage);
begin
  with TMessage(Msg) do SendMessage(PrevHWnd, WM_DRAWCLIPBOARD, wParam, lParam);
end;

procedure TAHMClipboard.CreateWnd;
begin
  inherited CreateWnd;
  PrevHwnd := SetClipboardViewer(Handle);
end;

procedure TAHMClipboard.DestroyWnd;
begin
  ChangeClipboardChain(Handle, PrevHwnd);
  inherited DestroyWnd;
end;

Procedure AHMCenterControl(Control: TControl);
var
  X, Y: Integer;
begin
  X := Control.Left;
  Y := Control.Top;
  if Control is TForm then begin
    with Control do begin
      if (TForm(Control).FormStyle = fsMDIChild) and
        (Application.MainForm <> nil) then
      begin
        X := (Application.MainForm.ClientWidth - Width) div 2;
        Y := (Application.MainForm.ClientHeight - Height) div 2;
      end
      else begin
        X := (Screen.Width - Width) div 2;
        Y := (Screen.Height - Height) div 2;
      end;
    end;
  end
  else if Control.Parent <> nil then begin
    with Control do begin
      Parent.HandleNeeded;
      X := (Parent.ClientWidth - Width) div 2;
      Y := (Parent.ClientHeight - Height) div 2;
    end;
  end;
  if X < 0 then X := 0;
  if Y < 0 then Y := 0;
  with Control do SetBounds(X, Y, Width, Height);
end;

procedure TAHMClipboard.CreatePaintControl;
var Format: TAHMClipFormat;
begin
  FPaintControl.Free;
  FPaintControl := nil;
  if IsEmptyClipboard then Exit;
  Format := GetDrawFormat;
  if not ValidFormat(Format) then Format := fUnknown;
  case Format of
    fText, fOemText, fUnknown, fDefault, fEmpty:
    begin
      FPaintControl := TMemo.Create(Self);
      with TMemo(FPaintControl) do
      begin
        BorderStyle := bsNone;
        Parent := Self;
        Left := 0;
        Top := 0;
        ScrollBars := ssBoth;
        Align := alClient;
        if Format = fOemText then Font.Name := ahmrcstdterminalfont;
        Visible := True;
        if Clipboard.HasFormat(CF_TEXT) then PasteFromClipboard
        else if IsEmptyClipboard then Text := ahmrcstdclipboardempty
        else Text := ahmrcstdunknownobject;
        Readonly := True;
      end;
    end;
    fPicture, fMetafile, fBitmap, fIcon:
    begin
      FPaintControl := TImage.Create(Self);
      with TImage(FPaintControl) do
      begin
        Parent := Self;
        AutoSize := True;
        Left := 0;
        Top := 0;
        Visible := True;
        if Format = fPicture then
        begin
          if Clipboard.HasFormat(CF_PICTURE) then Picture.Assign(Clipboard);
        end else if Format = fBitmap then
        begin
          if Clipboard.HasFormat(CF_BITMAP) then Picture.Bitmap.Assign(Clipboard);
        end else if Format = fMetafile then
        begin
          if Clipboard.HasFormat(CF_METAFILEPICT) then Picture.Metafile.Assign(Clipboard);
        end;
      end;
      AHMCenterControl(TImage(FPaintControl));
    end;
    fComponent:
    begin
      FPaintControl := Clipboard.GetComponent(Self, Self);
      if FPaintControl is TControl then
      begin
        with TControl(FPaintControl) do
        begin
          Left := 1;
          Top := 1;
          Parent := Self;
        end;
        AHMCenterControl(TControl(FPaintControl));
      end else
      begin
        FPaintControl.Free;
        FPaintControl := nil;
      end;
    end;
  end;
end;

function TAHMClipboard.GetClipboardFormatNames(Index: Integer): string;
begin
  Result := '';
  if Index < Clipboard.FormatCount then Result := ClipboardFormatName(Clipboard.Formats[Index]);
end;

procedure TAHMClipboard.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TAHMClipboard.WMSize(var Msg: TMessage);
begin
  inherited;
  if (FPaintControl <> nil) and (FPaintControl is TControl) then AHMCenterControl(TControl(FPaintControl));
end;

procedure TAHMClipboard.WMChangeCBChain(VAR Msg: TWMChangeCBChain);
begin
  if PrevHWnd = Msg.Remove then PrevHWnd := Msg.Next;
  if Msg.Remove <> Handle then SendMessage(PrevHWnd, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next);
end;

procedure TAHMClipboard.WMDrawClipboard(var Msg: TMessage);
var Format: Word;
begin
  ForwardMessage(Msg);
  Format := ViewToClipboardFormat(ViewFormat);
  if IsEmptyClipboard then FViewFormat := fEmpty
  else if not Clipboard.HasFormat(Format) then FViewFormat := fDefault;
  Change;
  CreatePaintControl;
  inherited;
end;

procedure TAHMClipboard.WMDestroyClipboard(var Msg: TMessage);
begin
  FViewFormat := fEmpty;
  Change;
  CreatePaintControl;
end;

function TAHMClipboard.IsEmptyClipboard: Boolean;
begin
  Result := (Clipboard.FormatCount = 0);
end;

procedure TAHMClipboard.SetViewFormat(Value: TAHMClipFormat);
var
  Format: Word;
begin
  if Value <> ViewFormat then
  begin
    Format := ViewToClipboardFormat(Value);
    if (Clipboard.HasFormat(Format) and ValidFormat(Value)) then FViewFormat := Value
                                                            else FViewFormat := fDefault;
    CreatePaintControl;
  end;
end;

function TAHMClipboard.GetDrawFormat: TAHMClipFormat;
function DefaultFormat: TAHMClipFormat;
begin
  if Clipboard.HasFormat(CF_TEXT) then Result := fText else
  if Clipboard.HasFormat(CF_OEMTEXT) then Result := fOemText else
  if Clipboard.HasFormat(CF_BITMAP) then Result := fBitmap else
  if Clipboard.HasFormat(CF_METAFILEPICT) then Result := fMetafile else
  if Clipboard.HasFormat(CF_COMPONENT) then Result := fComponent else Result := fUnknown;
end;
begin
  if IsEmptyClipboard then Result := fEmpty else
  begin
    Result := ViewFormat;
    if Result = fDefault then Result := DefaultFormat;
  end;
end;

class function TAHMClipboard.CanDrawFormat(ClipboardFormat: Word): Boolean;
begin
  Result:=ClipboardFormatToView(ClipboardFormat) <> fUnknown;
end;

function TAHMClipboard.ValidFormat(Format: TAHMClipFormat): Boolean;
begin
  Result := (Format in [fDefault, fEmpty, fUnknown]);
  if not Result then
  begin
    if Clipboard.HasFormat(ViewToClipboardFormat(Format)) then
    Result := True;
  end;
end;

end.
