jvclipboardviewer.pas

East make Tray Icon in delphi

  end;
end;

function TJvPaletteGrid.SelectCell(ACol, ARow: Longint): Boolean;
begin
  Result := ((ACol = 0) and (ARow = 0)) or (CellColor(ACol, ARow) <> clNone);
end;

procedure TJvPaletteGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  AState: TGridDrawState);
var
  Color: TColor;
begin
  Color := CellColor(ACol, ARow);
  if Color <> clNone then
    DrawSquare(PaletteColor(Color), ARect, gdFocused in AState)
  else
  begin
    Canvas.Brush.Color := Self.Color;
    Canvas.FillRect(ARect);
  end;
end;

procedure TJvPaletteGrid.Resize;
begin
  inherited Resize;
  UpdateSize;
end;

//=== { TJvCustomClipboardViewer } ===========================================

constructor TJvCustomClipboardViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlState := ControlState + [csCreating];
  FWndNext := 0;
  FPaintControl := nil;
  FViewFormat := cvDefault;
  ParentColor := False;
  Color := clWindow;
  ControlState := ControlState - [csCreating];
end;

procedure TJvCustomClipboardViewer.ForwardMessage(var Msg: TMessage);
begin
  if FWndNext <> 0 then
    with Msg do
      SendMessage(FWndNext, Msg, WParam, LParam);
end;

procedure TJvCustomClipboardViewer.CreateWnd;
begin
  inherited CreateWnd;
  if Handle <> 0 then
  begin
    FWndNext := SetClipboardViewer(Handle);
    FChained := True;
  end;
end;

procedure TJvCustomClipboardViewer.DestroyWindowHandle;
begin
  if FChained then
  begin
    ChangeClipboardChain(Handle, FWndNext);
    FChained := False;
  end;
  FWndNext := 0;
  inherited DestroyWindowHandle;
end;

procedure TJvCustomClipboardViewer.CreatePaintControl;
var
  Icon: TIcon;
  Format: TClipboardViewFormat;
  Instance: TComponent;
begin
  if csDesigning in ComponentState then
    Exit;
  FPaintControl.Free;
  FPaintControl := nil;
  if IsEmptyClipboard then
    Exit;
  Format := GetDrawFormat;
  if not ValidFormat(Format) then
    Format := cvUnknown;
  case Format of
    cvText, cvOemText, cvUnknown, cvDefault, cvEmpty:
      begin
        FPaintControl := TMemo.Create(Self);
        with TMemo(FPaintControl) do
        begin
          BorderStyle := bsNone;
          Parent := Self;
          Left := 0;
          Top := 0;
          ScrollBars := ssBoth;
          Align := alClient;
          if Format = cvOemText then
          begin
            ParentFont := False;
            Font.Name := 'Terminal';
          end;
          Visible := True;
          if Clipboard.HasFormat(CF_TEXT) then
            PasteFromClipboard
          else
          if (Format = cvText) and Clipboard.HasFormat(CF_COMPONENT) then
          begin
            Instance := Clipboard.GetComponent(Self, Self);
            try
              ComponentToStrings(Instance, Lines);
            finally
              Instance.Free;
            end;
          end
          else
          if IsEmptyClipboard then
            Text := RsClipboardEmpty
          else
            Text := RsClipboardUnknown;
          ReadOnly := True;
        end;
      end;
    cvPicture, cvMetafile, cvBitmap, cvIcon:
      begin
        FPaintControl := TImage.Create(Self);
        with TImage(FPaintControl) do
        begin
          Parent := Self;
          AutoSize := True;
          Left := 0;
          Top := 0;
          Visible := True;
          if Format = cvIcon then
          begin
            if Clipboard.HasFormat(CF_ICON) then
            begin
              Icon := CreateIconFromClipboard;
              try
                Picture.Icon := Icon;
              finally
                Icon.Free;
              end;
            end;
          end
          else
          if ((Format = cvBitmap) and Clipboard.HasFormat(CF_BITMAP)) or
            ((Format = cvMetafile) and (Clipboard.HasFormat(CF_METAFILEPICT)) or
            Clipboard.HasFormat(CF_ENHMETAFILE)) or
            ((Format = cvPicture) and Clipboard.HasFormat(CF_PICTURE)) then
            Picture.Assign(Clipboard);
        end;
        CenterControl(TImage(FPaintControl));
      end;
    cvComponent:
      begin
        Instance := Clipboard.GetComponent(Self, Self);
        FPaintControl := Instance;
        if FPaintControl is TControl then
        begin
          with TControl(FPaintControl) do
          begin
            Left := 1;
            Top := 1;
            Parent := Self;
          end;
          CenterControl(TControl(FPaintControl));
        end
        else
        begin
          FPaintControl := TMemo.Create(Self);
          try
            with TMemo(FPaintControl) do
            begin
              BorderStyle := bsNone;
              Parent := Self;
              Left := 0;
              Top := 0;
              ScrollBars := ssBoth;
              Align := alClient;
              ReadOnly := True;
              ComponentToStrings(Instance, Lines);
              Visible := True;
            end;
          finally
            Instance.Free;
          end;
        end;
      end;
    cvPalette:
      begin
        FPaintControl := TJvPaletteGrid.Create(Self);
        with TJvPaletteGrid(FPaintControl) do
        try
          BorderStyle := bsNone;
          Parent := Self;
          Ctl3D := False;
          Align := alClient;
          Clipboard.Open;
          try
            Palette := GetClipboardData(CF_PALETTE);
          finally
            Clipboard.Close;
          end;
        except
          FPaintControl.Free;
          raise;
        end;
      end;
  end;
