paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-19 09:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL-CustomDrawn: Start implementing clipboard, not working yet

Browse Source 
git-svn-id: trunk@36998 -
This commit is contained in:
sekelsenmat 2012-04-24 08:45:49 +00:00
parent 78412d51f2
commit 3d39574258
9 changed files with 129 additions and 204 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/interfaces/customdrawn/customdrawndefines.inc
View File

@ -76,4 +76,5 @@
{.$define VerboseCDX11WinAPI}
{.$define VerboseCDEvents}
{.$define VerboseCDAccessibility}
{.$define VerboseCDClipboard}

3
lcl/interfaces/customdrawn/customdrawnint.pas
View File

@ -116,6 +116,9 @@ type
private
FTerminating: Boolean;
// Clipboard support
FClipBoardFormats: TStringList;
{$ifdef CD_WINDOWS}
// In win32 it is: The parent of all windows, represents the button of the taskbar
// In wince it is just an invisible window, but retains the following functions:

5
lcl/interfaces/customdrawn/customdrawnobject.inc
View File

@ -127,6 +127,9 @@ begin
FTerminating := False;
DefaultFontSize := 10;
FClipBoardFormats := TStringList.Create;
FClipBoardFormats.Add('foo'); // 0 is reserved
// To be resistent against backend issues
CDWidgetset.ScreenFormat := clfARGB32;
@ -157,6 +160,8 @@ begin
FFontList.Free;
{$endif}
FClipBoardFormats.Free;
CDWidgetSet := nil;
inherited Destroy;
end;

89
lcl/interfaces/customdrawn/customdrawnwinapi.inc
View File

