⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 clipview.pas

📁 rxlib2.75控件包
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  if ShowSelector then begin
    Canvas.Brush.Color := Self.Color;
    Canvas.Pen.Color := Self.Color;
    InflateRect(CellRect, -1, -1);
    Canvas.DrawFocusRect(CellRect);
  end;
end;

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

procedure TPaletteGrid.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 TPaletteGrid.WMSize(var Message: TWMSize);
begin
  inherited;
  UpdateSize;
end;

{ TCustomClipboardViewer }

constructor TCustomClipboardViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlState := ControlState + [csCreating];
{$IFNDEF WIN32}
  ControlStyle := ControlStyle + [csFramed];
{$ENDIF}
  FWndNext := 0;
  FPaintControl := nil;
  FViewFormat := cvDefault;
  ParentColor := False;
  Color := clWindow;
  ControlState := ControlState - [csCreating];
end;

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

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

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

procedure TCustomClipboardViewer.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 := LoadStr(SClipbrdEmpty)
          else Text := LoadStr(SClipbrdUnknown);
          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))
            {$IFDEF WIN32} or Clipboard.HasFormat(CF_ENHMETAFILE) {$ENDIF WIN32})
            or ((Format = cvPicture) and Clipboard.HasFormat(CF_PICTURE)) then
          begin
            Picture.Assign(Clipboard);
          end;
        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 := TPaletteGrid.Create(Self);
        with TPaletteGrid(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 TCustomClipboardViewer.GetClipboardFormatNames(Index: Integer): string;
begin
  Result := '';
  if Index < Clipboard.FormatCount then
    Result := ClipboardFormatName(Clipboard.Formats[Index]);
end;

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

procedure TCustomClipboardViewer.WMSize(var Message: TMessage);
begin
  inherited;
  if (FPaintControl <> nil) and (FPaintControl is TControl) then
    CenterControl(TControl(FPaintControl));
end;

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

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

procedure TCustomClipboardViewer.WMDrawClipboard(var Message: TMessage);
var
  Format: Word;
begin
  ForwardMessage(Message);
  Format := ViewToClipboardFormat(ViewFormat);
  if IsEmptyClipboard then FViewFormat := cvEmpty
  else if not Clipboard.HasFormat(Format) then FViewFormat := cvDefault;
  Change;
  DisableAlign;
  try
    CreatePaintControl;
  finally
    EnableAlign;
  end;
  inherited;
end;

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

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

procedure TCustomClipboardViewer.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 TCustomClipboardViewer.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))
{$IFDEF WIN32}
      or (Clipboard.HasFormat(CF_ENHMETAFILE))
{$ENDIF}
      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 TCustomClipboardViewer.CanDrawFormat(ClipboardFormat: Word): Boolean;
begin
  Result := ClipboardFormatToView(ClipboardFormat) <> cvUnknown;
end;

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

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -