paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-25 07:17:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

Fixes the misterious non-windowed control dancing in customdrawnws (implementing Save/RestoreDC was the fix), advances the regions support and starts trayicon implementation in customdrawnws (doesnt work yet)

Browse Source 
git-svn-id: trunk@34378 -
This commit is contained in:
sekelsenmat 2011-12-24 10:06:18 +00:00
parent 9c630b6274
commit 21e55aba98
17 changed files with 1061 additions and 470 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -5468,6 +5468,10 @@ lcl/interfaces/customdrawn/customdrawnobject_win.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnobject_x11.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnprivate.pas svneol=native#text/plain
lcl/interfaces/customdrawn/customdrawnproc.pas svneol=native#text/plain
lcl/interfaces/customdrawn/customdrawntrayicon_android.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawntrayicon_cocoa.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawntrayicon_win.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawntrayicon_x11.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwinapi.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwinapi_android.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwinapi_cocoa.inc svneol=native#text/pascal

6
lcl/interfaces/customdrawn/customdrawnproc.pas
View File

@ -384,7 +384,7 @@ begin
ACanvas.Brush.FPColor := TColorToFPColor(ColorToRGB(clForm));
ACanvas.Pen.FPColor := TColorToFPColor(ColorToRGB(clForm));
ACanvas.Rectangle(0, 0, AImage.Width, AImage.Height);
ACanvas.RestoreState;
ACanvas.RestoreState(-1);
end;
// This does not render the win control itself, only it's children
@ -461,7 +461,7 @@ begin
ACanvas.Brush.FPColor := TColorToFPColor((lWinControl as TCustomPanel).GetRGBColorResolvingParent());
ACanvas.Pen.FPColor := ACanvas.Brush.FPColor;
ACanvas.Rectangle(Bounds(0, 0, lWinControl.Width, lWinControl.Height));
ACanvas.RestoreState;
ACanvas.RestoreState(-1);
end;
// Send the drawing message
@ -474,7 +474,7 @@ begin
{$endif}
// Now restore it
ACanvas.RestoreState;
ACanvas.RestoreState(-1);
Result := True;
end;

33
lcl/interfaces/customdrawn/customdrawntrayicon_android.inc Normal file
View File

