unit UnitFrameClipDisplay;

interface

uses
  Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls,
  Vcl.ExtCtrls, Vcl.StdCtrls, UnitClipQueue, Vcl.Buttons;


type THitTestEvent = procedure (var msg : TWMNCHitTest) of object;

type
  TFrameClipDisplay = class(TFrame)
    pnlDisabler: TPanel;
    imgPic: TImage;
    reText: TRichEdit;
    memText: TMemo;
    procedure FrameMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    private
    { Private declarations }
        fEnabled : boolean;
        fPicStretched : boolean;
        fLastHash : cardinal;
        fFontOverride : boolean;
        fVisibleEmpty : boolean;
        fOnHitTest : THitTestEvent;
        fFirstMouseDown : boolean;
        fOnClick : TNotifyEvent;
//        fLastMouse : TMouseButton;
        fNoRawHTML : boolean;
        fCompactWhitespace : boolean;
        procedure SetEnabled(value : boolean);
        procedure SetPicStretched(value : boolean);
        procedure SetColor(c : TColor);
        procedure SetOnClick(value : TNotifyEvent);
        function GetColor : TColor;
        procedure CheckForEmpty;
    public
    { Public declarations }
        procedure Init;
        procedure OverrideFont(f : TFont);
        procedure ShowClip(ci : TClipItem); overload;
        procedure ShowClip(s : string); overload;

        procedure SetScrollbars(value : TScrollStyle);
        procedure ReportLeave;
        property Enabled : boolean read fEnabled write SetEnabled;
        property PicStretched : boolean read fPicStretched write SetPicStretched;
        property OnHitTest : THitTestEvent read fOnHitTest write fOnHitTest;
        property Color : TColor read GetColor write SetColor;

        property OnClick : TNotifyEvent read fOnClick write SetOnclick;
        property VisibleEmpty : boolean read fVisibleEmpty write fVisibleEmpty;
        property NoRawHTML : boolean read fNoRawHTML write fNoRawHTML;
        property CompaceWhitespace : boolean read fCompactWhitespace write fCompactWhitespace;
  end;

implementation

{$R *.dfm}

uses UnitMisc, Math, UnitKeyboardQuery;

procedure TFrameClipDisplay.Init;
begin
end;
procedure TFrameClipDisplay.ReportLeave;
begin
    self.fFirstMouseDown := false;
end;
procedure TFrameClipDisplay.SetOnClick(value : TNotifyEvent);
begin
    fOnClick := value;
    imgPic.OnClick := value;
end;

procedure TFrameClipDisplay.OverrideFont(f : TFont);
begin
    pnlDisabler.ParentFont := false;
    pnlDisabler.Font := f;
    reText.ParentFont := true;
    memText.ParentFont := true;
    fFontOverride := true;
end;

procedure TFrameClipDisplay.SetEnabled(value : boolean);
begin
    self.pnlDisabler.Enabled := value;
    fEnabled := value;
end;
procedure TFrameClipDisplay.SetPicStretched(value : boolean);
begin
    imgPic.Proportional := true;
    imgPic.Stretch := value;
end;
procedure TFrameClipDisplay.ShowClip(s : string);
begin
    imgPic.visible := false;
    reText.Visible := false;
    memText.Visible := true;
    memtext.Text := s;
    self.CheckForEmpty;
end;
procedure TFrameClipDisplay.ShowClip(ci : TClipItem);
var txt : string;
    pic : TPicture;
    wd,ht : integer;
    iw, ih, iratio : double;
