paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 11:56:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

Opkman: VST support for Cocoa.

Browse Source 
git-svn-id: trunk@55937 -
This commit is contained in:
balazs 2017-09-28 05:44:46 +00:00
parent ac938407f0
commit fdde5e54a3
12 changed files with 1871 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
.gitattributes vendored
View File

@ -3497,6 +3497,10 @@ components/onlinepackagemanager/vst/include/carbon/opkman_delphicompat.inc svneo
components/onlinepackagemanager/vst/include/carbon/opkman_lclext.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/carbon/opkman_uses.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/carbon/opkman_uses_lclext.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/cocoa/opkman_delphicompat.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/cocoa/opkman_lclext.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/cocoa/opkman_uses.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/cocoa/opkman_uses_lclext.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/generic/opkman_independentfunctions.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/generic/opkman_stubs.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/generic/opkman_timerfunctions.inc svneol=native#text/plain
@ -3512,6 +3516,9 @@ components/onlinepackagemanager/vst/include/gtk2/opkman_uses_lclext.inc svneol=n
components/onlinepackagemanager/vst/include/intf/carbon/opkman_olemethods.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/intf/carbon/opkman_vtgraphicsi.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/intf/carbon/opkman_vtvdragmanager.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/intf/cocoa/opkman_olemethods.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/intf/cocoa/opkman_vtgraphicsi.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/intf/cocoa/opkman_vtvdragmanager.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/intf/gtk/opkman_olemethods.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/intf/gtk/opkman_vtgraphicsi.inc svneol=native#text/plain
components/onlinepackagemanager/vst/include/intf/gtk/opkman_vtvdragmanager.inc svneol=native#text/plain
@ -3561,6 +3568,10 @@ components/onlinepackagemanager/vst/units/carbon/opkman_fakeactivex.pas svneol=n
components/onlinepackagemanager/vst/units/carbon/opkman_fakemmsystem.pas svneol=native#text/pascal
components/onlinepackagemanager/vst/units/carbon/opkman_virtualdragmanager.pas svneol=native#text/pascal
components/onlinepackagemanager/vst/units/carbon/opkman_virtualpanningwindow.pas svneol=native#text/pascal
components/onlinepackagemanager/vst/units/cocoa/opkman_fakeactivex.pas svneol=native#text/pascal
components/onlinepackagemanager/vst/units/cocoa/opkman_fakemmsystem.pas svneol=native#text/pascal
components/onlinepackagemanager/vst/units/cocoa/opkman_virtualdragmanager.pas svneol=native#text/pascal
components/onlinepackagemanager/vst/units/cocoa/opkman_virtualpanningwindow.pas svneol=native#text/pascal
components/onlinepackagemanager/vst/units/gtk/opkman_fakeactivex.pas svneol=native#text/pascal
components/onlinepackagemanager/vst/units/gtk/opkman_fakemmsystem.pas svneol=native#text/pascal
components/onlinepackagemanager/vst/units/gtk/opkman_virtualdragmanager.pas svneol=native#text/pascal

84
components/onlinepackagemanager/vst/include/cocoa/opkman_delphicompat.inc Normal file
View File

@ -0,0 +1,84 @@
{
Cocoa Interface
Dummy implementation. Not tested.
}
type
TTimerList = class
end;
var
FTimerList: TTimerList;
function CF_UNICODETEXT: TClipboardFormat;
begin
//todo
Result := TClipboardFormat(0);
end;
{
Only a few functions are necessary to compile VirtualTreeView:
BitBlt
GetCurrentObject
Set/KillTimer (Look at Qt/Gtk implementation)
}
{$define HAS_GETCURRENTOBJECT}
{.$define HAS_MAPMODEFUNCTIONS}
{.$define HAS_GETTEXTEXTENTEXPOINT}
{.$define HAS_GETDOUBLECLICKTIME}
{.$define HAS_GETTEXTALIGN}
{.$define HAS_GETWINDOWDC}
{.$define HAS_INVERTRECT}
{.$define HAS_OFFSETRGN}
{.$define HAS_REDRAWWINDOW}
{.$define HAS_SCROLLWINDOW}
{.$define HAS_SETBRUSHORGEX}
{$i ../generic/opkman_stubs.inc}
{$i ../generic/opkman_independentfunctions.inc}
{$i ../generic/opkman_unicodefunctions.inc}
function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
YSrc: Integer; Rop: DWORD): Boolean;
begin
Result := StretchMaskBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc,
Width, Height, 0, 0, 0, Rop);
end;
function GetCurrentObject(hdc: HDC; uObjectType: UINT): HGDIOBJ;
var
CocoaContext: TCocoaContext absolute hdc;
CurrentBrush: TCocoaBrush;
CurrentFont: TCocoaFont;
CurrentPen: TCocoaPen;
begin
Result := 0;
with CocoaContext do
begin
case uObjectType of
OBJ_BITMAP:
begin
if CocoaContext is TCocoaBitmapContext then
Result := HGDIOBJ(TCocoaBitmapContext(CocoaContext).Bitmap);
end;
OBJ_BRUSH: Result := HGDIOBJ(CurrentBrush);
OBJ_FONT: Result := HGDIOBJ(CurrentFont);
OBJ_PEN: Result := HGDIOBJ(CurrentPen);
end;
end;
end;
function KillTimer(hWnd: THandle; nIDEvent: UINT_PTR):Boolean;
begin
Result := LCLIntf.KillTimer(hWnd, nIDEvent);
end;
function SetTimer(hWnd: THandle; nIDEvent: UINT_PTR; uElapse: LongWord; lpTimerFunc: TTimerNotify): UINT_PTR;
begin
Result := LCLIntf.SetTimer(hWnd, nIDEvent, uElapse, nil{lpTimerFunc});
end;

24
components/onlinepackagemanager/vst/include/cocoa/opkman_lclext.inc Normal file
View File

@ -0,0 +1,24 @@
function CreateBitmapMask(BitmapDC: HDC; Width, Height: Integer; TransparentColor: TColor): HBITMAP;
begin
//todo
Result := 0;
end;
function DirectMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP): Boolean;
begin
//todo: see if is possible todo it faster
Result := StretchMaskBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, Height,
Mask, 0, 0, SRCCOPY);
end;
function OptimalPixelFormat: TPixelFormat;
begin
Result := pfDevice;
end;
function OSSupportsUTF16: Boolean;
begin
Result := False;
end;

1
components/onlinepackagemanager/vst/include/cocoa/opkman_uses.inc Normal file
View File

@ -0,0 +1 @@
InterfaceBase, LCLIntf, Graphics, CocoaInt, CocoaGDIObjects, Math,

2
components/onlinepackagemanager/vst/include/cocoa/opkman_uses_lclext.inc Normal file
View File

@ -0,0 +1,2 @@
uses
LclIntf;

2
components/onlinepackagemanager/vst/include/intf/cocoa/opkman_olemethods.inc Normal file
View File

@ -0,0 +1,2 @@
{$i ../opkman_dummyolemethods.inc}

23
components/onlinepackagemanager/vst/include/intf/cocoa/opkman_vtgraphicsi.inc Normal file
View File

@ -0,0 +1,23 @@
//todo: properly implement
procedure AlphaBlend(Source, Destination: HDC; const R: TRect; const Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer);
begin
case Mode of
bmConstantAlpha,
bmPerPixelAlpha,
bmMasterAlpha,
bmConstantAlphaAndColor:
begin
BitBlt(Destination, Target.X, Target.Y, R.Right - R.Left, R.Bottom - R.Top, Source, R.Left, R.Right, SRCCOPY);
end;
end;
end;
function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer;
begin
Result := nil;
end;
function GetBitmapBitsFromBitmap(Bitmap: HBITMAP): Pointer;
begin
Result := nil;
end;

2
components/onlinepackagemanager/vst/include/intf/cocoa/opkman_vtvdragmanager.inc Normal file
View File

@ -0,0 +1,2 @@
{$i ../opkman_dummydragmanager.inc}

3
components/onlinepackagemanager/vst/units/cocoa/opkman_fakeactivex.pas Normal file
View File

@ -0,0 +1,3 @@
unit opkman_FakeActiveX;
{$i ../opkman_dummyactivex.inc}

38
components/onlinepackagemanager/vst/units/cocoa/opkman_fakemmsystem.pas Normal file
View File

@ -0,0 +1,38 @@
unit opkman_fakemmsystem;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Types;
function timeBeginPeriod(x1: DWord): DWord;
function timeEndPeriod(x1: DWord): DWord;
function timeGetTime: DWORD;
implementation
function timeBeginPeriod(x1: DWord): DWord;
begin
end;
function timeEndPeriod(x1: DWord): DWord;
begin
end;
function timeGetTime: DWORD;
var
ATime: TSystemTime;
begin
//todo: properly implement
GetLocalTime(ATime);
Result := ATime.MilliSecond;
end;
end.

1623
components/onlinepackagemanager/vst/units/cocoa/opkman_virtualdragmanager.pas Normal file
View File

File diff suppressed because it is too large Load Diff

58
components/onlinepackagemanager/vst/units/cocoa/opkman_virtualpanningwindow.pas Normal file
View File

@ -0,0 +1,58 @@
unit opkman_virtualpanningwindow;
{$mode objfpc}{$H+}
interface
uses
LCLType, Graphics, Classes, SysUtils;
type
{ TVirtualPanningWindow }
TVirtualPanningWindow = class
private
FHandle: THandle;
FOwnerHandle: THandle;
FImage: TBitmap;
procedure HandlePaintMessage;
public
procedure Start(OwnerHandle: THandle; const Position: TPoint);
procedure Stop;
procedure Show(ClipRegion: HRGN);
property Image: TBitmap read FImage;
property Handle: THandle read FHandle;
end;
implementation
{$ifdef DEBUG_VTV}
uses
opkman_vtlogger;
{$endif}
{ TVirtualPanningWindow }
procedure TVirtualPanningWindow.HandlePaintMessage;
begin
end;
procedure TVirtualPanningWindow.Start(OwnerHandle: THandle; const Position: TPoint);
begin
FImage := TBitmap.Create;
end;
procedure TVirtualPanningWindow.Stop;
begin
FImage.Free;
FImage := nil;
end;
procedure TVirtualPanningWindow.Show(ClipRegion: HRGN);
begin
{$ifdef DEBUG_VTV}Logger.SendBitmap([lcPanning],'Panning Image',FImage);{$endif}
end;
end.