@ -164,38 +164,67 @@ begin
end;
P := Point(APoint.x, APoint.y);
end;
end;
function TQtWidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
begin
Result := Clipboard.FormatToMimeType(FormatID);
end;
function TQtWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean;
begin
Result := Clipboard.Getdata(ClipboardType, FormatID, Stream);
end;
function TQtWidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean;
begin
Result := Clipboard.GetFormats(ClipboardType, Count, List);
end;
function TQtWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean;
begin
Result := Clipboard.GetOwnerShip(ClipboardType, OnRequestProc, FormatCount, Formats);
end;
function TQtWidgetSet.ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat;
begin
Result := Clipboard.RegisterFormat(AMimeType);
end;*)
{------------------------------------------------------------------------------
Method: ClipboardFormatToMimeType
Params: FormatID - a registered format identifier (can't be a predefined format)
Returns: the corresponding mime type as string
------------------------------------------------------------------------------}
function TCDWidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
begin
{$ifdef VerboseCDClipboard}
DebugLn('[TCDWidgetSet.ClipboardFormatToMimeType]');
{$endif}
if FClipBoardFormats.Count > Integer(FormatID) then
Result := FClipBoardFormats[FormatID]
else
Result := '';
end;
function TCDWidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean;
var
i: Integer;
Str: string;
begin
{$ifdef VerboseCDClipboard}
DebugLn('[TCDWidgetSet.GenericClipboardGetFormats]');
{$endif}
Result := False;
Count := 0;
List := nil;
Count := FClipBoardFormats.Count;
GetMem(List, Count * SizeOf(TClipboardFormat));
for i := 0 to Count - 1 do
begin
Str := FClipBoardFormats.Strings[i];
List[i] := ClipboardRegisterFormat(Str);
end;
Result := True;
end;
{------------------------------------------------------------------------------
Method: ClipboardRegisterFormat
Params: AMimeType - a string (usually a MIME type) identifying a new format
type to register
Returns: the registered Format identifier (TClipboardFormat)
------------------------------------------------------------------------------}
function TCDWidgetSet.ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat;
var
Index: Integer;
begin
{$ifdef VerboseCDClipboard}
DebugLn('[TCDWidgetSet.ClipboardRegisterFormat]');
{$endif}
Index := FClipBoardFormats.IndexOf(AMimeType);
if Index < 0 then
Index := FClipBoardFormats.Add(AMimeType);
Result := Index;
end;
{------------------------------------------------------------------------------
Function: CombineRgn

60
lcl/interfaces/customdrawn/customdrawnwinapi_android.inc
View File

@ -166,40 +166,54 @@ begin
end;
P := Point(APoint.x, APoint.y);
end;
end;
end;*)
function TQtWidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
begin
Result := Clipboard.FormatToMimeType(FormatID);
end;
function TQtWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
{------------------------------------------------------------------------------
Method: ClipboardGetData
Params: ClipboardType - clipboard type
FormatID - a registered format identifier (0 is invalid)
Stream - If format is available, it will be appended to this
stream
Returns: true on success
------------------------------------------------------------------------------}
function TCDWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean;
begin
Result := Clipboard.Getdata(ClipboardType, FormatID, Stream);
{$ifdef VerboseCDClipboard}
DebugLn('[TCDWidgetSet.ClipboardGetData]');
{$endif}
Result := False;
end;
function TQtWidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean;
begin
Result := Clipboard.GetFormats(ClipboardType, Count, List);
end;
{------------------------------------------------------------------------------
Method: ClipboardGetOwnerShip
Params: ClipboardType - Type of clipboard, the win32 interface only handles
ctClipBoard
OnRequestProc - TClipboardRequestEvent is defined in LCLType.pp
If OnRequestProc is nil the onwership will end.
FormatCount - number of formats
Formats - array of TClipboardFormat. The supported formats the owner
provides.
function TQtWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
Returns: true on success
Sets the supported formats and requests ownership for the clipboard.
The OnRequestProc is used to get the data from the LCL and to put it on the
clipboard.
If someone else requests the ownership, the OnRequestProc will be executed
with the invalid FormatID 0 to notify the old owner of the lost of ownership.
------------------------------------------------------------------------------}
function TCDWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean;
begin
Result := Clipboard.GetOwnerShip(ClipboardType, OnRequestProc, FormatCount, Formats);
{$ifdef VerboseCDClipboard}
DebugLn('[TCDWidgetSet.ClipboardGetOwnerShip]');
{$endif}
Result := True;
end;
function TQtWidgetSet.ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat;
begin
Result := Clipboard.RegisterFormat(AMimeType);
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: CombineRgn
Params: Dest, Src1, Src2, fnCombineMode
Returns: longint

13
lcl/interfaces/customdrawn/customdrawnwinapi_cocoa.inc
View File

@ -20,6 +20,19 @@
*****************************************************************************
}
function TCDWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean;
begin
Result := False;
end;
function TCDWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean;
begin
Result := False;
end;
//##apiwiz##sps## // Do not remove, no wizard declaration before this line
(*
procedure ColorToRGBFloat(cl: TColorRef; var r,g,b: Single); inline;

130
lcl/interfaces/customdrawn/customdrawnwinapi_win.inc
View File

@ -290,49 +290,7 @@ begin
if not Result then exit;
inc(P.X, ORect.Left);
inc(P.Y, ORect.Top);
end;
{------------------------------------------------------------------------------
Method: ClipboardFormatToMimeType
Params: FormatID - a registered format identifier (can't be a predefined format)
Returns: the corresponding mime type as string
------------------------------------------------------------------------------}
function TWin32WidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat): String;
var
FormatLength: Integer;
begin
case FormatID of
CF_BITMAP, CF_DIB, CF_PALETTE:
Result := PredefinedClipboardMimeTypes[pcfBitmap];
CF_TEXT, CF_UNICODETEXT:
Result := PredefinedClipboardMimeTypes[pcfText];
CF_METAFILEPICT:
Result := 'image/x-wmf';
CF_ENHMETAFILE:
Result := 'image/x-emf';
CF_TIFF:
Result := 'image/tiff';
CF_WAVE:
Result := 'audio/wav';
CF_RIFF:
Result := 'audio/riff';
CF_SYLK:
Result := 'application/x-ms-shortcut';
CF_LOCALE:
Result := 'application/x-ms-locale';
CF_OEMTEXT:
Result := 'application/x-ms-oemtext';
else
SetLength(Result,1000);
FormatLength:= Windows.GetClipboardFormatName(FormatID, PChar(Result), 1000);
if FormatLength = 0 then
raise Exception.CreateFmt('Unknown clipboard format: %d', [FormatID]);
SetLength(Result,FormatLength);
{$IFDEF VerboseWin32Clipbrd}
debugln('TWin32WidgetSet.ClipboardFormatToMimeType FormatID=',dbgs(FormatID),' ',Result);
{$ENDIF}
end;
end;
end;*)
{------------------------------------------------------------------------------
Method: ClipboardGetData
@ -342,7 +300,7 @@ end;
stream
Returns: true on success
------------------------------------------------------------------------------}
function TWin32WidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
function TCDWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): Boolean;
var
DataHandle: HGLOBAL;
@ -352,11 +310,9 @@ var
DbgFormatID: integer;
{$ENDIF}
Bitmap: TBitmap;
{$IFDEF WindowsUnicodeSupport}
BufferStream: TMemoryStream;
BufferWideString: widestring;
BufferString: ansistring;
{$ENDIF}
function ReadClipboardToStream(DestStream: TStream): Boolean;
begin
@ -409,7 +365,6 @@ begin
Bitmap.Free;
Result := true;
end;
{$IFDEF WindowsUnicodeSupport}
{ In the case of unicode text, it's necessary to
convert it from UTF-16 to UTF-8 }
Windows.CF_UNICODETEXT, Windows.CF_TEXT:
@ -447,7 +402,6 @@ begin
BufferStream.Free;
end;
end
{$ENDIF}
else
Result := ReadClipboardToStream(Stream)
end;
@ -456,51 +410,6 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: ClipboardGetFormats
Params: ClipboardType - the type of clipboard operation (GTK only; ignored here)
Count - the number of clipboard formats
List - Pointer to an array of supported formats
(you must free it yourself)
Returns: true on success
------------------------------------------------------------------------------}
function TWin32WidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: Integer; var List: PClipboardFormat): Boolean;
var
FormatID: UINT;
c: integer;
begin
Result := false;
List := nil;
{$IFDEF VerboseWin32Clipbrd}
debugln('TWin32WidgetSet.ClipboardGetData ');
{$ENDIF}
if not Windows.OpenClipboard(HWND(AppHandle)) then begin
{$IFDEF VerboseWin32Clipbrd}
debugln('TWin32WidgetSet.ClipboardGetData OpenClipboard failed');
{$ENDIF}
exit;
end;
Count := CountClipboardFormats;
GetMem(List, Count * SizeOf(TClipboardFormat));
try
c := 0;
FormatID := 0;
repeat
FormatID := EnumClipboardFormats(FormatID);
if (FormatID<>0) then begin
List[c] := FormatID;
inc(c);
end;
until (c>=Count) or (FormatID=0);
Count := c;
finally
Windows.CloseClipboard;
end;
Result := true;
end;
{------------------------------------------------------------------------------
Method: ClipboardGetOwnerShip
Params: ClipboardType - Type of clipboard, the win32 interface only handles
@ -519,7 +428,7 @@ end;
If someone else requests the ownership, the OnRequestProc will be executed
with the invalid FormatID 0 to notify the old owner of the lost of ownership.
------------------------------------------------------------------------------}
function TWin32WidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
function TCDWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: Integer;
Formats: PClipboardFormat): Boolean;
@ -547,10 +456,8 @@ function TWin32WidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
var
DataStream, BufferStream: TStream;
Bitmap: TBitmap;
{$IFDEF WindowsUnicodeSupport}
BufferWideString: widestring;
BufferString: ansistring;
{$ENDIF}
ScreenDC, MemDC: HDC;
OldBitmap, NewBitmap, Mask: HBitmap;
begin
@ -589,7 +496,6 @@ function TWin32WidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
Bitmap.Free;
end;
end;
{$IFDEF WindowsUnicodeSupport}
Windows.CF_UNICODETEXT, Windows.CF_TEXT:
// CF_UNICODETEXT is used by UnicodeEnabledOS, CF_TEXT by others
// we need to convert it from UTF8 to UTF16 or Ansi
@ -613,9 +519,6 @@ function TWin32WidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
end;
WriteStreamToClipBoard(FormatID, BufferStream);
end
{$ELSE}
// no clipboard support without unicode anymore
{$ENDIF}
else
begin
WriteStreamToClipBoard(FormatID, DataStream);
@ -690,32 +593,7 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: ClipboardRegisterFormat
Params: AMimeType - a string (usually a MIME type) identifying a new format
type to register
Returns: the registered Format identifier (TClipboardFormat)
------------------------------------------------------------------------------}
function TWin32WidgetSet.ClipboardRegisterFormat(Const AMimeType: String): TClipboardFormat;
begin
if AMimeType=PredefinedClipboardMimeTypes[pcfText] then
{$IFDEF WindowsUnicodeSupport}
if UnicodeEnabledOS
then Result := Windows.CF_UNICODETEXT
else Result := Windows.CF_TEXT
{$ELSE}
Result := Windows.CF_TEXT
{$ENDIF}
else if (AMimeType=PredefinedClipboardMimeTypes[pcfBitmap]) then
Result := Windows.CF_BITMAP
else
Result := Windows.RegisterClipboardFormat(PChar(AMimeType));
{$IFDEF VerboseWin32Clipbrd}
debugln('TWin32WidgetSet.ClipboardRegisterFormat AMimeType="',AMimeType,'" Result=',dbgs(Result));
{$ENDIF}
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: CombineRgn
Params: Dest, Src1, Src2, fnCombineMode
Returns: longint

