{%MainUnit ../interfacebase.pp} { $Id$ ****************************************************************************** TWidgetSet interface communication stuff !! In this file only interface related code as defined in lclintfh.inc Most routines implement only the default !! Keep this alphabetical !! ****************************************************************************** ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** } //##apiwiz##sps## // Do not remove function TWidgetSet.AddEventHandler(AHandle: TLCLHandle; AFlags: dword; AEventHandler: TWaitHandleEvent; AData: PtrInt): PEventHandler; begin Result := nil; end; function TWidgetSet.AddProcessEventHandler(AHandle: TLCLHandle; AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; begin Result := nil; end; function TWidgetSet.AddPipeEventHandler(AHandle: TLCLHandle; AEventHandler: TPipeEvent; AData: PtrInt): PPipeEventHandler; begin Result := nil; end; function TWidgetSet.AllocateHWnd(Method: TLCLWndMethod): HWND; begin Result := 0; end; function TWidgetSet.AskUser(const DialogCaption, DialogMessage: string; DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt; begin if QuestionDialogFunction <> nil then Result := QuestionDialogFunction(DialogCaption, DialogMessage, DialogType, Buttons, HelpCtx) else Result := 0; end; procedure TWidgetSet.CallDefaultWndHandler(Sender: TObject; var Message); begin end; // the clipboard functions are internally used by TClipboard function TWidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; begin Result := ''; end; function TWidgetSet.ClipboardGetData(ClipboardType: TClipboardType; FormatID: TClipboardFormat; Stream: TStream): boolean; begin Result := false; end; // ! List will be created. You must free it yourself with FreeMem(List) ! function TWidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType; var Count: integer; var List: PClipboardFormat): boolean; begin Result := true; Count := 0; List := nil; end; function TWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType; OnRequestProc: TClipboardRequestEvent; FormatCount: integer; Formats: PClipboardFormat): boolean; begin Result := false; end; function TWidgetSet.ClipboardRegisterFormat( const AMimeType: string): TClipboardFormat; begin Result := 0; end; function TWidgetSet.ClipboardFormatNeedsNullByte( const AFormat: TPredefinedClipboardFormat): Boolean; begin Result := AFormat = pcfText; end; //todo: remove ? function TWidgetSet.CreateEmptyRegion: hRGN; begin Result:=CreateRectRGN(0,0,0,0); end; function TWidgetSet.CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; begin Result := 0; end; function TWidgetSet.CreateRegionCopy(SrcRGN: hRGN): hRGN; begin // If the interface has a better way to create a copy it can override this Result:=CreateEmptyRegion; CombineRGN(Result,SrcRGN,SrcRGN,RGN_COPY); end; function TWidgetSet.CreateRubberBand(const ARect: TRect; const ABrush: HBrush): HWND; begin Result := 0; end; function TWidgetSet.CreateStandardCursor(ACursor: SmallInt): hCursor; begin Result := 0; end; function TWidgetSet.DCClipRegionValid(DC: HDC): boolean; var Clip: hRGN; begin // If the interface has a better way to check a region it can override this //debugln('TWidgetSet.DCClipRegionValid DC=',DbgS(DC)); Clip:=CreateEmptyRegion; Result:=GetClipRGN(DC,Clip)>=0; DeleteObject(Clip); end; procedure TWidgetSet.DeallocateHWnd(Wnd: HWND); begin end; procedure TWidgetSet.DestroyRubberBand(ARubberBand: HWND); begin end; procedure TWidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); procedure DefaultDockImage(ARect: TRect); const PenSize = 4; var DC: HDC; OldPen, NewPen: HPen; OldRop: Integer; LogPen: TLogPen; begin LogPen.lopnColor := $00FFFFFF; LogPen.lopnWidth := Point(PenSize, 0); LogPen.lopnStyle := PS_SOLID; DC := GetDC(0); try NewPen := CreatePenIndirect(LogPen); OldPen := SelectObject(DC, NewPen); OldRop := SetROP2(DC, R2_XORPEN); with ARect do begin MoveToEx(DC, Left+PenSize, Top+PenSize, nil); LineTo(DC, Right-PenSize, Top+PenSize); LineTo(DC, Right-PenSize, Bottom-PenSize); LineTo(DC, Left+PenSize, Bottom-PenSize); LineTo(DC, Left+PenSize, Top+PenSize); end; finally SetROP2(DC, OldRop); DeleteObject(SelectObject(DC, OldPen)); ReleaseDC(0, DC); end; end; begin if AOperation in [disMove, disHide] then DefaultDockImage(AOldRect); if AOperation in [disMove, disShow] then DefaultDockImage(ANewRect); end; procedure TWidgetSet.DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer); var X, Y: Integer; W, H: Integer; SavedDC: Integer; begin SavedDC := SaveDC(DC); try W := (R.Right - R.Left - 1) div DX; H := (R.Bottom - R.Top - 1) div DY; // remove rows from clip rect for Y := 0 to H do begin ExcludeClipRect(DC, R.Left, R.Top + Y * DY + 1, R.Right + 1, R.Top + (Y + 1) * DY); end; // draw vertical lines cross excluded rows -> only grid cross points painted for X := 0 to W do begin if MoveToEx(DC, R.Left + X * DX, R.Top, nil) then LineTo(DC, R.Left + X * DX, R.Bottom + 1); end; finally RestoreDC(DC, SavedDC); end; end; function TWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; begin Result:=ExtTextOut(DC,X,Y,Options,Rect,Str,Count,Dx); end; function TWidgetSet.RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean = False): Boolean; begin Result := False; end; function TWidgetSet.RawImage_DescriptionFromBitmap(ABitmap: HBITMAP; out ADesc: TRawImageDescription): Boolean; begin Result := False; end; function TWidgetSet.RawImage_DescriptionFromDevice(ADC: HDC; out ADesc: TRawImageDescription): Boolean; begin Result := False; end; function TWidgetSet.RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMask: HBITMAP; ARect: PRect): Boolean; begin Result := False; end; function TWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean; begin Result := False; end; function TWidgetSet.RawImage_QueryDescription(AFlags: TRawImageQueryFlags; var ADesc: TRawImageDescription): Boolean; var Desc: TRawImageDescription; begin // for most widgetsets, this default will work, however when necessary it can be overridden. Desc.Init; Result := RawImage_DescriptionFromDevice(0, Desc); if not Result then Exit; if not (riqfUpdate in AFlags) then ADesc.Init; if riqfMono in AFlags then begin ADesc.Format := ricfGray; ADesc.Depth := 1; ADesc.BitOrder := Desc.MaskBitOrder; ADesc.ByteOrder := riboLSBFirst; ADesc.LineOrder := Desc.LineOrder; ADesc.LineEnd := Desc.MaskLineEnd; ADesc.BitsPerPixel := Desc.MaskBitsPerPixel; ADesc.RedPrec := 1; ADesc.RedShift := Desc.MaskShift end else if riqfGrey in AFlags then begin ADesc.Format := ricfGray; ADesc.Depth := 8; ADesc.BitOrder := Desc.BitOrder; ADesc.ByteOrder := Desc.ByteOrder; ADesc.LineOrder := Desc.LineOrder; ADesc.LineEnd := Desc.LineEnd; ADesc.BitsPerPixel := 8; ADesc.RedPrec := 8; ADesc.RedShift := 0; end else if riqfRGB in AFlags then begin ADesc.Format := ricfRGBA; ADesc.Depth := Desc.Depth; ADesc.BitOrder := Desc.BitOrder; ADesc.ByteOrder := Desc.ByteOrder; ADesc.LineOrder := Desc.LineOrder; ADesc.LineEnd := Desc.LineEnd; ADesc.BitsPerPixel := Desc.BitsPerPixel; ADesc.RedPrec := Desc.RedPrec; ADesc.RedShift := Desc.RedShift; ADesc.GreenPrec := Desc.GreenPrec; ADesc.GreenShift := Desc.GreenShift; ADesc.BluePrec := Desc.BluePrec; ADesc.BlueShift := Desc.BlueShift; end; if riqfAlpha in AFlags then begin ADesc.AlphaPrec := Desc.AlphaPrec; ADesc.AlphaShift := Desc.AlphaShift; end else begin if (Desc.Depth = 32) and (ADesc.Format = ricfRGBA) and ([riqfMono, riqfGrey, riqfRGB] * AFlags <> []) then ADesc.Depth := 24; end; if riqfMask in AFlags then begin ADesc.MaskBitsPerPixel := Desc.MaskBitsPerPixel; ADesc.MaskShift := Desc.MaskShift; ADesc.MaskLineEnd := Desc.MaskLineEnd; ADesc.MaskBitOrder := Desc.MaskBitOrder; end; if riqfPalette in AFlags then begin ADesc.PaletteColorCount := Desc.PaletteColorCount; ADesc.PaletteBitsPerIndex := Desc.PaletteBitsPerIndex; ADesc.PaletteShift := Desc.PaletteShift; ADesc.PaletteLineEnd := Desc.PaletteLineEnd; ADesc.PaletteBitOrder := Desc.PaletteBitOrder; ADesc.PaletteByteOrder := Desc.PaletteByteOrder; end; end; function TWidgetSet.TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; begin Result:=TextOut(DC,X,Y,Str,Count); end; function TWidgetSet.FontIsMonoSpace(Font: HFont): boolean; begin Result:=false; end; function TWidgetSet.Frame3d(DC: HDC; var ARect: TRect; const FrameWidth: integer; const Style: TGraphicsBevelCut): Boolean; begin Result:= false; end; function TWidgetSet.GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; // If the interface has a better way to create a string it can override this begin Result := KeyAndShiftStateToKeyString(AVKey, AShiftState); end; function TWidgetSet.GetAvailableNativeCanvasTypes(DC: HDC; AAllowFallbackToParent: Boolean): TNativeCanvasTypes; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} begin Result := []; end; function TWidgetSet.GetAvailableNativeHandleTypes(Handle: HWND; AAllowFallbackToParent: Boolean): TNativeHandleTypes; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} begin Result := []; end; function TWidgetSet.GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; begin ShowHideOnFocus := true; Result := False; end; function TWidgetSet.GetClientBounds(Handle: HWND; var ARect: TRect): Boolean; begin Result := false; end; function TWidgetSet.GetCmdLineParamDescForInterface: TStringList; begin Result := nil; end; function TWidgetSet.GetControlConstraints(Constraints: TObject): boolean; begin Result:=true; end; function TWidgetSet.GetDeviceSize(DC: HDC; var p: TPoint): boolean; begin p.X := 0; p.Y := 0; Result := false; end; function TWidgetSet.GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; begin OriginDiff.X:=0; OriginDiff.Y:=0; Result:=true; end; function TWidgetSet.GetDesignerDC(WindowHandle: HWND): HDC; begin Result:=GetDC(WindowHandle); end; function TWidgetSet.GetLCLOwnerObject(Handle: HWnd): TObject; begin if Handle <> 0 then Result := TObject(GetProp(Handle,'WinControl')) else Result := nil; end; function TWidgetSet.GetNativeCanvas(DC: HDC; AHandleType: TNativeCanvasType; AAllowFallbackToParent: Boolean): PtrInt; begin Result := 0; end; function TWidgetSet.GetNativeHandle(Handle: HWND; AHandleType: TNativeHandleType; AAllowFallbackToParent: Boolean): PtrInt; begin Result := 0; end; // TODO: remove function TWidgetSet.GetScrollBarSize(Handle: HWND; SBStyle: Integer): integer; begin Result := GetSystemMetrics(SBStyle); end; function TWidgetSet.GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean; begin Result := false; end; function TWidgetSet.GetWindowRelativePosition(Handle: hwnd; var Left, Top: integer): boolean; { returns the position of the left, top coordinate relative to the clientorigin of its parent. This is normally the Left, Top of a TWinControl. But not during moving/sizing. } var ChildRect: TRect; ParentLeftTop: TPoint; ParentHandle: hWnd; begin Result:=false; GetWindowRect(Handle,ChildRect); Left:=ChildRect.Left; Top:=ChildRect.Top; ParentHandle:=GetParent(Handle); if ParentHandle<>0 then begin ParentLeftTop.X:=0; ParentLeftTop.Y:=0; if not ClientToScreen(ParentHandle,ParentLeftTop) then exit; dec(Left,ParentLeftTop.X); dec(Top,ParentLeftTop.Y); end; Result := true; end; function TWidgetSet.GetWindowSize(Handle: hwnd; var Width, Height: integer): boolean; // Returns the current Width and Height begin Result:=false; end; function TWidgetSet.InvalidateFrame(aHandle: HWND; ARect: pRect; bErase: Boolean; BorderWidth: integer): Boolean; function Min(i1, i2: integer): integer; begin if i1<=i2 then Result:=i1 else Result:=i2; end; function Max(i1, i2: integer): integer; begin if i1<=i2 then Result:=i2 else Result:=i1; end; var BorderRect: TRect; begin Result:=false; BorderRect:=ARect^; // left BorderRect.Right:=Min(BorderRect.Right,BorderRect.Left+BorderWidth); if not InvalidateRect(aHandle,@BorderRect,bErase) then exit; BorderRect.Right:=ARect^.Right; // top BorderRect.Bottom:=Min(BorderRect.Bottom,BorderRect.Top+BorderWidth); if not InvalidateRect(aHandle,@BorderRect,bErase) then exit; BorderRect.Bottom:=ARect^.Bottom; // right BorderRect.Left:=Max(BorderRect.Left,BorderRect.Right-BorderWidth); if not InvalidateRect(aHandle,@BorderRect,bErase) then exit; BorderRect.Left:=ARect^.Left; // bottom BorderRect.Top:=Max(BorderRect.Top,BorderRect.Bottom-BorderWidth); if not InvalidateRect(aHandle,@BorderRect,bErase) then exit; Result:=true; end; function TWidgetSet.IsDesignerDC(WindowHandle: HWND; DC: HDC): Boolean; begin Result := False; end; function TWidgetSet.IsMobilePlatform: Boolean; begin Result := False; // A good default would be: Result := Application.ApplicationType in [atPDA, atKeyPadDevice, atTV, atMobileEmulator]; // But Forms is not in the uses clause end; function TWidgetSet.IsCDIntfControl(AWinControl: TObject): Boolean; begin Result := False; end; function TWidgetSet.MoveWindowOrgEx(dc: hdc; dX,dY: Integer): boolean; var P: TPoint; lResult: Integer; begin lResult := GetWindowOrgEx(dc, @P); if lResult <> 0 then Result:=SetWindowOrgEx(dc, P.x-dX, P.y-dY, @P) else Result := False; {$ifdef DEBUG_WINDOW_ORG} DbgAppendToFile(ExtractFilePath(ParamStr(0)) + '1.log', Format(':> [TWidgetSet.MoveWindowOrgEx] DC=%d P.x=%d P.y=%d dx=%d dy=%d lResult=%d Result=%d', [DC, P.x, P.y, dx, dy, lResult, Integer(Result)])); {$endif} end; function TWidgetSet.PromptUser(const DialogCaption, DialogMessage: String; DialogType: longint; Buttons: PLongint; ButtonCount, DefaultIndex, EscapeResult: Longint): Longint; begin if PromptDialogFunction <> nil then Result := PromptDialogFunction(DialogCaption, DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult, True, 0, 0) else Result := 0; end; function TWidgetSet.PromptUserAtXY(const DialogCaption, DialogMessage: String; DialogType: longint; Buttons: PLongint; ButtonCount, DefaultIndex, EscapeResult: Longint; X, Y: Longint): Longint; begin if PromptDialogFunction<>nil then Result := PromptDialogFunction(DialogCaption, DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult, False, X, Y) else Result := 0; end; function TWidgetSet.RadialArc(DC: HDC; left, top, right, bottom, sx, sy, ex, ey: Integer): Boolean; var A1, A2: Extended; A2i : integer; begin Coords2Angles(left, top, right-left, bottom-top, sx, sy, ex, ey, A1, A2); A2i := RoundToInt(A2); if A2i = 0 then A2i := 5760; Result := Arc(DC, left, top, right, bottom, RoundToInt(A1), A2i); end; function TWidgetSet.RadialChord(DC: HDC; x1, y1, x2, y2, sx, sy, ex, ey: Integer): Boolean; var A1, A2: Extended; A2i : integer; Begin Coords2Angles(x1, y1, x2-x1, y2-y1, sx, sy, ex, ey, A1, A2); A2i := RoundToInt(A2); if A2i = 0 then A2i := 5760; Result := AngleChord(DC, x1, y1, x2, y2, RoundToInt(A1), A2i); End; function TWidgetSet.RadialPie(DC: HDC; x1, y1, x2, y2, Angle1, Angle2: Integer): Boolean; var Points: PPoint; Count: Longint; begin Result := False; Points := nil; Count := 0; PolyBezierArcPoints(x1, y1, x2 - x1, y2 - y1, Angle1, Angle2, 0, Points, Count); Inc(Count,2); ReallocMem(Points, Count*SizeOf(TPoint)); Points[Count - 2] := CenterPoint(Rect(x1, y1, x2, y2)); Points[Count - 1] := Points[0]; Polygon(DC, Points, Count, True); ReallocMem(Points, 0); Result := True; end; function TWidgetSet.RegroupMenuItem(hndMenu: HMENU; GroupIndex: Integer): Boolean; begin Result := false; end; procedure TWidgetSet.RemoveEventHandler(var AHandler: PEventHandler); begin end; procedure TWidgetSet.RemoveProcessEventHandler(var AHandler: PProcessEventHandler); begin end; procedure TWidgetSet.RemovePipeEventHandler(var AHandler: PPipeEventHandler); begin end; function TWidgetSet.ReleaseDesignerDC(hWnd: HWND; DC: HDC): Integer; begin Result := ReleaseDC(hWnd, DC); end; function TWidgetSet.RequestInput(const InputCaption, InputPrompt: String; MaskInput: Boolean; var Value: String): Boolean; begin if InputDialogFunction<>nil then Result := InputDialogFunction(InputCaption, InputPrompt, MaskInput, Value) else Result := false; end; procedure TWidgetSet.SendCachedLCLMessages; begin end; //This routine is used only by platforms which uses Scale instead of font DPI changes (or both). //Currently cocoa, qt5, qt6 and gtk3 are known to support this. Without proper scale ratio //setup, bitmap text rendering is blurred.See iphtml.pas, procedure TIpHtml.Render() how //we use it.Param DC is device context with selected bitmap/image into. procedure TWidgetSet.SetCanvasScaleFactor(DC: HDC; const AScaleRatio: double); begin end; function TWidgetSet.SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; begin Result := False; end; function TWidgetSet.SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean; begin Result := false; end; procedure TWidgetSet.SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); begin end; procedure TWidgetSet.SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); begin end; // This routine is only for platforms which need a special combobox dialog, like Android // It returns true if a dialog was provided for doing this task or false otherwise // The process is assynchronous, so the result will be given in LCLIntf.OnShowSelectItemDialogResult function TWidgetSet.ShowSelectItemDialog(const AItems: TStrings; APos: TPoint): Boolean; begin Result := False; end; function TWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; begin Result := False; end; { TMessageDispatcher } constructor TMessageDispatcher.Create(AMethod: TLCLWndMethod); begin FMethod := AMethod; end; procedure TMessageDispatcher.Dispatch(var message); begin FMethod(TLMessage(message)); end; //##apiwiz##eps## // Do not remove