begin
    imgPic.visible := false;
    reText.Visible := false;
    memText.Visible := false;
    if (ci.GetFormat = Windows.CF_DIB) then begin
        imgPic.Visible := true;
        if imgPic.Stretch then begin
            pic := TPicture.Create;

            ci.GetDIB(pic);
            with pic.Bitmap do begin
                imgpic.Canvas.Brush.Color := pnlDisabler.Color;
                imgpic.Canvas.FillRect(imgpic.ClientRect);
                imgPic.Invalidate;
                // scale down using smallest dimension
                // don't scale up
                iw :=  imgPic.Width / pic.width;
                ih :=  imgPic.Height / pic.Height;
                iratio := min(iw, ih);
                if iratio > 1 then iratio := 1.0;
                wd := trunc(pic.Width * iratio);
                ht := trunc(pic.Height * iratio);

                imgPic.Picture.Bitmap.Width := wd;
                imgPic.Picture.Bitmap.height := ht;

                SetStretchBltMode(imgPic.Canvas.Handle, STRETCH_HALFTONE);
                StretchBlt(
                    imgPic.Canvas.Handle,
                    0,0,wd,ht,
                    pic.Bitmap.Canvas.Handle,
                    0,0,pic.Width,pic.Height,
                    SRCCOPY
                );

            end;
            myfree(pic);
        end else begin
            ci.GetDIB(imgPic.Picture);
        end;
    end else if (ci.GetFormat = unitmisc.GetCF_RICHTEXT)
        or (ci.GetFormat = unitmisc.GetCF_HTML) then begin
        if fFontOverride then begin
            reText.Font := pnlDisabler.Font;
        end;

        reText.Visible := true;
        reText.PlainText := false;
        reText.Lines.Clear;

        if ci.HasRichShadow then begin
            ci.GetRichTextShadow(txt);
        end else if ci.GetFormatType = FT_HTML then begin
            if fNoRawHTML then begin
                txt := ci.GetAsPlaintext;
            end else begin
                ci.GetUTF8Text(txt);
            end;
        end else begin
            ci.GetRichText(txt);
        end;
        if txt = '' then begin
            reText.Text  := '[RichText Clip]';
            if ci.GetFormat = unitmisc.GetCF_HTML then
                reText.text := '[HTML Clip]';

        end else begin
            reText.Text := txt;
        end;

        if fFontOverride and FALSE then begin
            reText.SelStart := 0;
            reText.SelLength := length(retext.Text);
            retext.SelAttributes.Size := pnlDisabler.Font.Size;
        end;

    end else begin
        if fFontOverride then begin
            memtext.Font := pnlDisabler.Font;
            memtext.Font.Size := pnlDisabler.font.Size;
        end;

        memText.Visible := true;


        if fCompactWhitespace then begin
            memtext.Text := UnitMisc.CompactWhitespace(ci.GetAsPlaintext);
        end else begin
            memtext.Text := ci.GetAsPlaintext;
        end;

        self.CheckForEmpty;
    end;
end;
procedure TFrameClipDisplay.SetColor(c : TColor);
begin
    pnlDisabler.Color := c;
end;
procedure TFrameClipDisplay.FrameMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    self.BeginDrag(false);
end;

function TFrameClipDisplay.GetColor : TColor;
begin
    result := pnlDisabler.Color;
end;
procedure TFrameClipDisplay.SetScrollbars(value : TScrollStyle);
begin
    memText.ScrollBars := ssVertical;
    reText.ScrollBars := ssVertical;
end;
procedure TFrameClipDisplay.CheckForEmpty;
begin
 if (memtext.Text = '') and fVisibleEmpty then begin
            memtext.Text := '[empty]';
        end;
end;


{procedure TFrameClipDisplay.WMNCHitTest(var msg : TWMNcHitTest);
var isleft, isright : boolean;
begin
    isleft := KeyboardQuery.IsClicked(leftbutton);
    isright := KeyboardQuery.IsClicked(RightButton);
    if isleft or isright then begin
        if not fFirstMouseDown then  begin
            if isleft then begin
                fLastMouse := mbLeft;
            end else begin
                fLastMouse := mbRight;
            end;

            if assigned(self.OnMouseDown) then begin
                OnMouseDown(self, fLastMouse,[],Mouse.CursorPos.X, mouse.CursorPos.Y);
            end;
        end;
        fFirstMouseDown := true;
    end else begin
        if fFirstMouseDown then begin
            fFirstMouseDown := false;
            if assigned(self.OnMouseUp) then begin
                OnMouseUp(self, fLastMouse,[],Mouse.CursorPos.X, mouse.CursorPos.Y);
            end;
        end;
    end;
end;}

end.