28
lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc
View File

@ -166,39 +166,21 @@ begin
end;
P := Point(APoint.x, APoint.y);
end;
end;
end;*)
function TQtWidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
begin
Result := Clipboard.FormatToMimeType(FormatID);
end;
function TQtWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
function TCDWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean;
begin
Result := Clipboard.Getdata(ClipboardType, FormatID, Stream);
Result := False;
end;
function TQtWidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean;
begin
Result := Clipboard.GetFormats(ClipboardType, Count, List);
end;
function TQtWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
function TCDWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean;
begin
Result := Clipboard.GetOwnerShip(ClipboardType, OnRequestProc, FormatCount, Formats);
Result := False;
end;
function TQtWidgetSet.ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat;
begin
Result := Clipboard.RegisterFormat(AMimeType);
end;
{------------------------------------------------------------------------------
Function: CombineRgn
Params: Dest, Src1, Src2, fnCombineMode

4
lcl/interfaces/customdrawn/customdrawnwinapih.inc
View File

@ -41,7 +41,7 @@ function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSr
(*function CallNextHookEx(hHk: HHOOK; ncode : Integer; wParam: WParam; lParam : LParam) : Integer; override;
function CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; wParam: WParam; lParam : lParam) : Integer; override;
function ClientToScreen(Handle: HWND; var P: TPoint) : Boolean; override;
function ClientToScreen(Handle: HWND; var P: TPoint) : Boolean; override;*)
function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; override;
function ClipboardGetData(ClipboardType: TClipboardType;
@ -52,7 +52,7 @@ function ClipboardGetFormats(ClipboardType: TClipboardType;
function ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean; override;
function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; override;*)
function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; override;
function CombineRgn(Dest, Src1, Src2: HRGN; fnCombineMode: Longint): Longint; override;
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; override;