{%MainUnit fpguiint.pp} {****************************************************************************** All FPGUI Winapi implementations. This are the implementations of the overrides of the FPGUI Interface for the methods defined in the lcl/include/winapi.inc !! Keep alphabetical !! ****************************************************************************** Implementation ****************************************************************************** ***************************************************************************** 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, no wizard declaration before this line {------------------------------------------------------------------------------ Function: BeginPaint Params: Returns: This function is Called: - Once on every OnPaint event ------------------------------------------------------------------------------} function TFpGuiWidgetSet.BeginPaint(Handle: hWnd; Var PS : TPaintStruct): hdc; var PrivateWidget: TFPGUIPrivateWidget absolute Handle; DC: TFpGuiDeviceContext; begin {$ifdef VerboseFPGUIWinAPI} WriteLn('Trace:> [WinAPI BeginPaint] Handle=', dbghex(Handle)); {$endif} {$WARNING TFpGuiWidgetSet.BeginPaint Temporary Fix to prevent Crashing} (* try if PrivateWidget <> nil then DC := TFpGuiDeviceContext.Create(PrivateWidget) else DC := TFpGuiDeviceContext.Create(nil); {$ifdef VerboseFPGUIWinAPI} if PrivateWidget <> nil then WriteLn(PrivateWidget.ClassName); {$endif} except DC := TFpGuiDeviceContext.Create(nil); end; PS.hdc := HDC(DC); Result := PS.hdc; *) ps.hdc:=GetDC(Handle); {$ifdef VerboseFPGUIWinAPI} WriteLn('Trace:< [WinAPI BeginPaint] Result=', dbghex(Result)); {$endif} end; function TFpGuiWidgetSet.ClientToScreen(Handle: HWND; var P: TPoint): Boolean; var O: TFPGUIPrivateWidget absolute Handle; begin p:=TfpgWindowBase(o.Widget).WindowToScreen(TfpgWindowBase(o.Widget),p); Result:=true; end; function TFpGuiWidgetSet.CombineRgn(Dest, Src1, Src2: HRGN; fnCombineMode: Longint): Longint; var R1: TFPGUIBasicRegion absolute Src1; R2: TFPGUIBasicRegion absolute Src2; DR: TFPGUIBasicRegion absolute Dest; Combine: TFPGUIRegionCombine; begin case fnCombineMode of RGN_AND: Combine:=eRegionCombineAnd; RGN_COPY: Combine:=eRegionCombineCopy; RGN_DIFF: Combine:=eRegionCombineDiff; RGN_OR: Combine:=eRegionCombineOr; RGN_XOR: Combine:=eRegionCombineXor; end; if DR<>nil then DR.Free; DR:=R1.CombineWithRegion(R2,Combine); Case dr.RegionType of eRegionNULL: Result:=NullRegion; eRegionSimple: Result:=SimpleRegion ; eRegionComplex: Result:=ComplexRegion; eRegionNotCombinableOrError: Result:=Region_Error; end; end; function TFpGuiWidgetSet.CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; var img: TFPGUIWinAPIBitmap; begin if BitCount>0 then begin img:=TFPGUIWinAPIBitmap.Create(BitCount,Width,Height); Result:=HBITMAP(img); end else begin Result:=0; end; end; function TFpGuiWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush ): HBRUSH; begin Result:=HBRUSH(TFPGUIWinAPIBrush.Create(LogBrush)); end; function TFpGuiWidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer ): HBITMAP; var img: TFPGUIWinAPIBitmap; begin img:=TFPGUIWinAPIBitmap.Create(32,Width,Height); Result:=HBITMAP(img); end; function TFpGuiWidgetSet.CreateCompatibleDC(DC: HDC): HDC; var ADC: TFpGuiDeviceContext absolute DC; begin {$ifdef VerboseFPGUIWinAPI} if DC=0 then begin WriteLn(Self.ClassName,'.CreateCompatibleDC ','NULL'); end else begin if ADC.FPrivateWidget<>nil then begin WriteLn(Self.ClassName,'.CreateCompatibleDC ',ADC.FPrivateWidget.LCLObject.Name); end else begin WriteLn(Self.ClassName,'.CreateCompatibleDC ','Desktop'); end; end; {$endif} if DC=0 then begin //Create DC desktop compatible, or retrieve the destop one to avoid memory leask. Result:=HDC(FPGUIGetDesktopDC()); end else begin //Create DC widget compatible Result:=HDC(TFpGuiDeviceContext.Create(ADC.FPrivateWidget)); end; end; function TFpGuiWidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT; begin Result:=HFONT(TFPGUIWinAPIFont.Create(LogFont)); end; function TFpGuiWidgetSet.CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; begin Result:=HFONT(TFPGUIWinAPIFont.Create(LogFont,LongFontName)); end; function TFpGuiWidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN; begin Result:=HPEN(TFPGUIWinAPIPen.Create(LogPen)); end; function TFpGuiWidgetSet.CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; var Reg: TFPGUIBasicRegion; begin Reg:=TFPGUIBasicRegion.Create(Rect(X1,Y1,X2,Y2)); Result:=HRGN(Reg); end; function TFpGuiWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean; begin if IsValidGDIObject(GDIObject) then begin TObject(GDIObject).Free; Result:=true; end else begin Result:=false; end; end; function TFpGuiWidgetSet.DrawFocusRect(DC: HDC; const Rect: TRect): boolean; var ADC: TFpGuiDeviceContext absolute DC; r: TfpgRect; begin ADC.fpgCanvas.DrawFocusRect(ADC.PrepareRectOffsets(Rect)); Result:=true; end; function TFpGuiWidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer; var ARect: TRect; Flags: Cardinal): Integer; var ADC: TFpGuiDeviceContext absolute DC; begin ADC.fpgCanvas.Font:=ADC.FFont.fpguiFont; Result:=inherited DrawText(DC, Str, Count, ARect, Flags); if (Flags and DT_CALCRECT)=0 then begin ADC.fpgCanvas.TextColor:=ADC.FTextColor; ADC.fpgCanvas.DrawText(ADC.PrepareRectOffsets(ARect),Str,[],0); end; Result:=ARect.Bottom-ARect.Top; //The height of the text. end; function TFpGuiWidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean; var ADC: TFpGuiDeviceContext;// absolute DC; j: integer; OldColor: TfpgColor; r: TfpgRect; RR: TRect; begin ADC:=TFPGUIDeviceContext(DC); r:=ADC.PrepareRectOffsets(Rect(x1,y1,x2,y2)); TfpgRectToRect(r,RR); if not ADC.UseBrush then begin if ADC.UsePen then begin ADC.fpgCanvas.DrawArc(rr.Left,rr.Top,x2-x1,y2-y1,0,360); end; end else begin ADC.fpgCanvas.FillArc(rr.Left,rr.Top,x2-x1,y2-y1,0,360); if ADC.UsePen then begin ADC.fpgCanvas.DrawArc(rr.Left,rr.Top,x2-x1,y2-y1,0,360); end; end; Result:=true; end; function TFpGuiWidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; var Widget: TFPGUIPrivateWidget absolute hWnd; begin Result:=not Widget.Enabled; Widget.Enabled:=bEnable; end; function TFpGuiWidgetSet.EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer; var DC: TFpGuiDeviceContext; begin // DC := TFpGuiDeviceContext(PS.hdc); ReleaseDC(Handle,PS.hdc); Result:=1; //Any non zero value. end; function TFpGuiWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; var ADC: TFpGuiDeviceContext absolute DC; AStr: string; r: TfpgRect; rClip,OldClip: TfpgRect; RestoreClip: Boolean; begin SetLength(AStr,Count); move(Str[0],AStr[1],Count); r:=ADC.PrepareRectOffsets(classes.Rect(X,Y,0,0)); RestoreClip:=false; if Rect<>nil then begin rClip:=fpgRect(Rect^.Left,Rect^.Top,Rect^.Right-Rect^.Left,Rect^.Bottom-Rect^.Top); if (ETO_CLIPPED or ETO_OPAQUE) and Options <> 0 then begin OldClip:=ADC.fpgCanvas.GetClipRect; ADC.fpgCanvas.SetClipRect(rClip); RestoreClip:=true; end; if ETO_OPAQUE and Options = ETO_OPAQUE then begin ADC.ClearRectangle(rClip); end; end; ADC.fpgCanvas.TextColor:=ADC.FTextColor; ADC.fpgCanvas.Font:=ADC.FFont.fpguiFont; ADC.fpgCanvas.DrawText(r.Left, r.Top, AStr); if RestoreClip then begin ADC.fpgCanvas.SetClipRect(OldClip); end; Result:=true; end; function TFpGuiWidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH ): Boolean; var ADC: TFpGuiDeviceContext; NewBrush: TFPGUIWinAPIBrush; TheRect: TfpgRect; begin ADC:=TFPGUIDeviceContext(DC); NewBrush:=TFPGUIWinAPIBrush(Brush); TheRect:=ADC.PrepareRectOffsets(Rect); ADC.fpgCanvas.Color:=NewBrush.Color; ADC.fpgCanvas.FillRectangle(TheRect); Result:=true; end; function TFpGuiWidgetSet.GetCapture: HWND; begin Result:=HWND(GlobalMouseCapturedPrivateWidget); end; function TFpGuiWidgetSet.GetClientRect(handle: HWND; var ARect: TRect ): Boolean; var fpguiPrivate: TFPGUIPrivateWidget absolute handle; begin fpguiPrivate.GetClientRect(ARect); Result:=true; end; function TFpGuiWidgetSet.GetClipBox(DC: hDC; lpRect: PRect): Longint; var ADC: TFpGuiDeviceContext absolute DC; Clip: TfpgRect; begin ADC.fpgCanvas.GetWinRect(Clip); { TODO : Should be a clip region, but use this by now } Result:=SimpleRegion; TfpgRectToRect(Clip,lpRect^); end; function TFpGuiWidgetSet.GetClipRGN(DC: hDC; RGN: hRGN): Longint; var ADC: TFpGuiDeviceContext absolute DC; Clip: TfpgRect; Region: TFPGUIBasicRegion absolute RGN; begin ADC.fpgCanvas.GetWinRect(Clip); { TODO : Should be a clip region, but use this by now } if Region<>nil Then FreeAndNil(Region); Region:=TFPGUIBasicRegion.Create(Rect(Clip.Left,Clip.Top,Clip.Right,Clip.Bottom)); RGN:=HRGN(Region); if Region.RegionType=eRegionNULL then begin Result:=0; end else if Region.RegionType=eRegionNotCombinableOrError then begin Result:=-1; end else begin Result:=1; end; end; function TFpGuiWidgetSet.GetCursorPos(var lpPoint: TPoint): Boolean; var O: TFPGUIPrivateWidget; alPoint: TPoint; begin // TODO: Fix it cross platform style Result:=fpguicrosshelpers.GetCursorPos(lpPoint); end; function TFpGuiWidgetSet.GetDC(hWnd: HWND): HDC; var PrivateWidget: TFPGUIPrivateWidget; begin //Create a new DC PrivateWidget:=TFPGUIPrivateWidget(hWnd); if Assigned(PrivateWidget) then begin Result:=HDC(TFpGuiDeviceContext.Create(PrivateWidget)); end else begin Result:=HDC(FPGUIGetDesktopDC()); end; end; function TFpGuiWidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer; var ADC: TFpGuiDeviceContext absolute DC; begin if ADC.FPrivateWidget=nil then begin //Desktop device caps { TODO : Create real data for GetDeviceCaps } Case Index of LOGPIXELSX: Result:=96; //Hardcoded by now BITSPIXEL : Result:=32; //Hardcoded by now else begin {$ifdef VerboseFPGUIWinAPI} WriteLn(Self.ClassName,'.GetDeviceCaps Index ',Index,' Desktop'); {$endif} end; end; end else begin //other {$ifdef VerboseFPGUIWinAPI} WriteLn(Self.ClassName,'.GetDeviceCaps Index ',Index,ADC.FPrivateWidget.LCLObject.Name); {$endif} end; end; function TFpGuiWidgetSet.GetFocus: HWND; begin Result:=HWND(GlobalFocusedPrivateWidget); end; function TFpGuiWidgetSet.GetProp(Handle: hwnd; Str: PChar): Pointer; var PrivateWidget: TFPGUIPrivateWidget absolute Handle; begin if Assigned(PrivateWidget) and (Str='WinControl') then begin Result:=PrivateWidget.LCLObject; end else begin {$ifdef VerboseFPGUIWinAPI} WriteLn('Trace:Unknown Window property: ',Str); {$endif} Result:=nil; end; end; function TFpGuiWidgetSet.GetSysColor(nIndex: Integer): DWORD; begin if (nIndex < 0) or (nIndex > MAX_SYS_COLORS) then begin {$ifdef VerboseFPGUIWinAPI} WriteLn('Trace:Unknown lcl system color: [TFpGuiWidgetSet.GetSysColor]'); {$endif} Result:=clRed; exit; end; Result:=GetSysColorRGB(nIndex); end; function TFpGuiWidgetSet.GetSystemMetrics(nIndex: Integer): Integer; begin case nIndex of //Current screen size SM_CXSCREEN: Result:=fpgApplication.ScreenWidth; SM_CYSCREEN: Result:=fpgApplication.ScreenHeight; //Desktop size SM_CXVIRTUALSCREEN: Result:=fpgApplication.ScreenWidth; SM_CYVIRTUALSCREEN: Result:=fpgApplication.ScreenHeight; end; end; function TFpGuiWidgetSet.GetTextColor(DC: HDC): TColorRef; var ADC: TFpGuiDeviceContext absolute DC; begin Result:=ADC.GetTextColor; end; function TFpGuiWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; var ADC: TFpGuiDeviceContext absolute DC; begin Size.cx:=ADC.FFont.fpguiFont.TextWidth(Str); Size.cy:=ADC.FFont.fpguiFont.Height; Result:=true; end; function TFpGuiWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; var ADC: TFpGuiDeviceContext absolute DC; begin FillByte(TM,sizeof(TM),0); TM.tmAscent:=ADC.FFont.fpguiFont.Ascent; TM.tmDescent:=ADC.FFont.fpguiFont.Descent; //Defined usually in MSDN as the average of 'x' char. TM.tmAveCharWidth:=ADC.FFont.fpguiFont.TextWidth('x'); TM.tmHeight:=ADC.FFont.fpguiFont.Height; Result:=true; end; function TFpGuiWidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer; var ADC: TFpGuiDeviceContext absolute DC; begin P^:=ADC.FOrg; Result:=1; end; function TFpGuiWidgetSet.GetWindowRect(Handle: hwnd; var ARect: TRect ): Integer; var PrivateWidget: TFPGUIPrivateWidget absolute Handle; begin PrivateWidget.GetWindowRect(ARect); Result:=1; end; function TFpGuiWidgetSet.GetWindowSize(Handle: hwnd; var Width, Height: Integer ): boolean; var PrivateWidget: TFPGUIPrivateBin; begin PrivateWidget:=TFPGUIPrivateBin(Handle); Width:=PrivateWidget.Widget.Width; Height:=PrivateWidget.Widget.Height; Result:=true; end; function TFpGuiWidgetSet.InvalidateRect(aHandle: HWND; Rect: pRect; bErase: Boolean): Boolean; var PrivateWidget: TFPGUIPrivateWidget absolute aHandle; begin // PrivateWidget.Widget.Canvas.BeginDraw(true); PrivateWidget.Invalidate; // PrivateWidget.Widget.Canvas.EndDraw; Result:=true; end; function TFpGuiWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; var ADC: TFpGuiDeviceContext;// absolute DC; r: TPoint; begin ADC:=TFPGUIDeviceContext(DC); r:=ADC.PreparePointOffsets(Point(x,y)); if OldPoint<>nil then OldPoint^:=ADC.UnPreparePointOffsets(ADC.FDrawXY); ADC.FDrawXY:=r; end; function TFpGuiWidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean; var ADC: TFpGuiDeviceContext;// absolute DC; p: TPoint; begin ADC:=TFPGUIDeviceContext(DC); p:=ADC.PreparePointOffsets(Point(X,Y)); if ADC.UsePen then begin ADC.fpgCanvas.DrawLine(ADC.FDrawXY.x,ADC.FDrawXY.y,p.x,p.y); end; ADC.FDrawXY:=p; Result:=true; end; { Most of the functionality is implemented. As described in MSDN: http://msdn.microsoft.com/en-us/library/windows/desktop/ms645505%28v=vs.85%29.aspx } function TFpGuiWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer; var Str: AnsiString; TitleStr: AnsiString; Buttons : TfpgMsgDlgButtons; BtnType: Cardinal; DlgType: Cardinal; begin BtnType := (uType and $0000000F); { mask the button type } if (BtnType = MB_OKCANCEL) then Buttons := mbOKCancel else if (BtnType = MB_ABORTRETRYIGNORE) then Buttons := mbAbortRetryIgnore else if (BtnType = MB_YESNOCANCEL) then Buttons := mbYesNoCancel else if (BtnType = MB_YESNO) then Buttons := mbYesNo else if (BtnType = MB_RETRYCANCEL) then Buttons := [mbRetry, mbCancel] else if (BtnType = MB_CANCELTRYCONTINUE) then Buttons := mbAbortRetryIgnore else Buttons := [mbOK]; { shoud we had a Help button too? - again as per MSDN } if (uType and MB_HELP) = MB_HELP then Include(Buttons, mbHelp); Str := lpText; TitleStr := lpCaption; if lpCaption = nil then TitleStr := 'Error'; // as per MSDN DlgType := (uType and $000000F0); { mask the dialog type } if (DlgType and MB_ICONINFORMATION) = MB_ICONINFORMATION then TfpgMessageDialog.Information(TitleStr, Str, Buttons) else if (DlgType and MB_ICONWARNING) = MB_ICONWARNING then TfpgMessageDialog.Warning(TitleStr, Str, Buttons) else if (DlgType and MB_ICONQUESTION) = MB_ICONQUESTION then TfpgMessageDialog.Question(TitleStr, Str, Buttons) else if (DlgType and MB_ICONERROR) = MB_ICONERROR then TfpgMessageDialog.Critical(TitleStr, Str, Buttons) else TfpgMessageDialog.Information(TitleStr, Str, Buttons); end; function TFpGuiWidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: boolean): boolean; var ADC: TFpGuiDeviceContext;// absolute DC; lPoints: array of TPoint; j: integer; begin ADC:=TFPGUIDeviceContext(DC); SetLength(lPoints,NumPts+1); for j := 0 to Pred(NumPts) do begin lPoints[j]:=ADC.PreparePointOffsets(Points[j]); end; lPoints[NumPts]:=lPoints[0]; if not ADC.UseBrush then begin if ADC.UsePen then begin ADC.fpgCanvas.DrawPolyLine(lPoints); end; end else begin ADC.fpgCanvas.DrawPolygon(@lPoints[0],NumPts,Winding); if ADC.UsePen then begin ADC.fpgCanvas.DrawPolyLine(lPoints); end; end; Result:=true; end; function TFpGuiWidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer ): boolean; var ADC: TFpGuiDeviceContext;// absolute DC; lPoints: array of TPoint; j: integer; begin ADC:=TFPGUIDeviceContext(DC); SetLength(lPoints,NumPts); for j := 0 to Pred(NumPts) do begin lPoints[j]:=ADC.PreparePointOffsets(Points[j]); end; if ADC.UsePen then begin ADC.fpgCanvas.DrawPolyLine(lPoints); end; Result:=true; end; function TFpGuiWidgetSet.SendMessage(HandleWnd: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; var lMessageParams: TfpgMessageParams; lNewMsg: integer; begin FillByte(lMessageParams,Sizeof(lMessageParams),0); case msg of LM_USER..LM_USER+$7FFF: begin lNewMsg:=FPGM_USER; lMessageParams.user.Param1:=(msg-LM_USER); lMessageParams.user.Param2:=wParam; lMessageParams.user.Param3:=lParam; end; otherwise // This needs a lot of conversion between Windows messages and fpGUI messages. Result:=0; exit; end; fpgSendMessage(nil,TFPGUIPrivateWidget(HandleWnd),lNewMsg,lMessageParams); Result:=0; end; function TFpGuiWidgetSet.PostMessage(Handle: HWND; Msg: Cardinal; wParam: WParam; lParam: LParam): Boolean; var lMessageParams: TfpgMessageParams; lNewMsg: integer; begin FillByte(lMessageParams,Sizeof(lMessageParams),0); case msg of LM_USER..LM_USER+$7FFF: begin lNewMsg:=FPGM_USER; lMessageParams.user.Param1:=(msg-LM_USER); lMessageParams.user.Param2:=wParam; lMessageParams.user.Param3:=lParam; end; otherwise // This needs a lot of conversion between Windows messages and fpGUI messages. Result:=false; exit; end; fpgPostMessage(nil,TFPGUIPrivateWidget(Handle),lNewMsg,lMessageParams); fpgDeliverMessages; // Force message loop to deliver messages as // the post message seems to not wakeup the queue. Result:=true; end; function TFpGuiWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; var ADC: TFpGuiDeviceContext;// absolute DC; r: TfpgRect; begin ADC:=TFPGUIDeviceContext(DC); r:=ADC.PrepareRectOffsets(Rect(X1,Y1,X2,Y2)); if not ADC.UseBrush then begin if ADC.UsePen then begin ADC.fpgCanvas.DrawRectangle(r); end; end else begin ADC.fpgCanvas.FillRectangle(r); if ADC.UsePen then begin ADC.fpgCanvas.DrawRectangle(r); end; end; Result:=true; end; function TFpGuiWidgetSet.ReleaseCapture: Boolean; begin if Assigned(GlobalMouseCapturedPrivateWidget) then begin GlobalMouseCapturedPrivateWidget.Widget.ReleaseMouse; GlobalMouseCapturedPrivateWidget:=nil; Result:=true; end else begin Result:=false; end; end; function TFpGuiWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer; var MyDC: TFpGuiDeviceContext; MyPrivateWidget: TFPGUIPrivateWidget; begin MyDC:=TFPGUIDeviceContext(DC); if MyDC<>FPGUIGetDesktopDC then begin //DesktopDC can not be freed MyPrivateWidget:=TFPGUIPrivateWidget(hWnd); FreeAndNil(MyDC); end; Result:=1; end; function TFpGuiWidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean; var ADC: TFPGUIDeviceContext absolute DC; begin Result:=ADC.RestoreDC(SavedDC); end; function TFpGuiWidgetSet.SaveDC(DC: HDC): Integer; var ADC: TFPGUIDeviceContext absolute DC; begin Result:=ADC.SaveDC; end; function TFpGuiWidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint; var ADC: TFPGUIDeviceContext absolute DC; Reg: TFPGUIBasicRegion absolute RGN; begin if Reg.RegionType=eRegionSimple then begin ADC.SelectObject(HGDIObj(Reg)); Result:=SimpleRegion; end else begin Result:=NullRegion; end; end; function TFpGuiWidgetSet.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; var MyDC: TFpGuiDeviceContext absolute DC; begin Result:=MyDC.SelectObject(GDIObj); end; function TFpGuiWidgetSet.SetCapture(AHandle: HWND): HWND; var PrivateWidget: TFPGUIPrivateWidget absolute AHandle; begin Result:=HWND(GlobalMouseCapturedPrivateWidget); if Assigned(GlobalMouseCapturedPrivateWidget) then begin ReleaseCapture; end; if Assigned(PrivateWidget) then begin PrivateWidget.Widget.CaptureMouse; end; GlobalMouseCapturedPrivateWidget:=PrivateWidget; end; function TFpGuiWidgetSet.SetFocus(hWnd: HWND): HWND; var PrivateWidget: TFPGUIPrivateWidget absolute hWnd; begin Result:=LCLType.HWND(PrivateWidget.Widget.ActiveWidget); PrivateWidget.SetFocus; end; function TFpGuiWidgetSet.SetParent(hWndChild: HWND; hWndParent: HWND): HWND; var PrivateWidgetParent: TFPGUIPrivateWidget absolute hWndParent; PrivateWidgetChild: TFPGUIPrivateWidget absolute hWndChild; begin Result:=HWND(PrivateWidgetChild.Widget.Parent); PrivateWidgetChild.Widget.Parent:=PrivateWidgetParent.Widget; end; function TFpGuiWidgetSet.SetScrollInfo(Handle: HWND; SBStyle: Integer; ScrollInfo: TScrollInfo; bRedraw: Boolean): Integer; var PrivateWidget: TFPGUIPrivateWidget absolute Handle; ScrollWin: TFPGUIPrivateScrollingWinControl; begin Result:=0; if PrivateWidget is TFPGUIPrivateScrollingWinControl then begin ScrollWin:=TFPGUIPrivateScrollingWinControl(PrivateWidget); if ScrollInfo.fMask and SIF_RANGE = SIF_RANGE then begin if SBStyle=1 then begin ScrollWin.ScrollFrame.ContentFrame.Height:=ScrollInfo.nMax-ScrollInfo.nMin; Result:=-ScrollWin.ScrollFrame.ContentFrame.Left; end; if SBStyle=0 then begin ScrollWin.ScrollFrame.ContentFrame.Width:=ScrollInfo.nMax-ScrollInfo.nMin; Result:=-ScrollWin.ScrollFrame.ContentFrame.Top; end; end; end; end; function TFpGuiWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef; var ADC: TFpGuiDeviceContext;// absolute DC; begin ADC:=Tfpguidevicecontext(DC); Result:=ADC.SetTextColor(Color); end; function TFpGuiWidgetSet.SetWindowOrgEx(DC: HDC; NewX, NewY: Integer; OldPoint: PPoint): Boolean; var ADC: TFpGuiDeviceContext absolute DC; begin OldPoint^:=ADC.FOrg; ADC.SetOrigin(NewX,NewY); Result:=true; end; function TFpGuiWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; var Widget: TFPGUIPrivateWidget absolute hWnd; begin Result:=Widget.Visible; Widget.Visible:=true;{ TODO -oJose Mejuto : Process showwindow mode } end; function TFpGuiWidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal ): Boolean; var SDC: TFPGUIDeviceContext absolute SrcDC; TDC: TFPGUIDeviceContext absolute DestDC; begin Result:=false; end; function TFpGuiWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; var SDC: TFPGUIDeviceContext; TDC: TFPGUIDeviceContext; pTarget: TPoint; begin // Incomplete, partial source, masks and ROP not implemented. SDC:=TFPGUIDeviceContext(SrcDC); TDC:=TFPGUIDeviceContext(DestDC); pTarget:=Point(x,y); pTarget:=TDC.PreparePointOffsets(pTarget); TDC.ClearDC; if Assigned(SDC.FBitmap) then begin TDC.fpgCanvas.StretchDraw(pTarget.x,pTarget.y,Width,Height,SDC.FBitmap.Image); end; Result:=true; end; function TFpGuiWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; begin case uiAction of SPI_GETWORKAREA: begin PRect(pvPAram)^.Left:=0; PRect(pvPAram)^.Top:=0; PRect(pvPAram)^.Right:=fpgApplication.ScreenWidth; PRect(pvPAram)^.Bottom:=fpgApplication.ScreenHeight; Result := True; end; otherwise Result:=inherited SystemParametersInfo(uiAction, uiParam, pvParam, fWinIni); end; end; function TFpGuiWidgetSet.WindowFromPoint(Point: TPoint): HWND; begin { TODO : Temporal hack while not real WindowFromPoint implementation } Result:=HWND(GlobalMouseCursorPosPrivateWidget); end; function TFpGuiWidgetSet.CreateStandardCursor(ACursor: SmallInt): hCursor; var CursorValue: Integer; begin Result := 0; if ACursor < crLow then Exit; if ACursor > crHigh then Exit; case TCursor(ACursor) of crDefault: CursorValue := integer(mcDefault); crArrow: CursorValue := integer(mcArrow); crCross: CursorValue := integer(mcCross); crIBeam: CursorValue := integer(mcIBeam); crSizeNESW: CursorValue := integer(mcSizeNESW); crSizeNS: CursorValue := integer(mcSizeNS); crSizeNWSE: CursorValue := integer(mcSizeNWSE); crSizeWE: CursorValue := integer(mcSizeEW); crSizeNW: CursorValue := integer(mcSizeNWSE); crSizeN: CursorValue := integer(mcSizeNS); crSizeNE: CursorValue := integer(mcSizeNESW); crSizeW: CursorValue := integer(mcSizeEW); crSizeE: CursorValue := integer(mcSizeEW); crSizeSW: CursorValue := integer(mcSizeSWNE); crSizeS: CursorValue := integer(mcSizeNS); crSizeSE: CursorValue := integer(mcSizeSENW); crUpArrow: CursorValue := integer(mcArrow); crHourGlass:CursorValue := integer(mcHourGlass); crHSplit: CursorValue := integer(mcSizeEW); crVSplit: CursorValue := integer(mcSizeNS); // crAppStart: CursorValue := integer(mcAppStart); // crHelp: CursorValue := integer(mcHelp); crHandPoint:CursorValue := integer(mcHand); crSizeAll: CursorValue := integer(mcSizeNESW); otherwise CursorValue:=-1; end; if CursorValue<>-1 then begin Result := hCursor(CursorValue); end; end; //##apiwiz##eps## // Do not remove, no wizard declaration after this line