end;

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

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

procedure TJvCustomClipboardViewer.Loaded;
begin
  inherited Loaded;
  Resize; // Resize is not called while csLoading in ComponentState
end;

procedure TJvCustomClipboardViewer.Resize;
begin
  inherited Resize;
  if (FPaintControl <> nil) and (FPaintControl is TControl) then
    CenterControl(TControl(FPaintControl));
end;

procedure TJvCustomClipboardViewer.WMChangeCBChain(var Msg: TWMChangeCBChain);
begin
  if Msg.Remove = FWndNext then
    FWndNext := Msg.Next
  else
    ForwardMessage(TMessage(Msg));
  inherited;
end;

procedure TJvCustomClipboardViewer.WMNCDestroy(var Msg: TWMNCDestroy);
begin
  if FChained then
  begin
    ChangeClipboardChain(Handle, FWndNext);
    FChained := False;
    FWndNext := 0;
  end;
  inherited;
end;

procedure TJvCustomClipboardViewer.WMDrawClipboard(var Msg: TMessage);
var
  Format: Word;
  B: TBitmap;
begin
  ForwardMessage(Msg);
  Format := ViewToClipboardFormat(ViewFormat);
  if IsEmptyClipboard then
    FViewFormat := cvEmpty
  else
  if not Clipboard.HasFormat(Format) then
    FViewFormat := cvDefault;
  if Clipboard.HasFormat(CF_BITMAP) then
  begin
    B := TBitmap.Create;
    try
      B.Assign(Clipboard);
      DoImage(B);
    finally
      B.Free;
    end;
  end;
  if Clipboard.HasFormat(CF_TEXT) then
    DoText(Clipboard.AsText);
  Change;
  DisableAlign;
  try
    CreatePaintControl;
  finally
    EnableAlign;
  end;
  inherited;
end;

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

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

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

function TJvCustomClipboardViewer.GetDrawFormat: TClipboardViewFormat;

  function DefaultFormat: TClipboardViewFormat;
  begin
    if Clipboard.HasFormat(CF_TEXT) then
      Result := cvText
    else
    if Clipboard.HasFormat(CF_OEMTEXT) then
      Result := cvOemText
    else
    if Clipboard.HasFormat(CF_BITMAP) then
      Result := cvBitmap
    else
    if Clipboard.HasFormat(CF_METAFILEPICT) then
      Result := cvMetafile
    else
    if Clipboard.HasFormat(CF_ENHMETAFILE) then
      Result := cvMetafile
    else
    if Clipboard.HasFormat(CF_ICON) then
      Result := cvIcon
    else
    if Clipboard.HasFormat(CF_PICTURE) then
      Result := cvPicture
    else
    if Clipboard.HasFormat(CF_COMPONENT) then
      Result := cvComponent
    else
    if Clipboard.HasFormat(CF_PALETTE) then
      Result := cvPalette
    else
      Result := cvUnknown;
  end;

begin
  if IsEmptyClipboard then
    Result := cvEmpty
  else
  begin
    Result := ViewFormat;
    if Result = cvDefault then
      Result := DefaultFormat;
  end;
end;

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

function TJvCustomClipboardViewer.ValidFormat(Format: TClipboardViewFormat): Boolean;
begin
  Result := (Format in [cvDefault, cvEmpty, cvUnknown]);
  if not Result then
    if Clipboard.HasFormat(ViewToClipboardFormat(Format)) then
      Result := True;
end;

procedure TJvCustomClipboardViewer.DoImage(Image: TBitmap);
begin
  if Assigned(FOnImage) then
    FOnImage(Self, Image);
end;

procedure TJvCustomClipboardViewer.DoText(const AText: string);
begin
  if Assigned(FOnText) then
    FOnText(Self, AText);
end;

procedure TJvCustomClipboardViewer.EmptyClipboard;
begin
  OpenClipboard(Application.Handle);
  // (rom) added Windows. to avoid recursion
  Windows.EmptyClipboard;
  CloseClipboard;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.