@ -0,0 +1,33 @@
{%mainunit carbonwsextctrls.pas}
class function TCDWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
end;
class function TCDWSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
// Result := True;
end;
{*******************************************************************
* TCDWSCustomTrayIcon.InternalUpdate ()
*
* DESCRIPTION: Makes modifications to the Icon while running
* i.e. without hiding it and showing again
*******************************************************************}
class procedure TCDWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
begin
end;
class function TCDWSCustomTrayIcon.ShowBalloonHint(
const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
end;
class function TCDWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint;
begin
Result := Point(0, 0);
end;

553
lcl/interfaces/customdrawn/customdrawntrayicon_cocoa.inc Normal file
View File

@ -0,0 +1,553 @@
{%mainunit carbonwsextctrls.pas}
type
{ TCDCocoaTrayIcon }
TCDCocoaTrayIcon = objcclass(NSObject)
public
{ Fields }
LCLTrayIcon: TCustomTrayIcon;
bar: NSStatusBar;
item: NSStatusItem;
WSBitmap: TCocoaBitmap;//image: NSImage;
menu: NSMenu;
EmptyMenuTitle: CFStringRef;
(* // The following lists store the items and are used
// to be able to release them in ReleaseMenu
//
// SubMenuOwners: Holds all internal owners of the submenus
// SubMenuItems: Holds all items in submenus
SubMenuOwners: array of NSMenu;
SubMenuItems: array of NSMenuItem;
SubMenuImages: array of NSImage;
{ Structural Methods }
constructor Create; override;
destructor Destroy; override;
class function getClass: lobjc.id; override;
procedure AddMethods; override;
{ Pascal Methods }
function TrimAllChar(const S: string; const ch: Char): string;
function CreateMenu(APopUpMenu: TPopUpMenu): NSMenu;
function RecursiveCreateMenuItems(AMenuItem: TMenuItem;
ACallbackName: string; ACallbackClass: NSObject): NSMenuItem;
function CreateMenuItem(AMenuItem: TMenuItem;
ACallbackName: string; ACallbackClass: NSObject): NSMenuItem;
procedure ReleaseMenu();
procedure RemoveIcon();*)
function ConvertTIconToWSBitmap(AIcon: TIcon): TCocoaBitmap; message 'converticon:';
function ConvertTBitmapToWSBitmap(ABitmap: TBitmap): TCocoaBitmap; message 'convertbitmap:';
(* function IsMenuVisible: Boolean;
{ Objective-C compatible methods }
class procedure HandleMenuItemClick(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static;
class procedure HandleMenuWillOpen(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static;
class procedure HandleMenuDidClose(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static;*)
end;
(*const
Str_TPrivateCocoaCarbonTrayIcon = 'TTrayIcon';
Str_HandleMenuItemClick = 'HandleMenuItemClick';
Str_HandleMenuWillOpen = 'menuWillOpen:';
Str_HandleMenuDidClose = 'menuDidClose:';
{ TPrivateCocoaCarbonTrayIcon }
{@@
Adds methods to the class
Details of the parameters string:
The first parameter is the result (v = void),
followed by self and _cmd (@ = id and : = SEL),
and on the end "sender" (@ = id)
}
procedure TPrivateCocoaCarbonTrayIcon.AddMethods;
begin
AddMethod(Str_HandleMenuItemClick, 'v@:@', Pointer(HandleMenuItemClick));
AddMethod(Str_HandleMenuWillOpen, 'v@:@', Pointer(HandleMenuWillOpen));
AddMethod(Str_HandleMenuDidClose, 'v@:@', Pointer(HandleMenuDidClose));
end;
constructor TPrivateCocoaCarbonTrayIcon.Create;
begin
{ The class is registered on the Objective-C runtime before the NSObject constructor is called }
// The original plan was to create a descendent class, but causes wierd crashes
// so now we just stuck our method into NSObject
// if not CreateClassDefinition(Str_TPrivateCocoaCarbonTrayIcon, Str_NSObject) then WriteLn('Failed to create lobjc class');
EmptyMenuTitle := CFStringCreateWithPascalString(nil, '', kCFStringEncodingUTF8);
inherited Create;
end;
destructor TPrivateCocoaCarbonTrayIcon.Destroy;
begin
CFRelease(EmptyMenuTitle);
RemoveIcon();
ReleaseMenu();
if item <> nil then
begin
item.setImage(nil);
item.Free;
item := nil;
end;
if image <> nil then
begin
image.Free;
image := nil;
end;
inherited Destroy;
end;
class function TPrivateCocoaCarbonTrayIcon.getClass: lobjc.id;
begin
Result := objc_getClass({Str_TPrivateCocoaCarbonTrayIcon} Str_NSObject);
end;
{Removes/replaces all occurences of a character from a string}
function TPrivateCocoaCarbonTrayIcon.TrimAllChar(const S: string; const ch: Char): string;
var
buf: string;
begin
buf := S;
Result := '';
{while Pos finds a blank}
while (Pos(ch, buf) > 0) do
begin
{copy the substrings before the blank in to Result}
Result := Result + Copy(buf, 1, Pos(ch, buf) - 1);
buf := Copy(buf, Pos(ch, buf) + 1, Length(buf) - Pos(ch, buf));
end;
{There will still be a remainder in buf, so copy remainder into Result}
Result := Result + buf;
end;
{ Creates a NSMenu structure representing a TPopUpMenu }
function TPrivateCocoaCarbonTrayIcon.CreateMenu(APopUpMenu: TPopUpMenu): NSMenu;
var
i: Integer;
Item: NSMenuItem;
begin
Result := NSMenu.initWithTitle(EmptyMenuTitle);
// Result.setVersion(0);
Result.setDelegate(Self.Handle);
Result.setAutoenablesItems(LongBool(NO)); // For menu enabling/disabling
for i := 0 to APopUpMenu.Items.Count - 1 do
begin
{ If the submenu has a submenu it needs special treatment }
if APopUpMenu.Items[i].Count > 0 then
Item := RecursiveCreateMenuItems(APopUpMenu.Items[i], Str_HandleMenuItemClick, Self)
else
Item := CreateMenuItem(APopUpMenu.Items[i], Str_HandleMenuItemClick, Self);
if item <> nil then
Result.addItem(Item.Handle);
end;
end;
function TPrivateCocoaCarbonTrayIcon.RecursiveCreateMenuItems(
AMenuItem: TMenuItem; ACallbackName: string; ACallbackClass: NSObject): NSMenuItem;
var
j, subindex: Integer;
InternalOwner: NSMenu;
SubItem: NSMenuItem;
begin
// First create the menu
Result := CreateMenuItem(AMenuItem, Str_HandleMenuItemClick, Self);
// Then a owner for the children
InternalOwner := NSMenu.initWithTitle(EmptyMenuTitle);
InternalOwner.setAutoenablesItems(LongBool(NO)); // For menu enabling/disabling
subindex := Length(SubMenuOwners);
SetLength(SubMenuOwners, subindex + 1);
SubMenuOwners[subindex] := InternalOwner;
{ Add all submenus in this submenu }
for j := 0 to AMenuItem.Count - 1 do
begin
if AMenuItem.Items[j].Count > 0 then
SubItem := RecursiveCreateMenuItems(AMenuItem.Items[j], Str_HandleMenuItemClick, Self)
else
SubItem := CreateMenuItem(AMenuItem.Items[j], Str_HandleMenuItemClick, Self);
if SubItem <> nil then
InternalOwner.addItem(SubItem.Handle);
end;
// And set the submenu to the item
Result.setSubmenu(InternalOwner.Handle);
end;
function TPrivateCocoaCarbonTrayIcon.CreateMenuItem(AMenuItem: TMenuItem;
ACallbackName: string; ACallbackClass: NSObject): NSMenuItem;
var
ItemText: CFStringRef;
KeyText: CFStringRef;
subitemindex: Integer;
subimageindex: Integer;
AImage: NSImage;
StrBuffer: string;
// Default property implementation (=bold)
FontManager: NSFontManager;
AttrString: NSAttributedString;
AttrStringFont: NSFont;
AttrDictionary: NSDictionary;
begin
Result := nil;
{ Check visibility, invisible menus are implemented by not adding them at all,
because NSMenuItem.setHidden was only added in Mac OS X 10.5 }
if not AMenuItem.Visible then Exit;
{ The MenuItem is a separator }
if AMenuItem.Caption = '-' then
begin
Result := NSMenuItem.separatorItem();
end
{ A normal menu item }
else
begin
{ While creating the menus we ignore the & shortcut identifiers }
StrBuffer := TrimAllChar(AMenuItem.Caption, '&');
KeyText := CFStringCreateWithPascalString(nil, '', kCFStringEncodingUTF8);
ItemText := CFStringCreateWithPascalString(nil, StrBuffer, kCFStringEncodingUTF8);
{$ifdef VerboseCarbonTrayIcon}
WriteLn(' ItemText: ', IntToHex(Int64(ItemText), 8), ' ATitle: ', AMenuItem.Caption);
{$endif}
Result := NSMenuItem.initWithTitle_action_keyEquivalent(ItemText, nil, KeyText);
{ Assign the OnClick event handler }
Result.setTarget(ACallbackClass.Handle);
Result.setAction(sel_registerName(PChar(ACallbackName)));
{ Assign the checked state }
if AMenuItem.Checked then Result.setState(NSOnState)
else Result.setState(NSOffState);
{ Assign default (=bold) state }
if AMenuItem.Default then
begin
FontManager := NSFontManager.sharedFontManager;
// For now hard-code the menu font to 14, because the default size
// is 13, which is wrong, and looks bad.
AttrStringFont := NSFont.menuFontOfSize(14); // 0 = default size
AttrStringFont.Handle := FontManager.convertFont_toHaveTrait_(AttrStringFont.Handle, NSBoldFontMask);
AttrDictionary := NSDictionary.dictionaryWithObject_forKey(AttrStringFont.Handle, lobjc.id(NSFontAttributeName));
AttrString := NSAttributedString.initWithString_attributes(ItemText, CFDictionaryRef(AttrDictionary.Handle));
if AttrString.Handle <> nil then
Result.setAttributedTitle(AttrString.Handle);
// Only objects acquired with routines with alloc,
// init or copy in the name should be manually released
AttrString.Free;
AttrDictionary.Handle := nil;
AttrDictionary.Free;
AttrStringFont.Handle := nil;
AttrStringFont.Free;
FontManager.Handle := nil;
FontManager.Free;
end;
{ Assign enabled/disabled state }
if AMenuItem.Enabled then Result.setEnabled(LongBool(YES))
else Result.setEnabled(LongBool(NO));
{ Assign the item image, if any }
if (AMenuItem.Bitmap <> nil) and (not AMenuItem.Bitmap.Empty) then
begin
AImage := ConvertTBitmapToNSImage(AMenuItem.Bitmap);
Result.setImage(AImage.Handle);
// We also need to free the images
subimageindex := Length(SubMenuImages);
SetLength(SubMenuImages, subimageindex + 1);
SubMenuImages[subimageindex] := AImage;
end;
{ We use the Tag to hold the LCL MenuItem
RepresentedObject was also tried, by it crashed.
Cocoa probably tryes to use it as a real Cocoa object }
Result.setTag(PtrInt(AMenuItem));
{ Never add separators to the list of items to be freed }
subitemindex := Length(SubMenuItems);
SetLength(SubMenuItems, subitemindex + 1);
SubMenuItems[subitemindex] := Result;
end;
end;
procedure TPrivateCocoaCarbonTrayIcon.ReleaseMenu();
var
i: Integer;
begin
for i := 0 to Length(SubMenuOwners) - 1 do
if SubMenuOwners[i] <> nil then SubMenuOwners[i].Free;
for i := 0 to Length(SubMenuItems) - 1 do
if (SubMenuItems[i] <> nil) then SubMenuItems[i].Free;
for i := 0 to Length(SubMenuImages) - 1 do
if (SubMenuImages[i] <> nil) then SubMenuImages[i].Free;
SetLength(SubMenuOwners, 0);
SetLength(SubMenuItems, 0);
SetLength(SubMenuImages, 0);
if item <> nil then
item.setMenu(nil);
if menu <> nil then
begin
menu.Free;
menu := nil;
end;
end;
procedure TPrivateCocoaCarbonTrayIcon.RemoveIcon();
begin
if item <> nil then
bar.removeStatusItem(item.Handle);
end;*)
function TCDCocoaTrayIcon.ConvertTIconToWSBitmap(AIcon: TIcon): TCocoaBitmap;
(*var
ASize: NSSize;
ACGRect: CGRect;
AcurrentContext: NSGraphicsContext;*)
begin
Result := nil;
(* if (AIcon = nil) or (AIcon.Empty) then Exit;
{ Convert our CFImageRef to a NSImage }
ASize.width := TCarbonBitmap(AIcon.Handle).Width;
ASize.height := TCarbonBitmap(AIcon.Handle).Height;
ACGRect.size.width := ASize.width;
ACGRect.size.height := ASize.height;
ACGRect.origin.x := 0;
ACGRect.origin.y := 0;
Result := NSImage.initWithSize(ASize);
Result.setCacheMode(NSImageCacheNever);
Result.lockFocus;
AcurrentContext := NSGraphicsContext.currentContext();
CGContextDrawImage(AcurrentContext.graphicsPort, ACGRect, TCarbonBitmap(AIcon.Handle).CGImage);
{$ifdef VerboseCarbonTrayIcon}
WriteLn('::[TCarbonWSCustomTrayIcon.Show]',
' AcurrentContext ', IntToHex(PtrUInt(Pointer(AcurrentContext)), 8),
' AcurrentContext.ClassID ', IntToHex(Int64(AcurrentContext.ClassID), 8),
' AcurrentContext.Handle ', IntToHex(Int64(AcurrentContext.Handle), 8),
' AcurrentContext.graphicsPort ', IntToHex(Int64(AcurrentContext.graphicsPort), 8)
);
{$endif VerboseCarbonTrayIcon}
Result.unlockFocus;*)
end;
function TCDCocoaTrayIcon.ConvertTBitmapToWSBitmap(ABitmap: TBitmap): TCocoaBitmap;
(*var
ASize: NSSize;
ACGRect: CGRect;
AcurrentContext: NSGraphicsContext;*)
begin
Result := nil;
(* if (ABitmap = nil) or (ABitmap.Empty) then Exit;
{ Convert our CFImageRef to a NSImage }
ASize.width := TCarbonBitmap(ABitmap.Handle).Width;
ASize.height := TCarbonBitmap(ABitmap.Handle).Height;
ACGRect.size.width := ASize.width;
ACGRect.size.height := ASize.height;
ACGRect.origin.x := 0;
ACGRect.origin.y := 0;
Result := NSImage.initWithSize(ASize);
Result.setCacheMode(NSImageCacheNever);
Result.lockFocus;
AcurrentContext := NSGraphicsContext.currentContext();
CGContextDrawImage(AcurrentContext.graphicsPort, ACGRect, TCarbonBitmap(ABitmap.Handle).CGImage);
{$ifdef VerboseCarbonTrayIcon}
WriteLn('::[TCarbonWSCustomTrayIcon.Show]',
' AcurrentContext ', IntToHex(PtrUInt(Pointer(AcurrentContext)), 8),
' AcurrentContext.ClassID ', IntToHex(Int64(AcurrentContext.ClassID), 8),
' AcurrentContext.Handle ', IntToHex(Int64(AcurrentContext.Handle), 8),
' AcurrentContext.graphicsPort ', IntToHex(Int64(AcurrentContext.graphicsPort), 8)
);
{$endif VerboseCarbonTrayIcon}
Result.unlockFocus;*)
end;
(*// Using private APIs might cause a rejection in the Apple AppStore
// See: http://bugs.freepascal.org/view.php?id=19025
// But on the other hand there is no other way to check if the menu is visible
// http://www.cocoabuilder.com/archive/cocoa/100570-checking-if-menu-is-visible.html
{$ifdef CarbonUsePrivateAPIs}
function _NSGetCarbonMenu(AMenu: lobjc.id {NSMenu}): MenuRef; cdecl; external name '_NSGetCarbonMenu';
{$endif}
function TPrivateCocoaCarbonTrayIcon.IsMenuVisible: Boolean;
{$ifdef CarbonUsePrivateAPIs}
var
CarbonMenu: MenuRef;
theMenuTrackingData: MenuTrackingData;
begin
Result := False;
if menu = nil then Exit;
CarbonMenu := _NSGetCarbonMenu(menu.Handle);
if CarbonMenu = nil then Exit;
Result := GetMenuTrackingData(CarbonMenu, theMenuTrackingData) = noErr;
end;
{$else}
begin
Result := False;
end;
{$endif}
{ Here we try to get the LCL MenuItem from the Tag and then call
it's OnClick method }
class procedure TPrivateCocoaCarbonTrayIcon.HandleMenuItemClick(_self: lobjc.id;
_cmd: SEL; sender: lobjc.id); cdecl; //static;
var
AMenuItem: NSMenuItem;
LCLMenu: TMenuItem;
begin
AMenuItem := NSMenuItem.CreateWithHandle(lobjc.id(_cmd));
LCLMenu := TMenuItem(PtrInt(AMenuItem.Tag()));
if (LCLMenu <> nil) and Assigned(LCLMenu.OnClick) then LCLMenu.OnClick(LCLMenu);
end;
class procedure TPrivateCocoaCarbonTrayIcon.HandleMenuWillOpen(_self: lobjc.id;
_cmd: SEL; sender: lobjc.id); cdecl; //static;
var
AMenu: NSMenu;
//LCLMenu: TPopUpMenu;
begin
AMenu := NSMenu.CreateWithHandle(sender);
if AMenu=nil then ;
// LCLMenu := TPopUpMenu(PtrInt(AMenu.menuRepresentation()));
// if (LCLMenu <> nil) and Assigned(LCLMenu.OnPopUp) then LCLMenu.OnPopUp(LCLMenu);
end;
class procedure TPrivateCocoaCarbonTrayIcon.HandleMenuDidClose(_self: lobjc.id;
_cmd: SEL; sender: lobjc.id); cdecl; //static;
var
AMenu: NSMenu;
//LCLMenu: TPopUpMenu;
begin
AMenu := NSMenu.CreateWithHandle(sender);
// LCLMenu := TPopUpMenu(PtrInt(AMenu.menuRepresentation()));
// if (LCLMenu <> nil) and Assigned(LCLMenu.OnClose) then LCLMenu.OnClose(LCLMenu);
end;*)
{ TCarbonWSCustomTrayIcon }
class function TCDWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := True;
end;
class function TCDWSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
var
ATrayIconHandle: TCDCocoaTrayIcon;
begin
{$ifdef VerboseCDTrayIcon}
DebugLn(':>[TCarbonWSCustomTrayIcon.Show]');
{$endif VerboseCDTrayIcon}
Result := False;
{ Creates the handle }
ATrayIconHandle := TCDCocoaTrayIcon.alloc.init;
ATrayIconHandle.bar := NSStatusBar.systemStatusBar();
ATrayIconHandle.LCLTrayIcon := ATrayIcon;
ATrayIcon.Handle := HWND(ATrayIconHandle);
{ Converts the icon to NSImage }
ATrayIconHandle.WSBitmap := ATrayIconHandle.ConvertTIconToWSBitmap(ATrayIcon.Icon);
{ Shows the icon }
if ATrayIconHandle.item <> nil then Exit(True);
ATrayIconHandle.item := ATrayIconHandle.bar.statusItemWithLength(NSSquareStatusItemLength);
ATrayIconHandle.item.retain();
if Assigned(ATrayIconHandle.WSBitmap) and Assigned(ATrayIconHandle.WSBitmap.image) then
ATrayIconHandle.item.setImage(ATrayIconHandle.WSBitmap.image);
ATrayIconHandle.item.setHighlightMode(True);
(* { Inserts the menu }
if ATrayIcon.PopUpMenu <> nil then
begin
APrivateTrayIcon.menu := APrivateTrayIcon.CreateMenu(ATrayIcon.PopUpMenu);
if APrivateTrayIcon.item <> nil then
APrivateTrayIcon.item.setMenu(APrivateTrayIcon.menu.Handle);
end;*)
Result := True;
(* {$ifdef VerboseCDTrayIcon}
WriteLn(':<[TCarbonWSCustomTrayIcon.Show]',
' Handle: ', IntToHex(ATrayIcon.Handle, 8),
' ACGRect.size.width: ', ACGRect.size.width,
' ACGRect.size.height: ', ACGRect.size.height,
' ACGRect.origin.x: ', ACGRect.origin.x,
' ACGRect.origin.y: ', ACGRect.origin.y,
' TCarbonBitmap(ATrayIcon.Icon.Handle).CGImage ', IntToHex(Int64(TCarbonBitmap(ATrayIcon.Icon.Handle).CGImage), 8)
);
{$endif VerboseCDTrayIcon}*)
end;
class procedure TCDWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
begin
(* APrivateTrayIcon := TPrivateCocoaCarbonTrayIcon(ATrayIcon.Handle);
if APrivateTrayIcon = nil then Exit;
// The update is only necessary for a visible TTrayIcon
if not ATrayIcon.Visible then Exit;
{ Updates the image }
if Assigned(APrivateTrayIcon.Image) then
APrivateTrayIcon.image.Free;
if Assigned(ATrayIcon.Icon) then
begin
APrivateTrayIcon.image := APrivateTrayIcon.ConvertTIconToNSImage(ATrayIcon.Icon);
APrivateTrayIcon.item.setImage(APrivateTrayIcon.image.Handle);
end;
{ Inserts the menu }
APrivateTrayIcon.ReleaseMenu();
if ATrayIcon.PopUpMenu <> nil then
begin
APrivateTrayIcon.menu := APrivateTrayIcon.CreateMenu(ATrayIcon.PopUpMenu);
if APrivateTrayIcon.item <> nil then
APrivateTrayIcon.item.setMenu(APrivateTrayIcon.menu.Handle);
end;*)
end;
class function TCDWSCustomTrayIcon.ShowBalloonHint(const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
end;
class function TCDWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): Types.TPoint;
begin
Result := Types.Point(0, 0);
end;

33
lcl/interfaces/customdrawn/customdrawntrayicon_win.inc Normal file
View File

@ -0,0 +1,33 @@
{%mainunit carbonwsextctrls.pas}
class function TCDWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
end;
class function TCDWSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
// Result := True;
end;
{*******************************************************************
* TCDWSCustomTrayIcon.InternalUpdate ()
*
* DESCRIPTION: Makes modifications to the Icon while running
* i.e. without hiding it and showing again
*******************************************************************}
class procedure TCDWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
begin
end;
class function TCDWSCustomTrayIcon.ShowBalloonHint(
const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
end;
class function TCDWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint;
begin
Result := Point(0, 0);
end;

33
lcl/interfaces/customdrawn/customdrawntrayicon_x11.inc Normal file
View File

@ -0,0 +1,33 @@
{%mainunit carbonwsextctrls.pas}
class function TCDWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
end;
class function TCDWSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
// Result := True;
end;
{*******************************************************************
* TCDWSCustomTrayIcon.InternalUpdate ()
*
* DESCRIPTION: Makes modifications to the Icon while running
* i.e. without hiding it and showing again
*******************************************************************}
class procedure TCDWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
begin
end;
class function TCDWSCustomTrayIcon.ShowBalloonHint(
const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
end;
class function TCDWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint;
begin
Result := Point(0, 0);
end;

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

@ -473,6 +473,13 @@ begin
QtCaret.CreateCaret(TQtWidget(Handle), Bitmap, Width, Height);
end;*)
{ In LCL-CustomDrawn it is completely irrelevant if a Bitmap is compatible with the screen,
so just create any standard bitmap }
function TCDWidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP;
begin
Result := CreateBitmap(Width, Height, 1, 32, nil);
end;
{------------------------------------------------------------------------------
Function: CreateCompatibleDC
Params: DC - handle to memory device context
@ -590,14 +597,14 @@ begin
QtFont.setStyleStrategy(QStyleStategy[LogFont.lfQuality]);*)
end;
(*function TQtWidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON;
var
AIcon: TQtIcon;
APixmap, ATemp: QPixmapH;
AMask: QBitmapH;
function TCDWidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON;
//var
// AIcon: TCDIcon;
{ APixmap, ATemp: QPixmapH;
AMask: QBitmapH;}
begin
Result := 0;
if IsValidGDIObject(IconInfo^.hbmColor) then
{ if IsValidGDIObject(IconInfo^.hbmColor) then
begin
APixmap := QPixmap_create();
QPixmap_fromImage(APixmap, TQtImage(IconInfo^.hbmColor).FHandle);
@ -618,25 +625,24 @@ begin
end else
Result := HCURSOR(TQtCursor.Create(APixmap, IconInfo^.xHotspot, IconInfo^.yHotspot));
QPixmap_destroy(APixmap);
end;
end;}
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: CreatePatternBrush
Params: HBITMAP
Returns: HBRUSH
------------------------------------------------------------------------------}
function TQtWidgetSet.CreatePatternBrush(ABitmap: HBITMAP): HBRUSH;
var
function TCDWidgetSet.CreatePatternBrush(ABitmap: HBITMAP): HBRUSH;
{var
Image: QImageH;
QtBrush: TQtBrush;
QtBrush: TQtBrush;}
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI CreatePatternBrush]',' Bitmap=', dbghex(ABitmap));
{$endif}
Result := 0;
if ABitmap = 0 then
{ if ABitmap = 0 then
exit;
QtBrush := TQtBrush.Create(True);
Image := QImage_create(TQtImage(ABitmap).FHandle);
@ -646,7 +652,7 @@ begin
QImage_destroy(Image);
end;
Result := HBRUSH(QtBrush);
Result := //HBRUSH(QtBrush);}
end;*)
{------------------------------------------------------------------------------
@ -687,57 +693,51 @@ begin
lPen.Width := LogPen.lopnWidth.X;
end;
(*{------------------------------------------------------------------------------
{------------------------------------------------------------------------------
Function: CreatePolygonRgn
Params: none
Returns: HRGN
------------------------------------------------------------------------------}
function TQtWidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN;
function TCDWidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN;
var
QtRegion: TQtRegion;
QtPoints: PQtPoint;
lLazRegion: TLazRegion;
lPoints: array of TPoint;
i: Integer;
Poly: QPolygonH;
lFillMode: TLazRegionFillMode;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace: [WinAPI CreatePolygonRgn] ');
lLazRegion := TLazRegion.Create;
SetLength(lPoints, NumPts);
for i := 0 to NumPts-1 do
lPoints[i] := Points[i];
{fillmode can be ALTERNATE or WINDING as msdn says}
if FillMode = ALTERNATE then lFillMode := rfmOddEven
else lFillMode := rfmWinding;
lLazRegion.AddPolygon(lPoints, lFillMode);
Result := HRGN(lLazRegion);
{$ifdef VerboseCDWinAPI}
DebugLn('[WinAPI CreatePolygonRgn] Result: ', dbghex(Result));
{$endif}
GetMem(QtPoints, NumPts * SizeOf(TQtPoint));
for i := 0 to NumPts - 1 do
QtPoints[i] := QtPoint(Points[i].x, Points[i].y);
Poly := QPolygon_create(NumPts, PInteger(QtPoints));
FreeMem(QtPoints);
try
{fillmode can be ALTERNATE or WINDING as msdn says}
if FillMode = ALTERNATE then
QtRegion := TQtRegion.Create(True, Poly, QtOddEvenFill)
else
QtRegion := TQtRegion.Create(True, Poly, QtWindingFill);
Result := HRGN(QtRegion);
finally
QPolygon_destroy(Poly);
end;
end;
{------------------------------------------------------------------------------
Function: CreateRectRgn
Params: none
Returns: HRGN
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN;
function TCDWidgetSet.CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN;
var
QtRegion: TQtRegion;
lLazRegion: TLazRegion;
begin
QtRegion := TQtRegion.Create(True, X1, Y1, X2, Y2);
Result := HRGN(QtRegion);
{$ifdef VerboseQtWinAPI}
WriteLn('Trace: [WinAPI CreateRectRgn] Result: ', dbghex(Result),
' QRegionH: ', dbghex(PtrInt(QtRegion.Widget)));
lLazRegion := TLazRegion.Create;
lLazRegion.SetAsSimpleRectRegion(Types.Rect(X1, Y1, X2, Y2));
Result := HRGN(lLazRegion);
{$ifdef VerboseCDWinAPI}
DebugLn('Trace: [WinAPI CreateRectRgn] Result: ', dbghex(Result));
{$endif}
end;*)
end;
{------------------------------------------------------------------------------
Procedure: DeleteCriticalSection
@ -3276,36 +3276,27 @@ begin
result := nil;
end;
(*function TQtWidgetSet.GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint;
function TCDWidgetSet.GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint;
var
R: TRect;
lLazRegion: TLazRegion absolute RGN;
begin
{$ifdef VerboseQtWinAPI}
writeln('Trace:> [WinAPI GetRgnBox] Handle: ' + dbghex(RGN));
{$endif}
Result := SIMPLEREGION;
if lpRect <> nil then
lpRect^ := Rect(0,0,0,0);
if not IsValidGDIObject(RGN) then
Result := ERROR
else
if RGN = 0 then
begin
Result := TQtRegion(RGN).GetRegionType;
if not (Result in [ERROR, NULLREGION]) and (lpRect <> nil) then
begin
R := TQtRegion(RGN).getBoundingRect;
with lpRect^ do
begin
Left := R.Left;
Top := R.Top;
Right := R.Left + R.Right;
Bottom := R.Top + R.Bottom;
end;
end;
Result := ERROR;
if lpRect <> nil then lpRect^ := Types.Rect(0,0,0,0);
Exit();
end;
//Result := lLazRegion.IsSimpleRectRegion(); TQtRegion(RGN).GetRegionType;
Result := SIMPLEREGION;
if lpRect <> nil then lpRect^ := lLazRegion.GetBoundingRect();
{$ifdef VerboseCDWinAPI}
Debugln('Trace:> [WinAPI GetRgnBox] Handle: ' + dbghex(RGN));
{$endif}
end;
function TQtWidgetSet.GetROP2(DC: HDC): Integer;
(*function TQtWidgetSet.GetROP2(DC: HDC): Integer;
var
QtDC: TQtDeviceContext absolute DC;
begin
@ -4653,27 +4644,34 @@ begin
Result := True;
end;
(*{------------------------------------------------------------------------------
{------------------------------------------------------------------------------
Function: InvalidateRgn
Params: aHandle:
Rect:
bErase:
Returns: True if invalidate is successfull.
Invalidates region of widget.
Felipe: Invalidating a non-rectangular region is unusual and complicated,
so for now lets just get the bounding rect and invalidate that instead.
------------------------------------------------------------------------------}
function TQtWidgetSet.InvalidateRgn(aHandle: HWND; Rgn: HRGN; Erase: Boolean
): Boolean;
function TCDWidgetSet.InvalidateRgn(aHandle: HWND; Rgn: HRGN; Erase: Boolean): Boolean;
var
lLazRegion: TLazRegion absolute Rgn;
localRect: TRect;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI InvalidateRgn]');
{$ifdef VerboseCDWinAPI}
DebugLn('[WinAPI InvalidateRgn]');
{$endif}
if aHandle = 0 then
exit(False);
if IsValidGDIObject(Rgn) and (TQtRegion(Rgn).FHandle <> nil) then
TQtWidget(aHandle).UpdateRegion(TQtRegion(Rgn).FHandle)
if aHandle = 0 then Exit(False);
if Rgn <> 0 then
begin
localRect := lLazRegion.GetBoundingRect();
Result := InvalidateRect(aHandle, @localRect, Erase);
end
else
TQtWidget(aHandle).Update;
end;*)
Result := InvalidateRect(aHandle, nil, Erase);
end;
{------------------------------------------------------------------------------
Procedure: LeaveCriticalSection
@ -5038,8 +5036,7 @@ begin
if IsValidDC(DC) then Exit;
Result := 1;
end;
end;*)
{------------------------------------------------------------------------------
Function: RestoreDC: Restore a previously saved DC state
@ -5048,46 +5045,24 @@ end;
SavedDC: Index of saved state that needs to be restored
Returns: True if state was successfuly restored.
-------------------------------------------------------------------------------}
function TQtWidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean;
function TCDWidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean;
var
DCData: PQtDCData;
LazDC: TLazCanvas absolute DC;
begin
{$ifdef VerboseQTWinAPI}
WriteLn('Trace:> [WinAPI RestoreDC] DC=', dbghex(DC),' SavedDC=',SavedDC);
{$Endif}
// if SavedDC is positive, it represents the wished saved dc instance
// if SavedDC is negative, it's a relative number from last pushed state
Result := False;
if SavedDCList=nil then
begin
{$ifdef VerboseQTWinAPI}
WriteLn('Trace:< [WinAPI RestoreDC] there is no List yet, result=', result);
{$Endif}
exit;
end;
if not IsValidDC(DC) then Exit;
if SavedDC < 0 then
SavedDC := SavedDC + SavedDCList.Count;
// check index
Result := (SavedDC > 0) and (SavedDC < SavedDCList.Count);
if Result then
begin
Result := true;
while SavedDC > 0 do
begin
DCData := PQtDcData(SavedDCList[SavedDC]);
SavedDCList.Delete(SavedDC);
Result := TQtDeviceContext(DC).RestoreDCData(DCData);
Dec(SavedDC);
end;
end;
LazDC.RestoreState(SavedDC);
Result := True;
{$ifdef VerboseQTWinAPI}
WriteLn('Trace:< [WinAPI RestoreDC]');
{$Endif}
end;
function TQtWidgetSet.RoundRect(DC: hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer): Boolean;
(*function TQtWidgetSet.RoundRect(DC: hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer): Boolean;
begin
Result := False;
if not IsValidDC(DC) then
@ -5098,15 +5073,16 @@ begin
Exit;
end;
Result := inherited RoundRect(DC, X1, Y1, X2, Y2, RX, RY);
end;
end;*)
{------------------------------------------------------------------------------
Function: SaveDC: save DC state information to a stack
Params: DC
Returns: The index assigned to the or 0 if DC is not valid
-------------------------------------------------------------------------------}
function TQtWidgetSet.SaveDC(DC: HDC): Integer;
function TCDWidgetSet.SaveDC(DC: HDC): Integer;
var
DCData: PQtDCData;
LazDC: TLazCanvas absolute DC;
begin
{$ifdef VerboseQTWinAPI}
WriteLn('Trace:> [WinAPI SaveDC] DC=', dbghex(DC));
@ -5122,22 +5098,14 @@ begin
exit;
end;
if SavedDCList=nil then
begin
SavedDCList := TFPList.Create;
SavedDCList.Add(nil); // start at index 1, 0 is an invalid saved state
end;
DCData := TQtDeviceContext(DC).CreateDCData;
Result := 1;
SavedDCList.Insert(Result, DCData);
Result := LazDC.SaveState();
{$ifdef VerboseQTWinAPI}
WriteLn('Trace:< [WinAPI SaveDC] result=', Result);
{$Endif}
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: ScreenToClient
Params: Handle: HWND; var P: TPoint
Returns:

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

@ -2764,7 +2764,7 @@ begin
OBJ_FONT: Result := HGDIOBJ(QtDC.vFont);
OBJ_PEN: Result := HGDIOBJ(QtDC.vPen);
end;
end;
end;*)
{------------------------------------------------------------------------------
Function: GetCursorPos
@ -2772,19 +2772,17 @@ end;
Returns: True if succesful
------------------------------------------------------------------------------}
function TQtWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
var
vPoint: TQtPoint;
function TCDWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
begin
QCursor_pos(@vPoint);
// QCursor_pos(@vPoint);
lpPoint.x := vPoint.x;
lpPoint.y := vPoint.y;
lpPoint.x := 1;
lpPoint.y := 1;
Result := True;
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: GetDC
Params: hWnd is any widget.
Returns: Nothing

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

@ -386,50 +386,6 @@ begin
end;
{$endif}
{------------------------------------------------------------------------------
Function: GetDeviceCaps
Params: DC: HDC; Index: Integer
Returns: Integer
------------------------------------------------------------------------------}
function TCDWidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
var
LazDC: TLazCanvas;
begin
{$ifdef VerboseCDWinAPI}
DebugLn('[WinAPI GetDeviceCaps] DC ' + dbghex(DC));
{$endif}
Result := 0;
if DC = 0 then DC := HDC(ScreenDC);
LazDC := TLazCanvas(DC);
case Index of
// HORZSIZE:
// Result := QPaintDevice_widthMM(PaintDevice);
// VERTSIZE:
// Result := QPaintDevice_heightMM(PaintDevice);
// HORZRES:
// Result := QPaintDevice_width(PaintDevice);
// BITSPIXEL:
// Result := QPaintDevice_depth(PaintDevice);
PLANES:
Result := 1;
// SIZEPALETTE:
// Result := QPaintDevice_numColors(PaintDevice);
{ LOGPIXELSX:
Result := javaEnvRef^^.GetLongField(javaEnvRef, javaActivityObject, javaField_lclxdpi;
LOGPIXELSY:
Result := javaEnvRef^^.GetLongField(javaEnvRef, javaActivityObject, javaField_lclydpi;}
// VERTRES:
// Result := QPaintDevice_height(PaintDevice);
NUMRESERVED:
Result := 0;
else
Result := 0;
end;
end;
(*{------------------------------------------------------------------------------
Method: GetWindowRect
Params: Handle - Handle of window
@ -492,20 +448,63 @@ begin
MoveRect(ARect, dx, dy);
end else
Result:=False;
end;
end;*)
function TCocoaWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
function TCDWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
begin
with NSEvent.mouseLocation do
begin
lpPoint.x := Round(x);
lpPoint.x := Round(NSEvent.mouseLocation.x);
// cocoa returns cursor with inverted y coordinate
lpPoint.y := Round(NSScreen.mainScreen.frame.size.height-y);
end;
lpPoint.y := Round(NSScreen.mainScreen.frame.size.height -
NSEvent.mouseLocation.y);
Result := True;
end;
function TCocoaWidgetSet.GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
{------------------------------------------------------------------------------
Function: GetDeviceCaps
Params: DC: HDC; Index: Integer
Returns: Integer
------------------------------------------------------------------------------}
function TCDWidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
var
LazDC: TLazCanvas;
begin
{$ifdef VerboseCDWinAPI}
DebugLn('[WinAPI GetDeviceCaps] DC ' + dbghex(DC));
{$endif}
Result := 0;
if DC = 0 then DC := HDC(ScreenDC);
LazDC := TLazCanvas(DC);
case Index of
// HORZSIZE:
// Result := QPaintDevice_widthMM(PaintDevice);
// VERTSIZE:
// Result := QPaintDevice_heightMM(PaintDevice);
// HORZRES:
// Result := QPaintDevice_width(PaintDevice);
// BITSPIXEL:
// Result := QPaintDevice_depth(PaintDevice);
PLANES:
Result := 1;
// SIZEPALETTE:
// Result := QPaintDevice_numColors(PaintDevice);
{ LOGPIXELSX:
Result := javaEnvRef^^.GetLongField(javaEnvRef, javaActivityObject, javaField_lclxdpi;
LOGPIXELSY:
Result := javaEnvRef^^.GetLongField(javaEnvRef, javaActivityObject, javaField_lclydpi;}
// VERTRES:
// Result := QPaintDevice_height(PaintDevice);
NUMRESERVED:
Result := 0;
else
Result := 0;
end;
end;
(*function TCocoaWidgetSet.GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
var
ScreenID: NSScreen absolute hMonitor;
begin
@ -527,6 +526,129 @@ begin
Result:=0;
end;*)
{------------------------------------------------------------------------------
Method: GetSystemMetrics
Params: NIndex - System metric to retrieve
Returns: The requested system metric value
Retrieves various system metrics.
------------------------------------------------------------------------------}
function TCDWidgetSet.GetSystemMetrics(nIndex: Integer): Integer;
begin
Result := 0;
{$IFDEF VerboseWinAPI}
DebugLn('TCocoaWidgetSet.GetSystemMetrics NIndex: ' + DbgS(NIndex));
{$ENDIF}
case NIndex of
{ SM_CXHSCROLL,
SM_CYHSCROLL,
SM_CXVSCROLL,
SM_CYVSCROLL:
Result := 10;//GetCarbonThemeMetric(kThemeMetricScrollBarWidth);}
SM_CXSCREEN,
SM_CXVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.size.width);
SM_CYSCREEN,
SM_CYVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.size.height);
SM_XVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.origin.x);
SM_YVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.origin.y);
SM_CXSMICON,
SM_CYSMICON:
Result := 16;
SM_CXICON,
SM_CYICON:
Result := 128;
SM_CXCURSOR,
SM_CYCURSOR:
begin
{ if TCarbonCursor.HardwareCursorsSupported then
Result := 64 else}
Result := 16;
end;
{ SM_CXHTHUMB:
Result := 16;//GetCarbonThemeMetric(kThemeMetricScrollBarMinThumbWidth);
SM_CYVTHUMB:
Result := 16;//GetCarbonThemeMetric(kThemeMetricScrollBarMinThumbHeight);}
SM_SWSCROLLBARSPACING:
Result:=0;
else
DebugLn('TCocoaWidgetSet.GetSystemMetrics TODO ', DbgS(NIndex));;
end;
{$IFDEF VerboseWinAPI}
DebugLn('TCocoaWidgetSet.GetSystemMetrics Result: ' + DbgS(Result));
{$ENDIF}
end;
{$ifdef CD_UseNativeText}
{------------------------------------------------------------------------------
Method: GetTextExtentPoint
Params: DC - Handle of device context
Str - Text string
Count - Number of characters in string
Size - The record for the dimensions of the string
Returns: If the function succeeds
Computes the width and height of the specified string of text
------------------------------------------------------------------------------}
function TCDWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean;
var
ctx: TCocoaContext;
lazdc: TLazCanvas;
begin
{$IFDEF VerboseCDText}
DebugLn('[TCDWidgetSet.GetTextExtentPoint] DC: %x Str: %s Count: %d', [DC, Str, Count]);
{$ENDIF}
if not IsValidDC(DC) then Exit;
lazdc := TLazCanvas(DC);
if lazdc.NativeDC = 0 then Exit;
ctx := TCocoaContext(lazdc.NativeDC);
Result := ctx.GetTextExtentPoint(Str, Count, Size);
{$IFDEF VerboseCDText}
DebugLn('[TCDWidgetSet.GetTextExtentPoint] Size: %d,%d', [Size.cx, Size.cy]);
{$ENDIF}
end;
{------------------------------------------------------------------------------
Method: GetTextMetrics
Params: DC - Handle of device context
TM - The Record for the text metrics
Returns: If the function succeeds
Fills the specified buffer with the metrics for the currently selected font
TODO: get exact max. and av. char width, pitch and charset
------------------------------------------------------------------------------}
function TCDWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
var
ctx: TCocoaContext;
lazdc: TLazCanvas;
begin
Result := False;
{$IFDEF VerboseCDText}
DebugLn('TCDWidgetSet.GetTextMetrics DC: ' + DbgS(DC));
{$ENDIF}
if not IsValidDC(DC) then Exit;
lazdc := TLazCanvas(DC);
if lazdc.NativeDC = 0 then Exit;
ctx := TCocoaContext(lazdc.NativeDC);
Result := ctx.GetTextMetrics(TM);
{$IFDEF VerboseCDText}
DebugLn('TCDWidgetSet.GetTextMetrics Result: ' + DbgS(Result) +
' TextMetric: ' + DbgS(TM));
{$ENDIF}
end;
{$endif}
function TCDWidgetSet.BackendGetWindowRelativePosition(Handle: hwnd; var Left, Top: Integer): boolean;
begin
if Handle<>0 then
@ -752,129 +874,6 @@ begin
end;
*)
{------------------------------------------------------------------------------
Method: GetSystemMetrics
Params: NIndex - System metric to retrieve
Returns: The requested system metric value
Retrieves various system metrics.
------------------------------------------------------------------------------}
function TCDWidgetSet.GetSystemMetrics(nIndex: Integer): Integer;
begin
Result := 0;
{$IFDEF VerboseWinAPI}
DebugLn('TCocoaWidgetSet.GetSystemMetrics NIndex: ' + DbgS(NIndex));
{$ENDIF}
case NIndex of
{ SM_CXHSCROLL,
SM_CYHSCROLL,
SM_CXVSCROLL,
SM_CYVSCROLL:
Result := 10;//GetCarbonThemeMetric(kThemeMetricScrollBarWidth);}
SM_CXSCREEN,
SM_CXVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.size.width);
SM_CYSCREEN,
SM_CYVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.size.height);
SM_XVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.origin.x);
SM_YVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.origin.y);
SM_CXSMICON,
SM_CYSMICON:
Result := 16;
SM_CXICON,
SM_CYICON:
Result := 128;
SM_CXCURSOR,
SM_CYCURSOR:
begin
{ if TCarbonCursor.HardwareCursorsSupported then
Result := 64 else}
Result := 16;
end;
{ SM_CXHTHUMB:
Result := 16;//GetCarbonThemeMetric(kThemeMetricScrollBarMinThumbWidth);
SM_CYVTHUMB:
Result := 16;//GetCarbonThemeMetric(kThemeMetricScrollBarMinThumbHeight);}
SM_SWSCROLLBARSPACING:
Result:=0;
else
DebugLn('TCocoaWidgetSet.GetSystemMetrics TODO ', DbgS(NIndex));;
end;
{$IFDEF VerboseWinAPI}
DebugLn('TCocoaWidgetSet.GetSystemMetrics Result: ' + DbgS(Result));
{$ENDIF}
end;
{$ifdef CD_UseNativeText}
{------------------------------------------------------------------------------
Method: GetTextExtentPoint
Params: DC - Handle of device context
Str - Text string
Count - Number of characters in string
Size - The record for the dimensions of the string
Returns: If the function succeeds
Computes the width and height of the specified string of text
------------------------------------------------------------------------------}
function TCDWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean;
var
ctx: TCocoaContext;
lazdc: TLazCanvas;
begin
{$IFDEF VerboseCDText}
DebugLn('[TCDWidgetSet.GetTextExtentPoint] DC: %x Str: %s Count: %d', [DC, Str, Count]);
{$ENDIF}
if not IsValidDC(DC) then Exit;
lazdc := TLazCanvas(DC);
if lazdc.NativeDC = 0 then Exit;
ctx := TCocoaContext(lazdc.NativeDC);
Result := ctx.GetTextExtentPoint(Str, Count, Size);
{$IFDEF VerboseCDText}
DebugLn('[TCDWidgetSet.GetTextExtentPoint] Size: %d,%d', [Size.cx, Size.cy]);
{$ENDIF}
end;
{------------------------------------------------------------------------------
Method: GetTextMetrics
Params: DC - Handle of device context
TM - The Record for the text metrics
Returns: If the function succeeds
Fills the specified buffer with the metrics for the currently selected font
TODO: get exact max. and av. char width, pitch and charset
------------------------------------------------------------------------------}
function TCDWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
var
ctx: TCocoaContext;
lazdc: TLazCanvas;
begin
Result := False;
{$IFDEF VerboseCDText}
DebugLn('TCDWidgetSet.GetTextMetrics DC: ' + DbgS(DC));
{$ENDIF}
if not IsValidDC(DC) then Exit;
lazdc := TLazCanvas(DC);
if lazdc.NativeDC = 0 then Exit;
ctx := TCocoaContext(lazdc.NativeDC);
Result := ctx.GetTextMetrics(TM);
{$IFDEF VerboseCDText}
DebugLn('TCDWidgetSet.GetTextMetrics Result: ' + DbgS(Result) +
' TextMetric: ' + DbgS(TM));
{$ENDIF}
end;
{$endif}
(*function TCocoaWidgetSet.SaveDC(DC: HDC): Integer;
var
ctx : TCocoaContext;

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

@ -1692,7 +1692,7 @@ end;
function TWin32WidgetSet.GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ;
begin
Result := Windows.GetCurrentObject(DC, uObjectType);
end;
end;*)
{------------------------------------------------------------------------------
Method: GetCursorPos
@ -1701,12 +1701,12 @@ end;
Gets the cursor position, in screen coordinates.
------------------------------------------------------------------------------}
function TWin32WidgetSet.GetCursorPos(Var LPPoint: TPoint): Boolean;
function TCDWidgetSet.GetCursorPos(Var LPPoint: TPoint): Boolean;
begin
Result := Boolean(Windows.GetCursorPos(@LPPoint));
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Method: GetDC
Params: HWND - handle of window
Returns: value identifying the device context for the given window's client

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

@ -2721,27 +2721,26 @@ begin
OBJ_FONT: Result := HGDIOBJ(QtDC.vFont);
OBJ_PEN: Result := HGDIOBJ(QtDC.vPen);
end;
end;
end;*)
{------------------------------------------------------------------------------
Function: GetCursorPos
Params: lpPoint: The cursorposition
Returns: True if succesful
------------------------------------------------------------------------------}
function TQtWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
var
vPoint: TQtPoint;
function TCDWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
{var
vPoint: TQtPoint;}
begin
QCursor_pos(@vPoint);
// QCursor_pos(@vPoint);
lpPoint.x := vPoint.x;
lpPoint.y := vPoint.y;
lpPoint.x := 1;
lpPoint.y := 1;
Result := True;
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: GetDC
Params: hWnd is any widget.
Returns: Nothing

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

@ -34,7 +34,7 @@
//##apiwiz##sps## // Do not remove, no wizard declaration before this line
function Arc(DC: HDC; Left,Top,Right,Bottom,angle1,angle2 : Integer): Boolean; override;
(*function AngleChord(DC: HDC; x1, y1, x2, y2, angle1, angle2: Integer): Boolean; override;*)
//function AngleChord(DC: HDC; x1, y1, x2, y2, angle1, angle2: Integer): Boolean; override;
function BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc; override;
function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; override;
@ -57,17 +57,17 @@ function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; ove
function CombineRgn(Dest, Src1, Src2: HRGN; fnCombineMode: Longint): Longint; override;*)
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; override;
function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; override;
(*function CreateCaret(Handle : HWND; Bitmap : hBitmap; Width, Height : Integer) : Boolean; override;
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; override;*)
(*function CreateCaret(Handle : HWND; Bitmap : hBitmap; Width, Height : Integer) : Boolean; override;*)
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; override;
function CreateCompatibleDC(DC: HDC): HDC; override;
//function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; override;
function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
(*function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;
function CreatePatternBrush(ABitmap: HBITMAP): HBRUSH; override;*)
function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;
//function CreatePatternBrush(ABitmap: HBITMAP): HBRUSH; override;
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
(*function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;
function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override;*)
function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;
function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override;
procedure DeleteCriticalSection(var CritSection: TCriticalSection); override;
function DeleteDC(hDC: HDC): Boolean; override;
@ -110,13 +110,13 @@ function GetClientRect(handle : HWND; var ARect : TRect) : Boolean; override;
(*function GetClipBox(DC : hDC; lpRect : PRect) : Longint; override;
function GetClipRGN(DC: hDC; RGN: hRGN): Longint; override;
function GetCmdLineParamDescForInterface: string; override;
function GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ; override;
function GetCursorPos(var lpPoint: TPoint ): Boolean; override;*)
function GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ; override;*)
function GetCursorPos(var lpPoint: TPoint ): Boolean; override;
function GetDC(hWnd: HWND): HDC; override;
//function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; override;
function GetDeviceCaps(DC: HDC; Index: Integer): Integer; override;
(*function GetDeviceSize(DC: HDC; var P: TPoint): Boolean; Override;
function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; Override;
//function GetDeviceSize(DC: HDC; var P: TPoint): Boolean; Override;
(*function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; Override;
function GetDoubleClickTime: UINT; override;*)
function GetFocus: HWND; override;
(*function GetForegroundWindow: HWND; override;
@ -126,8 +126,8 @@ function GetMonitorInfo(Monitor: HMONITOR; lpmi: PMonitorInfo): Boolean; overrid
function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; override;
function GetParent(Handle : HWND): HWND; override;*)
function GetProp(Handle : hwnd; Str : PChar): Pointer; override;
(*function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint; override;
function GetROP2(DC: HDC): Integer; override;
function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint; override;
(*function GetROP2(DC: HDC): Integer; override;
function GetScrollBarSize(Handle: HWND; BarKind: Integer): integer; override;
function GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean; override;
function GetScrollInfo(Handle: HWND; BarFlag: Integer; Var ScrollInfo: TScrollInfo): Boolean; override;
@ -156,7 +156,7 @@ function HideCaret(hWnd: HWND): Boolean; override;*)
function InvalidateRect(aHandle : HWND; Rect : pRect; bErase : Boolean) : Boolean; override;
function BackendInvalidateRect(aHandle : HWND; Rect : pRect; bErase : Boolean) : Boolean;
(*function InvalidateRgn(aHandle: HWND; Rgn: HRGN; Erase: Boolean): Boolean; override;*)
function InvalidateRgn(aHandle: HWND; Rgn: HRGN; Erase: Boolean): Boolean; override;
procedure InitializeCriticalSection(var CritSection: TCriticalSection); override;
(*function IntersectClipRect(dc: hdc; Left, Top, Right, Bottom: Integer): Integer; override;
function IsIconic(Handle: HWND): boolean; override;
@ -185,14 +185,14 @@ function Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; override;
function RectVisible(dc : hdc; const ARect: TRect) : Boolean; override;
(*function RedrawWindow(Wnd: HWND; lprcUpdate: PRECT; hrgnUpdate: HRGN; flags: UINT): Boolean; override;
function ReleaseCapture : Boolean; override;
function ReleaseDC(hWnd: HWND; DC: HDC): Integer; override;
function ReleaseDC(hWnd: HWND; DC: HDC): Integer; override;*)
function RestoreDC(DC: HDC; SavedDC: Integer): Boolean; override;
function RoundRect(DC : hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer): Boolean; override;
//function RoundRect(DC : hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer): Boolean; override;
function SaveDC(DC: HDC): Integer; override;
function ScreenToClient(Handle : HWND; var P : TPoint) : Integer; override;
function ScrollWindowEx(HWnd: HWND; DX, DY: Integer; PRcScroll, PRcClip: PRect; HRgnUpdate: HRGN; PRcUpdate: PRect; Flags: UINT): Boolean; override;
function SelectClipRGN(DC : hDC; RGN : HRGN) : Longint; override;*)
//function ScreenToClient(Handle : HWND; var P : TPoint) : Integer; override;
//function ScrollWindowEx(HWnd: HWND; DX, DY: Integer; PRcScroll, PRcClip: PRect; HRgnUpdate: HRGN; PRcUpdate: PRect; Flags: UINT): Boolean; override;
//function SelectClipRGN(DC : hDC; RGN : HRGN) : Longint; override;
function SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; override;
(*function SendMessage(HandleWnd: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; override;
function SetActiveWindow(Handle: HWND): HWND; override;

140
lcl/interfaces/customdrawn/customdrawnwsextctrls.pas
View File

@ -1,6 +1,6 @@
{
*****************************************************************************
* CustomDrawnWSExtCtrls.pp *
* CustomDrawnWSExtCtrls.pas *
* --------------- *
* *
* *
@ -23,15 +23,23 @@ unit CustomDrawnWSExtCtrls;
{$mode objfpc}{$H+}
{$I customdrawndefines.inc}
interface
//{$I qtdefines.inc}
uses
// RTL
Types,
// {$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
{$ifdef CD_Cocoa}MacOSAll, CocoaAll, CocoaPrivate, CocoaGDIObjects,{$endif}
// {$ifdef CD_X11}X, XLib, XUtil, BaseUnix, customdrawn_x11proc,{$ifdef CD_UseNativeText}xft, fontconfig,{$endif}{$endif}
// {$ifdef CD_Android}customdrawn_androidproc, jni, bitmap, log, keycodes,{$endif}
// LCL
LCLProc,
SysUtils, Classes, Controls, Graphics, Forms, ExtCtrls, LCLType,
ImgList,
ImgList, InterfaceBase,
// Widgetset
WSExtCtrls, WSProc, WSLCLClasses,
customdrawncontrols, customdrawnwscontrols, customdrawnproc;
@ -150,11 +158,11 @@ type
TCDWSCustomTrayIcon = class(TWSCustomTrayIcon)
published
{ class function Hide(const ATrayIcon: TCustomTrayIcon): Boolean; override;
class function Hide(const ATrayIcon: TCustomTrayIcon): Boolean; override;
class function Show(const ATrayIcon: TCustomTrayIcon): Boolean; override;
class procedure InternalUpdate(const ATrayIcon: TCustomTrayIcon); override;
class function ShowBalloonHint(const ATrayIcon: TCustomTrayIcon): Boolean; override;
class function GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; override;}
class function GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; override;
end;
implementation
@ -230,117 +238,19 @@ begin
lCDWinControl := TCDWinControl(Result);
end;
(*{ TCDWSCustomTrayIcon }
{ TCDWSCustomTrayIcon }
class function TCDWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
var
SystemTrayIcon: TQtSystemTrayIcon;
begin
Result := False;
SystemTrayIcon := TQtSystemTrayIcon(ATrayIcon.Handle);
SystemTrayIcon.Hide;
SystemTrayIcon.Free;
ATrayIcon.Handle := 0;
Result := True;
end;
class function TCDWSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
var
Text: WideString;
SystemTrayIcon: TQtSystemTrayIcon;
IconH: QIconH;
begin
Result := False;
if ATrayIcon.Icon.Handle = 0 then
IconH := nil
else
IconH := TQtIcon(ATrayIcon.Icon.Handle).Handle;
SystemTrayIcon := TQtSystemTrayIcon.Create(IconH);
SystemTrayIcon.FTrayIcon := ATrayIcon;
ATrayIcon.Handle := HWND(SystemTrayIcon);
Text := UTF8ToUTF16(ATrayIcon.Hint);
SystemTrayIcon.setToolTip(Text);
if Assigned(ATrayIcon.PopUpMenu) then
if TQtMenu(ATrayIcon.PopUpMenu.Handle).Widget <> nil then
SystemTrayIcon.setContextMenu(QMenuH(TQtMenu(ATrayIcon.PopUpMenu.Handle).Widget));
SystemTrayIcon.show;
Result := True;
end;
{*******************************************************************
* TCDWSCustomTrayIcon.InternalUpdate ()
*
* DESCRIPTION: Makes modifications to the Icon while running
* i.e. without hiding it and showing again
*******************************************************************}
class procedure TCDWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
var
SystemTrayIcon: TQtSystemTrayIcon;
AIcon: QIconH;
begin
if (ATrayIcon.Handle = 0) then Exit;
SystemTrayIcon := TQtSystemTrayIcon(ATrayIcon.Handle);
if Assigned(ATrayIcon.Icon) then
begin
// normal icon
if (ATrayIcon.Icon.HandleAllocated) then
SystemTrayIcon.setIcon(TQtIcon(ATrayIcon.Icon.Handle).Handle)
else
// image list (animate)
if (ATrayIcon.Icon.BitmapHandle <> 0) then
SystemTrayIcon.setIcon(TQtImage(ATrayIcon.Icon.BitmapHandle).AsIcon)
else
begin
AIcon := QIcon_create;
SystemTrayIcon.setIcon(AIcon);
QIcon_destroy(AIcon);
end;
end else
begin
AIcon := QIcon_create;
SystemTrayIcon.setIcon(AIcon);
QIcon_destroy(AIcon);
end;
{ PopUpMenu }
if Assigned(ATrayIcon.PopUpMenu) then
if TQtMenu(ATrayIcon.PopUpMenu.Handle).Widget <> nil then
SystemTrayIcon.setContextMenu(QMenuH(TQtMenu(ATrayIcon.PopUpMenu.Handle).Widget));
end;
class function TCDWSCustomTrayIcon.ShowBalloonHint(
const ATrayIcon: TCustomTrayIcon): Boolean;
var
QtTrayIcon: TQtSystemTrayIcon;
begin
Result := False;
if (ATrayIcon.Handle = 0) then Exit;
QtTrayIcon := TQtSystemTrayIcon(ATrayIcon.Handle);
QtTrayIcon.showBaloonHint(ATrayIcon.BalloonTitle, ATrayIcon.BalloonHint,
QSystemTrayIconMessageIcon(Ord(ATrayIcon.BalloonFlags)),
ATrayIcon.BalloonTimeout);
Result := True;
end;
class function TCDWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint;
begin
Result := Point(0, 0);
end; *)
{$ifdef CD_Windows}
{$I customdrawntrayicon_win.inc}
{$endif}
{$ifdef CD_Cocoa}
{$I customdrawntrayicon_cocoa.inc}
{$endif}
{$ifdef CD_X11}
{$I customdrawntrayicon_x11.inc}
{$endif}
{$ifdef CD_Android}
{$I customdrawntrayicon_android.inc}
{$endif}
end.

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

@ -391,7 +391,8 @@ end;
function RegisterCustomTrayIcon: Boolean; alias : 'WSRegisterCustomTrayIcon';
begin
Result := False;
RegisterWSComponent(TCustomTrayIcon, TCDWSCustomTrayIcon);
Result := True;
end;
//ExtDlgs

23
lcl/interfaces/lcl.lpk
View File

@ -100,6 +100,11 @@ end;"/>
<ValueDescriptions Count="2"/>
</Item2>
</BuildMacros>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2"/>
</Debugging>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5044="True"/>
@ -114,7 +119,7 @@ end;"/>
<License Value="modified LGPL-2
"/>
<Version Major="1" Release="1"/>
<Files Count="387">
<Files Count="391">
<Item1>
<Filename Value="carbon/agl.pp"/>
<AddToUsesPkgSection Value="False"/>
@ -1919,6 +1924,22 @@ end;"/>
<Filename Value="customdrawn/customdrawnlclintf_x11.inc"/>
<Type Value="Include"/>
</Item387>
<Item388>
<Filename Value="customdrawn/customdrawntrayicon_android.inc"/>
<Type Value="Include"/>
</Item388>
<Item389>
<Filename Value="customdrawn/customdrawntrayicon_cocoa.inc"/>
<Type Value="Include"/>
</Item389>
<Item390>
<Filename Value="customdrawn/customdrawntrayicon_win.inc"/>
<Type Value="Include"/>
</Item390>
<Item391>
<Filename Value="customdrawn/customdrawntrayicon_x11.inc"/>
<Type Value="Include"/>
</Item391>
</Files>
<LazDoc Paths="../../docs/xml/lcl"/>
<i18n>

30
lcl/lazcanvas.pas
View File

@ -33,6 +33,7 @@
unit lazcanvas;
{$mode objfpc}{$H+}
{.$define lazcanvas_debug}
interface
@ -43,7 +44,7 @@ uses
fpimgcanv, fpcanvas, fpimage, clipping, pixtools, fppixlcanv,
// regions
lazregions
{, LCLProc for debugging};
{$ifdef lazcanvas_debug}, LCLProc{$endif};
type
@ -82,7 +83,7 @@ type
FLazClipRegion: TFPCustomRegion;
{$endif}
FWindowOrg: TPoint; // already in absolute coords with BaseWindowOrg summed up
GraphicStateStack: TObjectStack; // TLazCanvasState
GraphicStateList: TFPList; // TLazCanvasState
function GetAssignedBrush: TFPCustomBrush;
function GetAssignedPen: TFPCustomPen;
function GetAssignedFont: TFPCustomFont;
@ -103,9 +104,9 @@ type
constructor create (AnImage : TFPCustomImage);
destructor destroy; override;
procedure SetLazClipRegion(ARegion: TLazRegion);
// Canvas states stack
procedure SaveState;
procedure RestoreState;
// Canvas states list
function SaveState: Integer;
procedure RestoreState(AIndex: Integer);
// A simple operation to bring the Canvas in the default LCL TCanvas state
procedure ResetCanvasState;
// Alpha blending operations
@ -193,6 +194,9 @@ procedure TLazCanvas.SetWindowOrg(AValue: TPoint);
begin
FWindowOrg.X := AValue.X+FBaseWindowOrg.X;
FWindowOrg.Y := AValue.Y+FBaseWindowOrg.Y;
{$ifdef lazcanvas_debug}
DebugLn(Format('[TLazCanvas.SetWindowOrg] AValue=%d,%d BaseWindowOrg=%d,%d', [AValue.X, AValue.Y, FBaseWindowOrg.X, FBaseWindowOrg.y]));
{$endif}
end;
procedure TLazCanvas.SetColor(x, y: integer; const AValue: TFPColor);
@ -397,13 +401,13 @@ end;
constructor TLazCanvas.create(AnImage: TFPCustomImage);
begin
inherited Create(AnImage);
GraphicStateStack := TObjectStack.Create;
GraphicStateList := TFPList.Create;
HasNoImage := AnImage = nil;
end;
destructor TLazCanvas.destroy;
begin
GraphicStateStack.Free;
GraphicStateList.Free;
if FAssignedBrush <> nil then FAssignedBrush.Free;
if FAssignedPen <> nil then FAssignedPen.Free;
inherited destroy;
@ -420,7 +424,7 @@ begin
{$endif}
end;
procedure TLazCanvas.SaveState;
function TLazCanvas.SaveState: Integer;
var
lState: TLazCanvasState;
begin
@ -433,14 +437,18 @@ begin
lState.WindowOrg := WindowOrg;
lState.Clipping := Clipping;
GraphicStateStack.Push(lState);
GraphicStateList.Add(lState);
end;
procedure TLazCanvas.RestoreState;
// if AIndex is positive, it represents the wished saved dc instance
// if AIndex is negative, it's a relative number from last pushed state
procedure TLazCanvas.RestoreState(AIndex: Integer);
var
lState: TLazCanvasState;
begin
lState := TLazCanvasState(GraphicStateStack.Pop());
if AIndex < 0 then AIndex := AIndex + GraphicStateList.Count;
lState := TLazCanvasState(GraphicStateList.Items[AIndex]);
GraphicStateList.Delete(AIndex);
if lState = nil then Exit;
AssignPenData(lState.Pen);

31
lcl/lazregions.pas
View File

@ -13,6 +13,9 @@ uses
Classes, SysUtils, fpcanvas;
type
TLazRegionFillMode = (rfmOddEven, rfmWinding);
TPointArray = array of TPoint;
{ TLazRegionPart }
@ -29,6 +32,15 @@ type
function IsPointInPart(AX, AY: Integer): Boolean; override;
end;
{ TLazRegionPolygon }
TLazRegionPolygon = class(TLazRegionPart)
public
Points: array of TPoint;
FillMode: TLazRegionFillMode;
function IsPointInPart(AX, AY: Integer): Boolean; override;
end;
{$if defined(ver2_4) or defined(ver2_5) or defined(ver2_6)}
TFPCustomRegion = class
function GetBoundingRect: TRect; virtual; abstract;
@ -48,6 +60,7 @@ type
constructor Create; virtual;
destructor Destroy; override;
procedure AddRectangle(ARect: TRect);
procedure AddPolygon(var APoints: TPointArray; AFillMode: TLazRegionFillMode);
procedure SetAsSimpleRectRegion(ARect: TRect);
function GetBoundingRect: TRect; override;
function IsPointInRegion(AX, AY: Integer): Boolean; override;
@ -139,6 +152,13 @@ begin
(AY >= Rect.Top) and (AY <= Rect.Bottom);
end;
{ TLazRegionPolygon }
function TLazRegionPolygon.IsPointInPart(AX, AY: Integer): Boolean;
begin
Result := IsPointInPolygon(AX, AY, Points);
end;
{ TLazRegion }
constructor TLazRegion.Create;
@ -163,6 +183,17 @@ begin
Parts.Add(lNewRect);
end;
procedure TLazRegion.AddPolygon(var APoints: TPointArray;
AFillMode: TLazRegionFillMode);
var
lNewPolygon: TLazRegionPolygon;
begin
lNewPolygon := TLazRegionPolygon.Create;
lNewPolygon.Points := APoints;
lNewPolygon.FillMode := AFillMode;
Parts.Add(lNewPolygon);
end;
procedure TLazRegion.SetAsSimpleRectRegion(ARect: TRect);
begin
IsSimpleRectRegion := True;