{%MainUnit ../interfacebase.pp} { $Id$ } {****************************************************************************** TWidgetSet WinApi stuff !! In this file only winapi related code as defined in winapih.inc Most routines implement only the default !! Keep this alphabetical !! ****************************************************************************** ***************************************************************************** * * * This file is part of the Lazarus Component Library (LCL) * * * * See the file COPYING.LCL, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } //##apiwiz##sps## // Do not remove function TWidgetSet.Arc(DC: HDC; Left,Top,width,height,angle1,angle2 : Integer): Boolean; var Points : PPoint; Count : Longint; begin Result := False; Points := nil; Count := 0; PolyBezierArcPoints(Left,Top,Width,Height,Angle1, Angle2, 0, Points, Count); Polygon(DC, Points, Count, False); ReallocMem(Points, 0); Result := True; end; function TWidgetSet.AngleChord(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean; var Points : PPoint; Count : Longint; begin Result := False; Points := nil; Count := 0; PolyBezierArcPoints(X,Y,Width,Height,Angle1, Angle2, 0, Points, Count); Inc(Count); ReallocMem(Points, Count*SizeOf(TPoint)); Points[Count - 1] := Points[0]; Polygon(DC, Points, Count, True); ReallocMem(Points, 0); Result := True; end; function TWidgetSet.BeginPaint(Handle: hWnd; Var PS: TPaintStruct): hdc; begin Result:=GetDC(Handle); end; function TWidgetSet.BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; begin Result := False; end; Function TWidgetSet.BringWindowToTop(hWnd : HWND): Boolean; begin Result := false; end; function TWidgetSet.CallNextHookEx(hhk : HHOOK; ncode : Integer; WParam: WParam; LParam: LParam) : Integer; begin Result := 0; end; function TWidgetSet.CallWindowProc(lpPrevWndFunc: TFarProc; Handle: HWND; Msg: UINT; WParam: WParam; LParam: LParam): Integer; begin Result:=0; end; Function TWidgetSet.ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean; Begin Result := False; end; Function TWidgetSet.CombineRgn(Dest, Src1, Src2 : HRGN; fnCombineMode : Longint) : Longint; begin Result := ERROR; end; function TWidgetSet.CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; begin Result := 0; end; function TWidgetSet.CreateDIBitmap(DC: HDC; var InfoHeader: TBitmapInfoHeader; dwUsage: DWORD; InitBits: PChar; var InitInfo: TBitmapInfo; wUsage: UINT): HBITMAP; begin Result := 0; end; function TWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; begin Result := 0; end; function TWidgetSet.CreateCaret(Handle : HWND; Bitmap : hBitmap; width, Height : Integer) : Boolean; begin Result := False; end; function TWidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; begin Result := 0; end; function TWidgetSet.CreateCompatibleDC(DC: HDC): HDC; begin Result := 0; end; function TWidgetSet.CreateDIBSection(DC: HDC; const BitmapInfo: tagBitmapInfo; Usage: UINT; var Bits: Pointer; SectionHandle: THandle; Offset: DWORD): HBITMAP; begin Result := 0; end; function TWidgetSet.CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; begin Result:=ERROR; DebugLn('WARNING: CreateEllipticRgn not yet implemented.'); end; function TWidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT; begin Result := 0; end; function TWidgetSet.CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; begin // this functions is needed, because the fontname in TLogFont is limited to // 32 characters. If the interface does not support long font names, it can // simple omit this function Result := CreateFontIndirect(LogFont); end; function TWidgetSet.CreatePalette(const LogPalette: TLogPalette): HPalette; begin Result := 0; end; function TWidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN; begin Result := 0; end; function TWidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; Begin Result := 0; end; function TWidgetSet.CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; begin Result := 0; end; procedure TWidgetSet.DeleteCriticalSection(var CritSection: TCriticalSection); begin DebugLn('TWidgetSet.DeleteCriticalSection Not implemented yet'); end; function TWidgetSet.DeleteDC(hDC: HDC): Boolean; begin Result := False; end; function TWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean; begin Result := False; end; function TWidgetSet.DestroyCaret(Handle : HWND): Boolean; begin Result := False; end; function TWidgetSet.DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean; begin Result := False; end; function TWidgetSet.DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; Begin Result := False; end; function TWidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer; var AP : TSize; TM : TTextmetric; theRect : TRect; aLeft,aTop, I : Integer; Lines : TStrings; TDC : hDC; pStr : PChar; tmpString, AStr : String; pIndex, pX1, pX2, pY : Longint; B, P : Longint; LogP : TLogPen; MaxLength : Integer; Pt : TPoint; Function LeftOffset : Longint; begin If (Flags and DT_Right) = DT_Right then Result := DT_Right else If (Flags and DT_CENTER) = DT_CENTER then Result := DT_CENTER else Result := DT_LEFT; end; Function TopOffset : Longint; begin If (Flags and DT_BOTTOM) = DT_BOTTOM then Result := DT_BOTTOM else If (Flags and DT_VCENTER) = DT_VCENTER then Result := DT_VCENTER else Result := DT_Top; end; Function SingleLine : Boolean; begin Result := (Flags and DT_SingleLine) = DT_SingleLine; end; Function WordWrap : Boolean; begin Result := (Flags and DT_WordBreak) = DT_WordBreak; end; Function CalcRect : Boolean; begin Result := (Flags and DT_CalcRect) = DT_CalcRect; end; Function NOCLIP : Boolean; begin Result := (Flags and DT_NOCLIP) = DT_NOCLIP; end; Function NoPrefix : Boolean; begin Result := (Flags and DT_NoPrefix) = DT_NoPrefix; end; Function Breakable(Breaks : TList; Index : Integer) : Boolean; begin If not Assigned(Breaks) then exit; Result := Breaks.IndexOf(Pointer(PtrInt(Index))) <> -1; end; Function NextBreakable(Breaks : TList; Index : Integer) : Integer; begin Result := -1; If (not Assigned(Breaks)) or (not Breakable(Breaks,Index)) then exit; If Breaks.IndexOf(Pointer(PtrInt(Index))) >= Breaks.Count - 1 then exit; Result := Ptrint(Breaks[Breaks.IndexOf(Pointer(PtrInt(Index))) + 1]); end; Function GetBreakablePoints(const Source : String) : TList; var I : Integer; begin Result := TList.Create; If Length(Source) < 1 then exit; For I := 1 to Length(Source) do If Source[I] = ' ' then If not Breakable(Result, I) then Result.Add(Pointer(PtrInt(I))); If not Breakable(Result, Length(Source)) then Result.Add(Pointer(PtrInt(Length(Source)))); If not Breakable(Result, 0) then Result.Insert(0,nil); end; Function TextExtent(Handle : hDC; const Source : String) : TSize; var pStr : PChar; begin pStr := StrAlloc(Length(Source)+1); try StrPCopy(pStr, Source); GetTextExtentPoint(Handle, pStr, Length(Source), Result); finally StrDispose(PStr); end; end; Function GetStringLength(Handle : hDC; const Source : String; FromPos, ToPos : Integer) : Integer; var Tmp : String; begin Tmp := Copy(Source,FromPos,ToPos - FromPos); Result := TextExtent(Handle, Tmp).cX; SetLength(Tmp,0); end; Function GetStringHeight(Handle : hDC; const Source : String; FromPos, ToPos : Integer) : Integer; var Tmp : String; begin Tmp := Copy(Source,FromPos,ToPos - FromPos); Result := TextExtent(Handle,Tmp).cY; SetLength(Tmp,0); end; Function BreakString(const Source : String) : TStrings; var I, FromPos, ToPos : Integer; Breaks : TList; begin Result := TStringList.Create; Breaks := GetBreakablePoints(Source); If Breaks.Count <= 0 then begin Result.Append(Source); Breaks.Free; exit; end; FromPos := 1; ToPos := 0; I := 1; Repeat If Breakable(Breaks,I) then begin If NextBreakable(Breaks,I) <> -1 then begin TmpString := Copy(Source, FromPos, NextBreakable(Breaks,I)); If not NoPrefix then DeleteAmpersands(tmpString); If TextExtent(DC, TmpString).cX > MaxLength then begin ToPos := I; Result.Append(Copy(Source,FromPos,ToPos - FromPos + 1)); FromPos := ToPos + 1; I := FromPos; end Else I := NextBreakable(Breaks,I); end else begin ToPos := I; Result.Append(Copy(Source,FromPos,ToPos - FromPos + 1)); FromPos := ToPos + 1; I := FromPos; end; end else I := I + 1; until I > Length(Source); SetLength(TmpString,0); Breaks.Free; end; Function DoBreakString(const AStr : String) : TStrings; var TS : TStrings; Num : Longint; OldText, NewText : String; begin Result := TStringList.Create; If not SingleLine then begin OldText := AStr; Num := pos(#10,OldText); while Num > 0 do begin NewText := Copy(OldText,1,Num); Case OldText[Num] of #13,#10 : Delete(NewText,Num,1); end; If Num -1 > 0 then Case OldText[Num-1] of #13,#10 : Delete(NewText,Num-1,1); end; If WordWrap then begin TS := BreakString(Copy(NewText,1,Length(NewText))); Result.AddStrings(TS); TS.Free; end else Result.Append(Copy(NewText,1,Length(NewText))); Delete(OldText,1,Num); Num := pos(#10,OldText); SetLength(NewText,0); end; if OldText <> '' then If WordWrap then begin TS := BreakString(Copy(OldText,1,Length(OldText))); Result.AddStrings(TS); TS.Free; end else Result.Append(Copy(OldText,1,Length(OldText))); end else Result.Append(AStr); end; Procedure CalcTextRect; var J, wT,hT : Integer; begin Rect:=theRect; {Initialize text width/height} wT := Tm.tmAveCharWidth*StrLen(Str); hT := TM.tmHeight; If Lines.Count = 1 then begin {Get text width/height if only one line} AStr := Lines[0]; If not NoPrefix then DeleteAmpersands(aStr); hT := TM.tmHeight; wT := GetStringLength(DC, AStr,1, Length(AStr) + 1); end else begin {Get text width/height if more than one line} hT := hT* (Lines.Count); wT := 0; For J := 0 to Lines.Count - 1 do begin AStr := Lines[J]; If not NoPrefix then DeleteAmpersands(aStr); If wT < GetStringLength(DC, AStr,1, Length(AStr) + 1) then wT := GetStringLength(DC, AStr,1, Length(AStr) + 1); end; end; theRect.Right := theRect.Left + wT; If not CalcRect then Case LeftOffset of DT_CENTER : OffsetRect(theRect, (Rect.Right - theRect.Right) div 2, 0); DT_Right : OffsetRect(theRect, Rect.Right - theRect.Right, 0); end; theRect.Bottom := theRect.Top + hT; {If SingleLine allow vertical offset} If not CalcRect then If SingleLine then Case TopOffset of DT_VCENTER : OffsetRect(theRect, 0, (Rect.Bottom - theRect.Bottom) div 2); DT_Bottom : OffsetRect(theRect, 0, Rect.Bottom - theRect.Bottom); end; end; begin Result := 0; Lines := nil; {Get accurate string length, if none was given} If Count < 0 then Count := StrLen(Str); {Calculate # Lines, etc.} pStr := StrAlloc(Count + 1); try StrLCopy(pStr, Str, Count); pStr[Count] := #0; AStr := String(pStr); tmpString := Copy(AStr, 1, Length(ASTR)); {Get font & string metrics} GetTextMetrics(DC, TM); If not NoPrefix then DeleteAmpersands(tmpString); If tmpString > '' then begin AP:=TextExtent(DC, tmpString); AP.cX := AP.cX div Length(tmpString); end else begin AP.cY := TM.tmHeight; AP.cX := TM.tmAveCharWidth; end; {Break string into individual lines} MaxLength := (Rect.Right - Rect.Left); Lines := DoBreakString(AStr); finally StrDispose(pStr); end; {Error occcured...} If Lines = nil then exit; {Calculate the text's bounding rect} CalcTextRect; {If just calculating rect, finish up here} If CalcRect then begin theRect:=Rect; Lines.Free; exit; end; {Backup device-context} TDC := SaveDC(DC); {Set clipping area if enabled} If not NOCLIP then begin If theRect.Right > Rect.Right then theRect.Right := Rect.Right; If theRect.Bottom > Rect.Bottom then theRect.Bottom := Rect.Bottom; IntersectClipRect(DC, theRect.Left, theRect.Top, theRect.Right, theRect.Bottom); end; {Select NULL brush} B := SelectObject(DC, GetStockObject(NULL_BRUSH)); {Create & select pen of font color} LogP.lopnStyle := PS_SOLID; LogP.lopnWidth.X := 1; LogP.lopnColor := GetTextColor(DC); P := SelectObject(DC, CreatePenIndirect(LogP)); For I := 0 to Lines.Count - 1 do begin {Set vertical position for line} aTop := theRect.Top + I*TM.tmHeight; If (aTop >= Rect.Top) and (aTop <= Rect.Bottom - TM.tmHeight) then begin AStr := Lines[I]; {Remove ampersands & get index of prefix} If not NoPrefix then pIndex := DeleteAmpersands(aStr) else pIndex := -1; {Offset line according to orientation} Case LeftOffset of DT_Left: aLeft := theRect.Left; DT_Center: aLeft := theRect.Left + (theRect.Right - theRect.Left) div 2 - TextExtent(DC, aStr).cX div 2; DT_Right: aLeft := theRect.Right - TextExtent(DC, AStr).cX; end; {Draw line of Text} TextOut(DC, aLeft, aTop, PChar(AStr), Length(AStr)); {Prefix drawing} If pIndex > 0 then begin {Get prefix line position} pX1 := aLeft + GetStringLength(DC, AStr, 1, pIndex); pX2 := pX1 + GetStringLength(DC, AStr, pIndex, pIndex + 1); pY := aTop + tm.tmHeight - TM.tmDescent + 1; {Draw prefix line} MoveToEx(DC, pX1, PY, @Pt); LineTo(DC, pX2, pY); {Reset pen position} MoveToEx(DC, Pt.X, Pt.Y, nil); end; end; end; {Reset brush} SelectObject(DC, B); {Reset pen} DeleteObject(SelectObject(DC, P)); {Finalize Lines} Lines.Free; {Restore device-context} RestoreDC(DC, TDC); Result := 1; end; function TWidgetSet.DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; begin Result := False; end; function TWidgetSet.EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; begin Result := False; end; function TWidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; begin Result := False; end; Function TWidgetSet.EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; Begin Result:=1; end; procedure TWidgetSet.EnterCriticalSection(var CritSection: TCriticalSection); begin DebugLn('TWidgetSet.EnterCriticalSection Not implemented yet'); end; function TWidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean; var Points : PPoint; Count : Longint; X, Y : Longint; begin Result := False; Points := nil; Count := 0; If X2 < X1 then begin X := X2; X2 := X1; X1 := X; end; If Y2 < Y1 then begin Y := Y2; Y2 := Y1; Y1 := Y; end; If (ABS(Y2 - Y1) > 0) and (ABS(X2 - X1) > 0) then begin PolyBezierArcPoints(x1, y1, x2 - x1, y2 - y1,0,360*16,0,Points,Count); Polygon(DC, Points, Count, True); ReallocMem(Points, 0); end; Result := True; end; function TWidgetSet.ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer; var RRGN : hRGN; begin If DCClipRegionValid(DC) then begin //DebugLn('TWidgetSet.ExcludeClipRect A DC=',DbgS(DC),' Rect=',Left,',',Top,',',Right,',',Bottom); // create the rectangle region, that should be excluded RRGN := CreateRectRgn(Left,Top,Right,Bottom); Result := ExtSelectClipRGN(DC, RRGN, RGN_DIFF); //DebugLn('TWidgetSet.ExcludeClipRect B Result=',Result); DeleteObject(RRGN); end else Result:=ERROR; end; function TWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; begin Result := False; end; function TWidgetSet.ExtSelectClipRGN(dc: hdc; rgn: hrgn; Mode: Longint ): Integer; var OldC, Clip : hRGN; begin OldC := CreateEmptyRegion; GetClipRGN(DC, OldC); Clip := CreateEmptyRegion; //DebugLn('TWidgetSet.ExtSelectClipRGN A OldC=',DbgS(OldC), // ' Clip=',DbgS(Clip),8),' RGn=',DbgS(Cardinal(RGN),' Mode=',dbgs(Mode)); Result := CombineRGN(Clip, OldC, RGN, Mode); //DebugLn('TWidgetSet.ExtSelectClipRGN B Result=',Result); If Result <> ERROR then Result := SelectClipRGN(DC, Clip); DeleteObject(Clip); DeleteObject(OldC); end; function TWidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean; begin Result := False; end; function TWidgetSet.FloodFill(DC: HDC; X, Y: Integer; Color: TGraphicsColor; FillStyle: TGraphicsFillStyle; Brush: HBRUSH): Boolean; begin Result := false; end; function TWidgetSet.FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): BOOL; begin Result := false; end; function TWidgetSet.FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH) : integer; begin Result:= 0; end; Function TWidgetSet.GetActiveWindow : HWND; begin Result := 0; end; function TWidgetSet.GetBitmapBits(Bitmap: HBITMAP; Count: Longint; Bits: Pointer): Longint; begin Result := 0; end; function TWidgetSet.GetCapture : HWND; begin Result := 0; end; function TWidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean; begin Result := False; end; function TWidgetSet.GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): Boolean; begin Result := False; end; function TWidgetSet.GetClientRect(handle : HWND; var Rect : TRect) : Boolean; begin Result := False; end; Function TWidgetSet.GetClipBox(DC : hDC; lpRect : PRect) : Longint; begin lpRect^ := Rect(0,0,0,0); Result := SIMPLEREGION; end; Function TWidgetSet.GetClipRGN(DC : hDC; RGN : hRGN) : Longint; begin Result := -1; end; function TWidgetSet.GetCursorPos(var lpPoint: TPoint): Boolean; begin Result := False; end; function TWidgetSet.GetDC(hWnd: HWND): HDC; begin Result := 0; end; function TWidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer; begin Result := 0; end; function TWidgetSet.GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; begin Result := 0; end; function TWidgetSet.GetFocus: HWND; begin Result := 0; end; function TWidgetSet.GetFontLanguageInfo(DC: HDC): DWord; begin Result := 0; end; function TWidgetSet.GetKeyState(nVirtKey: Integer): Smallint; begin Result := 0; end; function TWidgetSet.GetMapMode(DC: HDC): Integer; begin Result := 0; end; function TWidgetSet.GetObject(GDIObject: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; begin Result := 0; end; function TWidgetSet.GetPaletteEntries(Palette: HPALETTE; StartIndex, NumEntries: UINT; var PaletteEntries): UINT; begin Result := 0; end; Function TWidgetSet.GetParent(Handle : HWND): HWND; begin Result := 0; end; Function TWidgetSet.GetProp(Handle : hwnd; Str : PChar): Pointer; begin Result := nil; end; Function TWidgetSet.GetRGNBox(RGN : HRGN; lpRect : PRect) : Longint; begin Result := SIMPLEREGION; end; Function TWidgetSet.GetROP2(DC: HDC): Integer; begin Result := 0; end; function TWidgetSet.GetScrollInfo(Handle: HWND; SBStyle: Integer; var ScrollInfo: TScrollInfo): Boolean; begin Result := False; end; function TWidgetSet.GetStockObject(Value: Integer): LongInt; begin Result := 0; end; function TWidgetSet.GetSysColor(nIndex: Integer): DWORD; begin Result := 0; end; function TWidgetSet.GetSystemMetrics(nIndex: Integer): Integer; begin Result := 0; end; function TWidgetSet.GetSystemPaletteEntries(DC: HDC; StartIndex, NumEntries: UINT; var PaletteEntries): UINT; begin Result := 0; end; function TWidgetSet.GetTextColor(DC: HDC) : TColorRef; begin Result := 0; end; function TWidgetSet.GetTextExtentExPoint(DC: HDC; Str: PChar; Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: TSize): Boolean; begin if MaxCount<>nil then MaxCount^:=Count; if PartialWidths<>nil then DebugLn('Warning: TWidgetSet.GetTextExtentExPoint PartialWidths not implemented yet'); Result := GetTextExtentPoint(DC,Str,Count,Size); end; function TWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; begin Result := False; end; function TWidgetSet.GetTextExtentPoint32(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; begin Result := GetTextExtentPoint(DC,Str,Count,Size); end; function TWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; begin Result := False; end; function TWidgetSet.GetWindowLong(Handle : hwnd; int : Integer): Longint; begin Result := 0; end; Function TWidgetSet.GetWindowOrgEx(dc : hdc; P : PPoint): Integer; Begin Result := 0; if P<>nil then P^:=Point(0,0); end; function TWidgetSet.GetWindowRect(Handle : hwnd; var Rect : TRect): Integer; { After the call, ARect will be the control area in screen coordinates. That means, Left and Top will be the screen coordinate of the TopLeft pixel of the Handle object and Right and Bottom will be the screen coordinate of the BottomRight pixel. } begin Result := 0; end; function TWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex; NumVertices : Longint; Meshes: Pointer; NumMeshes : Longint; Mode : Longint): Boolean; begin Result := False; end; function TWidgetSet.HideCaret(hWnd: HWND): Boolean; begin Result := False; end; function TWidgetSet.InitHintFont(HintFont: TObject): Boolean; begin Result := false; end; procedure TWidgetSet.InitializeCriticalSection(var CritSection: TCriticalSection); begin DebugLn('TWidgetSet.InitializeCriticalSection Not implemented yet'); end; function TWidgetSet.IntersectClipRect(dc: hdc; Left, Top, Right, Bottom: Integer): Integer; var RRGN : hRGN; begin RRGN := CreateRectRgn(Left, Top, Right, Bottom); //DebugLn('TWidgetSet.IntersectClipRect A RGN=',DbgS(RRGN), // ' ',dbgs(Left),',',dbgs(Top),',',dbgs(Right),',',dbgs(Bottom)); If not DCClipRegionValid(DC) then Result := SelectClipRGN(DC, RRGN) else Result := ExtSelectClipRGN(DC, RRGN, RGN_AND); DeleteObject(RRGN); end; Function TWidgetSet.InvalidateRect(aHandle : HWND; ARect : pRect; bErase : Boolean) : Boolean; begin Result := false; end; function TWidgetSet.IsDBCSLeadByte(TestChar: Byte): boolean; begin Result := false; end; function TWidgetSet.IsWindowEnabled(handle: HWND): boolean; begin Result := false; end; function TWidgetSet.IsWindowVisible(handle: HWND): boolean; begin Result := false; end; procedure TWidgetSet.LeaveCriticalSection(var CritSection: TCriticalSection); begin DebugLn('TWidgetSet.LeaveCriticalSection Not implemented yet'); end; function TWidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean; begin Result := False; end; function TWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType : Cardinal): integer; begin Result:= 0; end; function TWidgetSet.MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer; ROp: DWORD): Boolean; begin Result := StretchMaskBlt(DestDC,X,Y,Width,Height,SrcDC,XSrc,YSrc,Width,Height, Mask,XMask,YMask,ROp); end; function TWidgetSet.MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer): Boolean; begin Result := MaskBlt(DestDC,X,Y,Width,Height,SrcDC,XSrc,YSrc, Mask,XMask,YMask,SRCCOPY); end; function TWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; begin Result := False; end; function TWidgetSet.PeekMessage(var lpMsg : TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean; Begin Result := False; End; function TWidgetSet.Pie(DC: HDC; EllipseX1,EllipseY1,EllipseX2,EllipseY2, StartX,StartY,EndX,EndY: Integer): Boolean; begin Result := RadialPie(DC, Min(EllipseX1,EllipseX2), Min(EllipseY1,EllipseY2), Abs(EllipseX2-EllipseX1), Abs(EllipseY2-EllipseY1), StartX,StartY, EndX,EndY); end; function TWidgetSet.PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; Filled,Continuous: boolean): boolean; var APoints : PPoint; ACount : Longint; Begin APoints := nil; ACount := 0; PolyBezier2Polyline(Points,NumPts,APoints,ACount,Continuous); If Filled then Result := Polygon(DC,APoints,ACount, False) else Result := Polyline(DC,APoints,ACount); ReallocMem(APoints,0); End; function TWidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: boolean): boolean; begin Result := false; end; function TWidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean; begin Result := false; end; function TWidgetSet.PostMessage(Handle: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam): Boolean; begin Result := False; end; function TWidgetSet.PtInRegion(RGN: HRGN; X, Y: Integer): Boolean; begin Result := false; end; function TWidgetSet.RealizePalette(DC: HDC): Cardinal; begin Result := 0; end; function TWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; begin Result := False; end; {------------------------------------------------------------------------------ Function: RectVisible Params: dc : hdc; ARect: TRect Returns: True if ARect is not completely clipped away. ------------------------------------------------------------------------------} function TWidgetSet.RectVisible(dc : hdc; const ARect: TRect) : Boolean; var ClipRGN, RectRgn: hRGN; Intersection: Cardinal; CombineResult: Integer; begin Result:=false; if (ARect.Left>=ARect.Right) or (ARect.Top>=ARect.Bottom) or not DCClipRegionValid(DC) then exit; ClipRGN:=CreateEmptyRegion; if GetClipRGN(DC,ClipRGN)>0 then begin RectRgn:=CreateRectRGN(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom); Intersection:=CreateEmptyRegion; CombineResult:=CombineRGN(Intersection,RectRGN,ClipRGN,RGN_AND); if CombineResult in [SimpleRegion,ComplexRegion] then Result:=true; DeleteObject(Intersection); DeleteObject(RectRgn); end; DeleteObject(ClipRGN); end; Function TWidgetSet.ReleaseCapture : Boolean; Begin Result := True; end; function TWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer; begin Result := 0; end; function TWidgetSet.RemoveProp(Handle: hwnd; Str: PChar): THandle; begin Result := 0; end; function TWidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean; begin Result := False; end; function TWidgetSet.RoundRect(DC : hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer) : Boolean; Procedure Switch(Var F,T : Integer); var Tmp : Integer; begin Tmp := F; F := T; T := Tmp end; var pt : TPoint; Pen : hPen; Brush : hBrush; begin Result := False; If X2 < X1 then Switch(X2,X1); If Y2 < Y1 then Switch(Y2,Y1); If ((X2 - X1) < 0) or ((Y2 - Y1) < 0) then exit; If not ((RX <= 0) or (RY <= 0)) then begin If ((X2 - X1) <= RX) or ((X2 - X1) div 2 < RX) then RX := (X2 - X1) div 2; If ((Y2 - Y1) <= RY) or ((Y2 - Y1) div 2 < RY) then RY := (Y2 - Y1) div 2; Pen := SelectObject(DC, GetStockObject(NULL_PEN)); //debugln('TWidgetSet.RoundRect ',dbgs(Rect(X1,Y1,X2,Y2)),' ',dbgs(Point(RX,RY))); RadialPieWithAngles(DC, X1, Y1, RX, RY, 90*16,90*16); RadialPieWithAngles(DC, X2 - RX, Y1, RX, RY, 0, 90*16); RadialPieWithAngles(DC, X1, Y2 - RY, RX, RY, 180*16,90*16); RadialPieWithAngles(DC, X2 - RX, Y2 - RY, RX, RY, 270*16,90*16); Rectangle(DC, X1 + (RX div 2) - 1, Y1, X2 - (RX div 2) + 1, Y2 + 1); Rectangle(DC, X1, Y1 + (RY div 2) - 1, X2 + 1, Y2 - (RY div 2) + 1); SelectObject(DC, Pen); Brush := SelectObject(DC, GetStockObject(NULL_BRUSH)); Arc(DC, X1, Y1, RX, RY, 90*16,90*16); Arc(DC, X2 - RX, Y1, RX, RY, 0, 90*16); Arc(DC, X1, Y2 - RY, RX, RY, 180*16,90*16); Arc(DC, X2 - RX, Y2 - RY, RX, RY, 270*16,90*16); RY := RY div 2; RX := RX div 2; MoveToEx(DC, X1 + RX, Y1, @pt); LineTo(DC, X2 - RX,Y1); MoveToEx(DC, X1 + RX, Y1, nil); LineTo(DC, X2 - RX, Y1); MoveToEx(DC, X1, Y1 + RY - 1,nil); LineTo(DC, X1, Y2 - RY); MoveToEx(DC, X1 + RX, Y2, nil); LineTo(DC, X2 - RX, Y2); MoveToEx(DC, X2, Y1 + RY, nil); LineTo(DC, X2, Y2 - RY); MoveToEx(DC, pt.X, pt.Y, nil); SelectObject(DC, Brush); end else Rectangle(DC, X1, Y1, X2, Y2); Result := True; end; function TWidgetSet.SaveDC(DC: HDC) : Integer; begin Result := 0; end; function TWidgetSet.ScreenToClient(Handle : HWND; var P : TPoint) : Integer; begin Result := 0; end; function TWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer; prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT): Boolean; begin Result := False; end; function TWidgetSet.SelectClipRGN(DC : hDC; RGN : HRGN) : Longint; begin Result := ERROR; end; function TWidgetSet.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; begin Result := 0; end; function TWidgetSet.SelectPalette(DC: HDC; Palette: HPALETTE; ForceBackground: Boolean): HPALETTE; begin Result := 0; end; function TWidgetSet.SendMessage(HandleWnd: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; begin Result := 0; end; function TWidgetSet.SetActiveWindow(Handle: HWND): HWND; begin Result:=GetActiveWindow; end; function TWidgetSet.SetBkColor(DC: HDC; Color: TColorRef): TColorRef; //pbd begin Result := 0; end; function TWidgetSet.SetBkMode(DC: HDC; bkMode : Integer): Integer; begin Result := 0; end; function TWidgetSet.SetCapture(AHandle: HWND): HWND; begin Result := 0; End; function TWidgetSet.SetCaretPos(X, Y: Integer): Boolean; begin Result := False; end; function TWidgetSet.SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean; begin Result := False; end; function TWidgetSet.SetCursor(hCursor: HICON): HCURSOR; begin Result := 0; end; function TWidgetSet.SetCursorPos(X, Y: Integer): Boolean; begin // Your default here Result := False; end; function TWidgetSet.SetFocus(hWnd: HWND): HWND; begin Result := 0; end; function TWidgetSet.SetMapMode(DC: HDC; MapMode: Integer): Integer; begin Result := 0; end; Function TWidgetSet.SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean; Begin Result := True; end; function TWidgetSet.SetROP2(DC: HDC; Mode: Integer): Integer; begin Result := 0; end; function TWidgetSet.SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; Redraw : Boolean): Integer; begin Result := 0; end; function TWidgetSet.SetStretchBltMode(DC: HDC; StretchMode: Integer): Integer; begin Result := 0; end; function TWidgetSet.SetSysColors(cElements: Integer; const lpaElements; const lpaRgbValues): Boolean; begin Result := False; end; function TWidgetSet.SetTextAlign(DC: HDC; Flags: UINT): UINT; begin Result := 0; end; function TWidgetSet.SetTextCharacterExtra(_hdc : hdc; nCharExtra : Integer):Integer; begin Result := 0; end; function TWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef; begin Result := CLR_INVALID; end; function TWidgetSet.SetWindowLong(Handle: HWND; Idx: Integer; NewLong : Longint): LongInt; begin Result := -1; end; Function TWidgetSet.SetWindowOrgEx(dc : hdc; NewX, NewY : Integer; OldPoint: PPoint) : Boolean; Begin Result := False; end; function TWidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, cx, cy: Integer; uFlags: UINT): Boolean; begin Result:=false; end; function TWidgetSet.ShowCaret(hWnd: HWND): Boolean; begin Result := False; end; function TWidgetSet.ShowScrollBar(Handle: HWND; wBar: Integer; bShow: Boolean): Boolean; begin Result := False; end; function TWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; begin Result:=false; end; procedure TWidgetSet.Sleep(dwMilliseconds: DWORD); begin end; function TWidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Rop: Cardinal): Boolean; begin Result := False; end; function TWidgetSet.StretchDIBits(DC: HDC; DestX, DestY, DestWidth, DestHeight, SrcX, SrcY, SrcWidth, SrcHeight: Integer; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT; Rop: DWORD): Integer; begin Result := 0; end; Function TWidgetSet.TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; begin Result := false; end; function TWidgetSet.UpdateWindow(Handle: HWND): Boolean; begin Result := false; end; function TWidgetSet.VkKeyScan(AChar: Char): Short; begin Result := -1; // $FFFF end; Function TWidgetSet.WindowFromPoint(Point : TPoint) : HWND; begin Result := 0; end; //##apiwiz##eps## // Do not remove { ============================================================================= $Log$ Revision 1.23 2005/06/22 17:37:06 mattias implemented TMouse.SetCursorPos from Andrew Revision 1.22 2005/03/07 21:59:44 vincents changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman Revision 1.21 2005/03/04 13:50:09 mattias fixed Arc and changed x,y to Left,Top to make meaning more clear Revision 1.20 2005/02/23 01:15:56 marc + Added RemoveProp winapi call Revision 1.19 2005/02/05 16:09:52 marc * first 64bit changes Revision 1.18 2005/02/05 09:05:50 micha add platform independent winapi function IsWindowEnabled Revision 1.17 2005/01/16 11:40:10 mattias fixed TGtkWidgetSet.ExtSelectClipRGN for DCOrigin Revision 1.16 2005/01/08 11:03:18 mattias implemented TPen.Mode=pmXor from Jesus Revision 1.15 2004/12/19 19:29:04 marc * x86_64 fix: Conversion if integer to pointer Revision 1.14 2004/12/19 19:26:05 marc * x86_64 fix: Conversion if integer to pointer Revision 1.13 2004/08/10 22:09:02 mattias fixed uninitialised LogFont Revision 1.12 2004/05/11 12:16:47 mattias replaced writeln by debugln Revision 1.11 2004/04/10 17:58:57 mattias implemented mainunit hints for include files Revision 1.10 2004/03/06 21:57:14 mattias fixed compilation under fpc 1.9.3 Revision 1.9 2004/03/05 00:14:02 marc * Renamed TInterfaceBase to TWidgetSet Revision 1.8 2004/02/23 08:19:04 micha revert intf split Revision 1.6 2004/02/17 00:32:25 mattias fixed TCustomImage.DoAutoSize fixing uninitialized vars Revision 1.5 2004/02/10 00:05:03 mattias TSpeedButton now uses MaskBlt Revision 1.4 2004/01/10 22:34:20 mattias started double buffering for gtk intf Revision 1.3 2003/12/29 14:22:22 micha fix a lot of range check errors win32 Revision 1.2 2003/12/14 19:18:04 micha hint fixes: parentfont, font itself, showing/hiding + more Revision 1.1 2003/11/24 11:03:07 marc * Splitted winapi*.inc into a winapi and a lcl interface communication part }