diff --git a/.gitattributes b/.gitattributes index 4e4d42690c..ffd90689ac 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/lcl/interfaces/customdrawn/customdrawnproc.pas b/lcl/interfaces/customdrawn/customdrawnproc.pas index 863db4dbcc..52c624ab93 100644 --- a/lcl/interfaces/customdrawn/customdrawnproc.pas +++ b/lcl/interfaces/customdrawn/customdrawnproc.pas @@ -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; diff --git a/lcl/interfaces/customdrawn/customdrawntrayicon_android.inc b/lcl/interfaces/customdrawn/customdrawntrayicon_android.inc new file mode 100644 index 0000000000..031cda9267 --- /dev/null +++ b/lcl/interfaces/customdrawn/customdrawntrayicon_android.inc @@ -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; diff --git a/lcl/interfaces/customdrawn/customdrawntrayicon_cocoa.inc b/lcl/interfaces/customdrawn/customdrawntrayicon_cocoa.inc new file mode 100644 index 0000000000..d5da68bcf0 --- /dev/null +++ b/lcl/interfaces/customdrawn/customdrawntrayicon_cocoa.inc @@ -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; + diff --git a/lcl/interfaces/customdrawn/customdrawntrayicon_win.inc b/lcl/interfaces/customdrawn/customdrawntrayicon_win.inc new file mode 100644 index 0000000000..031cda9267 --- /dev/null +++ b/lcl/interfaces/customdrawn/customdrawntrayicon_win.inc @@ -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; diff --git a/lcl/interfaces/customdrawn/customdrawntrayicon_x11.inc b/lcl/interfaces/customdrawn/customdrawntrayicon_x11.inc new file mode 100644 index 0000000000..031cda9267 --- /dev/null +++ b/lcl/interfaces/customdrawn/customdrawntrayicon_x11.inc @@ -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; diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi.inc b/lcl/interfaces/customdrawn/customdrawnwinapi.inc index 26915492dd..334e108076 100644 --- a/lcl/interfaces/customdrawn/customdrawnwinapi.inc +++ b/lcl/interfaces/customdrawn/customdrawnwinapi.inc @@ -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: diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi_android.inc b/lcl/interfaces/customdrawn/customdrawnwinapi_android.inc index 7da2ecf86c..5252402e7b 100644 --- a/lcl/interfaces/customdrawn/customdrawnwinapi_android.inc +++ b/lcl/interfaces/customdrawn/customdrawnwinapi_android.inc @@ -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 diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi_cocoa.inc b/lcl/interfaces/customdrawn/customdrawnwinapi_cocoa.inc index f413b4aae4..f3cf7aebba 100644 --- a/lcl/interfaces/customdrawn/customdrawnwinapi_cocoa.inc +++ b/lcl/interfaces/customdrawn/customdrawnwinapi_cocoa.inc @@ -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; diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc b/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc index f87de31740..922a138429 100644 --- a/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc +++ b/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc @@ -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 diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc b/lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc index f70abc2de7..b7854c7558 100644 --- a/lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc +++ b/lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc @@ -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 diff --git a/lcl/interfaces/customdrawn/customdrawnwinapih.inc b/lcl/interfaces/customdrawn/customdrawnwinapih.inc index d35b3ca75e..152d650174 100644 --- a/lcl/interfaces/customdrawn/customdrawnwinapih.inc +++ b/lcl/interfaces/customdrawn/customdrawnwinapih.inc @@ -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; diff --git a/lcl/interfaces/customdrawn/customdrawnwsextctrls.pas b/lcl/interfaces/customdrawn/customdrawnwsextctrls.pas index 62a884d44d..d49c2bb6b7 100644 --- a/lcl/interfaces/customdrawn/customdrawnwsextctrls.pas +++ b/lcl/interfaces/customdrawn/customdrawnwsextctrls.pas @@ -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. diff --git a/lcl/interfaces/customdrawn/customdrawnwsfactory.pas b/lcl/interfaces/customdrawn/customdrawnwsfactory.pas index 99b188ed11..612a8e8867 100644 --- a/lcl/interfaces/customdrawn/customdrawnwsfactory.pas +++ b/lcl/interfaces/customdrawn/customdrawnwsfactory.pas @@ -391,7 +391,8 @@ end; function RegisterCustomTrayIcon: Boolean; alias : 'WSRegisterCustomTrayIcon'; begin - Result := False; + RegisterWSComponent(TCustomTrayIcon, TCDWSCustomTrayIcon); + Result := True; end; //ExtDlgs diff --git a/lcl/interfaces/lcl.lpk b/lcl/interfaces/lcl.lpk index e7088bbfcb..db3368c3d4 100644 --- a/lcl/interfaces/lcl.lpk +++ b/lcl/interfaces/lcl.lpk @@ -100,6 +100,11 @@ end;"/> + + + + + @@ -114,7 +119,7 @@ end;"/> - + @@ -1919,6 +1924,22 @@ end;"/> + + + + + + + + + + + + + + + + diff --git a/lcl/lazcanvas.pas b/lcl/lazcanvas.pas index 4749d9a453..75e84dfbc5 100644 --- a/lcl/lazcanvas.pas +++ b/lcl/lazcanvas.pas @@ -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); diff --git a/lcl/lazregions.pas b/lcl/lazregions.pas index 3d57644cff..3442db4210 100644 --- a/lcl/lazregions.pas +++ b/lcl/lazregions.pas @@ -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;