{*********************************************************} {* mymisc.pas *} {*********************************************************} {* ***** BEGIN LICENSE BLOCK ***** *} {* Version: MPL 1.1 *} {* *} {* The contents of this file are subject to the Mozilla Public License *} {* Version 1.1 (the "License"); you may not use this file except in *} {* compliance with the License. You may obtain a copy of the License at *} {* http://www.mozilla.org/MPL/ *} {* *} {* Software distributed under the License is distributed on an "AS IS" basis, *} {* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *} {* for the specific language governing rights and limitations under the *} {* License. *} {* *} {* The Original Code is Orpheus for Lazarus Additional Units. *} {* *} {* The Initial Developer of the Original Code is Phil Hess. *} {* *} {* Portions created by Phil Hess are Copyright (C) 2006 Phil Hess. *} {* All Rights Reserved. *} {* *} {* Contributor(s): *} {* *} {* ***** END LICENSE BLOCK ***** *} unit MyMisc; { This unit provides types, constants, and functions that fill in some gaps in the Lazarus LCL for compiling the ported Orpheus controls. Declarations that have been commented out in the interface section are no longer needed. It is expected that over time more of these can be eliminated as the LCL evolves. Several of these functions are only used by Orpheus units that have not yet been ported to Lazarus. For now, these functions are just stubs on non-Windows platforms, as indicated in the function comments. } {$I ovc.inc} interface uses SysUtils, {$IFDEF MSWINDOWS} Windows, {$ELSE} Types, {$ENDIF} LclIntf, LMessages, LclType, InterfaceBase, {$IFDEF LINUX} FileUtil, {$ENDIF} GraphType, Graphics, Controls; type TButtonStyle = (bsAutoDetect, bsWin31, bsNew); TWMMouse = TLMMouse; TWMKeyDown = TLMKeyDown; TWMNCHitTest = TLMNCHitTest; TWMSetText = TLMSetText; TCMDesignHitTest = TWMMouse; TWMChar = TLMChar; TWMClear = TLMNoParams; TWMCopy = TLMNoParams; TWMCut = TLMNoParams; TWMLButtonDblClk = TLMLButtonDblClk; TWMLButtonDown = TLMLButtonDown; TWMLButtonUp = TLMLButtonUp; TWMRButtonDown = TLMRButtonDown; TWMSysKeyDown = TLMSysKeyDown; TWMMouseActivate = packed record Msg: Cardinal; {$ifdef cpu64} //64 UnusedMsg: Cardinal; {$endif} TopLevel: HWND; HitTestCode: Word; MouseMsg: Word; {$ifdef cpu64} //64 Unused: Longint; {$endif} Result: LRESULT; //64 end; TWMMouseMove = TLMMouseMove; TWMPaste = TLMNoParams; TMessage = TLMessage; TWMEraseBkgnd = TLMEraseBkgnd; TWMGetText = TLMGetText; TWMGetTextLength = TLMGetTextLength; TWMKillFocus = TLMKillFocus; TWMSetCursor = TLMSetCursor; //64 // TWMSetCursor = packed record // Msg: Cardinal; // CursorWnd: HWND; // HitTest: Word; // MouseMsg: Word; // Result: Longint; // end; TWMSetFocus = TLMSetFocus; TWMGetDlgCode = TLMNoParams; TWMSize = TLMSize; TWMSetFont = packed record Msg: Cardinal; {$ifdef cpu64} //64 UnusedMsg: Cardinal; {$endif} Font: HFONT; Redraw: WordBool; Unused: Word; {$ifdef cpu64} //64 Unused2: Longint; {$endif} Result: LRESULT; //64 end; TWMCommand = TLMCommand; TWMDrawItem = TLMDrawItems; LPDWORD = PDWORD; TFNWndEnumProc = TFarProc; TNonClientMetrics = packed record cbSize: UINT; iBorderWidth: Integer; iScrollWidth: Integer; iScrollHeight: Integer; iCaptionWidth: Integer; iCaptionHeight: Integer; lfCaptionFont: TLogFontA; iSmCaptionWidth: Integer; iSmCaptionHeight: Integer; lfSmCaptionFont: TLogFontA; iMenuWidth: Integer; iMenuHeight: Integer; lfMenuFont: TLogFontA; lfStatusFont: TLogFontA; lfMessageFont: TLogFontA; end; TWMKey = TLMKey; TWMScroll = TLMScroll; TWMNoParams = TLMNoParams; TWMPaint = TLMPaint; TWMNCPaint = packed record Msg: Cardinal; {$ifdef cpu64} //64 UnusedMsg: Cardinal; {$endif} RGN: HRGN; Unused: LPARAM; //64 Result: LRESULT; //64 end; TWMHScroll = TLMHScroll; TWMVScroll = TLMVScroll; const WM_WININICHANGE = CM_WININICHANGE; WM_CANCELMODE = LM_CANCELMODE; WM_ERASEBKGND = LM_ERASEBKGND; WM_GETTEXTLENGTH = LM_GETTEXTLENGTH; WM_KEYDOWN = LM_KEYDOWN; WM_KILLFOCUS = LM_KILLFOCUS; WM_LBUTTONDOWN = LM_LBUTTONDOWN; WM_LBUTTONUP = LM_LBUTTONUP; WM_MOUSEMOVE = LM_MOUSEMOVE; WM_NCHITTEST = LM_NCHITTEST; WM_SETCURSOR = LM_SETCURSOR; WM_SETTEXT = $000C; WM_GETTEXT = $000D; WM_SETFOCUS = LM_SETFOCUS; WM_CHAR = LM_CHAR; WM_CLEAR = LM_CLEAR; WM_COPY = LM_COPY; WM_CUT = LM_CUT; WM_PASTE = LM_PASTE; // With Lazarus versions prior to March 2008, LM_CLEAR, etc. are not defined, // so comment previous 4 lines and uncomment next 4 lines. { WM_CLEAR = LM_CLEARSEL; WM_COPY = LM_COPYTOCLIP; WM_CUT = LM_CUTTOCLIP; WM_PASTE = LM_PASTEFROMCLIP; } WM_GETDLGCODE = LM_GETDLGCODE; WM_SIZE = LM_SIZE; WM_SETFONT = LM_SETFONT; WM_SYSKEYDOWN = LM_SYSKEYDOWN; WM_RBUTTONUP = LM_RBUTTONUP; WM_MOUSEACTIVATE = $0021; WM_LBUTTONDBLCLK = LM_LBUTTONDBLCLK; WM_SETREDRAW = $000B; WM_NEXTDLGCTL = $0028; WM_MOUSEWHEEL = LM_MOUSEWHEEL; WM_PAINT = LM_PAINT; WM_VSCROLL = LM_VSCROLL; WM_HSCROLL = LM_HSCROLL; WM_NCPAINT = LM_NCPAINT; WM_MEASUREITEM = LM_MEASUREITEM; EM_GETMODIFY = $00B8; EM_SETMODIFY = $00B9; EM_GETSEL = $00B0; EM_SETSEL = $00B1; EM_GETLINECOUNT = $00BA; EM_LINELENGTH = $00C1; EM_LINEINDEX = $00BB; EM_GETLINE = $00C4; EM_REPLACESEL = $00C2; CS_SAVEBITS = $800; CS_DBLCLKS = 8; SPI_GETWORKAREA = 48; SPI_GETNONCLIENTMETRICS = 41; DLGC_STATIC = $100; GW_HWNDLAST = 1; GW_HWNDNEXT = 2; GW_HWNDPREV = 3; GW_CHILD = 5; DT_EXPANDTABS = $40; DT_END_ELLIPSIS = $8000; DT_MODIFYSTRING = $10000; GHND = 66; TMPF_TRUETYPE = 4; SWP_HIDEWINDOW = $80; SWP_SHOWWINDOW = $40; RDW_INVALIDATE = 1; RDW_UPDATENOW = $100; RDW_FRAME = $400; LANG_JAPANESE = $11; ES_PASSWORD = $20; ES_LEFT = 0; ES_RIGHT = 2; ES_CENTER = 1; ES_AUTOHSCROLL = $80; ES_MULTILINE = 4; ODS_COMBOBOXEDIT = $1000; CB_FINDSTRING = $014C; CB_SETITEMHEIGHT = $0153; CB_FINDSTRINGEXACT = $0158; CB_SETDROPPEDWIDTH = 352; CBS_DROPDOWN = 2; CBS_DROPDOWNLIST = 3; CBS_OWNERDRAWVARIABLE = $20; CBS_AUTOHSCROLL = $40; CBS_HASSTRINGS = $200; WHEEL_DELTA = 120; LB_GETCARETINDEX = $019F; LB_GETCOUNT = $018B; LB_GETCURSEL = $0188; LB_GETITEMHEIGHT = $01A1; LB_GETITEMRECT = $0198; LB_GETSEL = $0187; LB_GETTOPINDEX = $018E; LB_RESETCONTENT = $0184; LB_SELITEMRANGE = $019B; LB_SETCURSEL = $0186; LB_SETSEL = $0185; LB_SETTABSTOPS = $0192; LB_SETTOPINDEX = $0197; LB_ERR = -1; MA_ACTIVATE = 1; MA_NOACTIVATEANDEAT = 4; {These belong in LclIntf unit} function IsCharAlpha(c : Char) : Boolean; function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; function GetProfileInt(lpAppName, lpKeyName: PChar; nDefault: Integer): UINT; function GetProfileString(lpAppName, lpKeyName, lpDefault: PChar; lpReturnedString: PChar; nSize: DWORD): DWORD; function GetTickCount : DWORD; //function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT; // lpTimerFunc: TFNTimerProc): UINT; //function KillTimer(hWnd: HWND; uIDEvent: UINT): BOOL; function GetCaretBlinkTime: UINT; function SetCaretBlinkTime(uMSeconds: UINT): BOOL; //function DestroyCaret: BOOL; function MessageBeep(uType: UINT): BOOL; function SystemParametersInfo(uiAction, uiParam: UINT; pvParam: Pointer; fWinIni: UINT): BOOL; {$IFNDEF MSWINDOWS} function GetSystemMetrics(nIndex: Integer): Integer; {$ENDIF} function MoveWindow(hWnd: HWND; X, Y, nWidth, nHeight: Integer; bRepaint: BOOL): BOOL; function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, cx, cy: Integer; uFlags: UINT): BOOL; function UpdateWindow(hWnd: HWND): BOOL; function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL; function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL; function InvalidateRgn(hWnd: HWND; hRgn: HRGN; bErase: BOOL): BOOL; function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint; function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean; function SetWindowText(hWnd: HWND; lpString: PChar): BOOL; function GetBkColor(hDC: HDC): COLORREF; function GetBkMode(hDC: HDC): Integer; function GetWindow(hWnd: HWND; uCmd: UINT): HWND; function GetNextWindow(hWnd: HWND; uCmd: UINT): HWND; function RedrawWindow(hWnd: HWND; lprcUpdate: PRect; hrgnUpdate: HRGN; flags: UINT): BOOL; function GetWindowDC(hWnd: HWND): HDC; function ScrollDC(DC: HDC; DX, DY: Integer; var Scroll, Clip: TRect; Rgn: HRGN; Update: PRect): BOOL; function SetScrollRange(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: BOOL): BOOL; function GetTabbedTextExtent(hDC: HDC; lpString: PChar; nCount, nTabPositions: Integer; var lpnTabStopPositions): DWORD; function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar; nCount, nTabPositions: Integer; var lpnTabStopPositions; nTabOrigin: Integer): Longint; function SetTextAlign(DC: HDC; Flags: UINT): UINT; function GetMapMode(DC: HDC): Integer; function SetMapMode(DC: HDC; p2: Integer): Integer; //function LoadBitmap(hInstance: HINST; lpBitmapName: PAnsiChar): HBITMAP; //function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR; function EnumThreadWindows(dwThreadId: DWORD; lpfn: TFNWndEnumProc; lParam: LPARAM): BOOL; procedure OutputDebugString(lpOutputString: PChar); function SetViewportOrgEx(DC: HDC; X, Y: Integer; Point: PPoint): BOOL; function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL; function GlobalLock(hMem: HGLOBAL): Pointer; function GlobalUnlock(hMem: HGLOBAL): BOOL; //function DestroyCursor(hCursor: HICON): BOOL; //{$IFDEF MSWINDOWS} //Not needed with GTK and Qt (but doesn't hurt); Win32 and Carbon need it. function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL; function SendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; //{$ENDIF} procedure RecreateWnd(const AWinControl:TWinControl); {These belong in Classes unit} //function MakeObjectInstance(Method: TWndMethod): Pointer; //procedure FreeObjectInstance(ObjectInstance: Pointer); //function AllocateHWnd(Method: TWndMethod): HWND; //procedure DeallocateHWnd(Wnd: HWND); {This belongs in System unit} //function FindClassHInstance(ClassType: TClass): LongWord; {This belongs in ExtCtrls unit} procedure Frame3D(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor: TColor; Width: Integer); // {This should be a TCanvas method} <--it is now, but still needed for TBitMap.BrushCopy. procedure BrushCopy(DestCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap; const Source: TRect; Color: TColor); {This belongs in Buttons unit} function DrawButtonFace(Canvas: TCanvas; const Client: TRect; BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown, IsFocused: Boolean): TRect; {Additional routines} {$IFDEF LINUX} function GetBrowserPath : string; {$ENDIF} implementation {$IFDEF LCL} uses LCLPlatformDef ; {$ENDIF} {These functions belong in LclIntf unit} function IsCharAlpha(c : Char) : Boolean; // Doesn't handle upper-ANSI chars, but then LCL IsCharAlphaNumeric // function doesn't either. begin Result := ((Ord(c) >= 65) and (Ord(c) <= 90)) or ((Ord(c) >= 97) and (Ord(c) <= 122)); end; function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; // DefWindowProc is a Win API function for handling any window message // that the application doesn't handle. // Can't find equivalent in LCL. begin {$IFDEF MSWINDOWS} Result := Windows.DefWindowProc(hWnd, Msg, wParam, lParam); {$ELSE} Result := 0; {$ENDIF} end; function GetProfileInt(lpAppName, lpKeyName: PChar; nDefault: Integer): UINT; // Return the integer value for the key name in the lpAppName section // of the WIN.INI file, which on Win32 maps to the corresponding // section of the Windows registry. begin {$IFDEF MSWINDOWS} Result := Windows.GetProfileInt(lpAppName, lpKeyName, nDefault); {$ELSE} //Just return default for now. Result := nDefault; {$ENDIF} end; function GetProfileString(lpAppName, lpKeyName, lpDefault: PChar; lpReturnedString: PChar; nSize: DWORD): DWORD; // Return the string value for the key name in the lpAppName section // of the WIN.INI file, which on Win32 maps to the corresponding // section of the Windows registry. begin {$IFDEF MSWINDOWS} Result := Windows.GetProfileString(lpAppName, lpKeyName, lpDefault, lpReturnedString, nSize); {$ELSE} //Just return default for now. StrLCopy(lpReturnedString, lpDefault, Pred(nSize)); {$ENDIF} end; function GetTickCount : DWORD; {On Windows, this is number of milliseconds since Windows was started. On non-Windows platforms, LCL returns number of milliseconds since Dec. 30, 1899, wrapped by size of DWORD. This value can overflow LongInt variable when checks turned on, so "wrap" value here so it fits within LongInt. Also, since same thing could happen with Windows that has been running for at least approx. 25 days, override it too.} begin {$IFDEF MSWINDOWS} Result := Windows.GetTickCount mod High(LongInt); {$ELSE} Result := LclIntf.GetTickCount mod High(LongInt); {$ENDIF} end; function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT; lpTimerFunc: TFNTimerProc): UINT; begin {$IFDEF MSWINDOWS} Result := {Windows.}SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc); {$ENDIF} end; function KillTimer(hWnd: HWND; uIDEvent: UINT): BOOL; begin {$IFDEF MSWINDOWS} Result := Windows.KillTimer(hWnd, UIDEvent); {$ENDIF} end; function GetCaretBlinkTime: UINT; // This function and SetCaretBlinkTime are only used in OvcCaret unit's // TOvcSingleCaret.SetLinked, which is used to write Linked property. begin {$IFDEF MSWINDOWS} Result := Windows.GetCaretBlinkTime; {$ELSE} Result := 530; //Default on Win XP, so use as reasonable value {$ENDIF} end; function SetCaretBlinkTime(uMSeconds: UINT): BOOL; begin {$IFDEF MSWINDOWS} Result := Windows.SetCaretBlinkTime(uMSeconds); {$ENDIF} end; function DestroyCaret: BOOL; begin {$IFDEF MSWINDOWS} Result := Windows.DestroyCaret; {$ENDIF} end; function MessageBeep(uType: UINT): BOOL; begin {$IFDEF MSWINDOWS} Result := Windows.MessageBeep(uType); {$ELSE} Beep; //Most calls pass 0 as uType (MB_OK), which is system default sound} {$ENDIF} end; function SystemParametersInfo(uiAction, uiParam: UINT; pvParam: Pointer; fWinIni: UINT): BOOL; // Only used in: // OvcMisc: PathEllipsis, which is only used in ovcmru (not yet ported). // OvcEdClc: TOvcCustomNumberEdit.PopupOpen. // OvcEdCal: TOvcCustomDateEdit.PopupOpen. // OvcEdSld (not yet ported). begin {$IFDEF MSWINDOWS} Result := Windows.SystemParametersInfo(uiAction, uiParam, pvParam, fWinIni); {$ENDIF} end; {$IFNDEF MSWINDOWS} function GetSystemMetrics(nIndex: Integer): Integer; // SM_CYBORDER, etc. not implemented yet in GTK widgetset. begin if nIndex = SM_SWAPBUTTON then Result := 0 {Not implemented on GTK, so assume buttons not swapped} else begin if nIndex = SM_CYBORDER then // nIndex := SM_CYEDGE; //Substitute for now so returned value is valid. begin //Neither implemented, so catch here to eliminate TODO messages. Result := 0; //0 was being returned before. Exit; end; Result := LclIntf.GetSystemMetrics(nIndex); end; end; {$ENDIF} function MoveWindow(hWnd: HWND; X, Y, nWidth, nHeight: Integer; bRepaint: BOOL): BOOL; // Only used in: // OvcEdClc: TOvcCustomNumberEdit.PopupOpen. // OvcEdCal: TOvcCustomDateEdit.PopupOpen. // OvcEdSld (not yet ported). begin {$IFDEF MSWINDOWS} Result := Windows.MoveWindow(hWnd, X, Y, nWidth, nHeight, bRepaint); {$ENDIF} end; function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, cx, cy: Integer; uFlags: UINT): BOOL; begin {$IFDEF MSWINDOWS} Result := Windows.SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, uFlags); {$ELSE} //Doesn't do much with GTK, but call it anyway. Result := LclIntf.SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, uFlags); if (uFlags and SWP_HIDEWINDOW) <> 0 then FindControl(hWnd).Visible := False else if (uFlags and SWP_SHOWWINDOW) <> 0 then FindControl(hWnd).Visible := True; {$ENDIF} end; function UpdateWindow(hWnd: HWND): BOOL; {For some reason, implementing this function in win32 widgetset on 27-May-2008 broke TOvcTable when a manifest is used. Since TOvcTable worked when this function was not implemented, just intercept and ignore call for now.} begin Result := True; end; function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL; // Since LCL InvalidateRect redraws window, shouldn't need this function, // so leave it as stub for now. begin {$IFDEF MSWINDOWS} // Result := Windows.ValidateRect(hWnd, lpRect); {$ENDIF} Result := True; end; function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL; {InvalidateRect crashes if lpRect is nil with some versions of LCL.} begin {$IFDEF MSWINDOWS} if Assigned(lpRect) then Result := LclIntf.InvalidateRect(hWnd, lpRect, bErase) else Result := Windows.InvalidateRect(hWnd, lpRect, bErase); {$ELSE} if Assigned(lpRect) then Result := LclIntf.InvalidateRect(hWnd, lpRect, bErase) else Result := True; //For now just ignore if nil since no alternative as with Windows. {$ENDIF} end; function InvalidateRgn(hWnd: HWND; hRgn: HRGN; bErase: BOOL): BOOL; {$IFDEF MSWINDOWS} begin Result := Windows.InvalidateRgn(hWnd, hRgn, bErase); {$ELSE} var ARect : TRect; begin GetRgnBox(hRgn, @ARect); Result := InvalidateRect(hWnd, @ARect, bErase); {$ENDIF} end; function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint; begin {$IFDEF MSWINDOWS} Result := Windows.GetRgnBox(RGN, lpRect); {$ELSE} Result := LclIntf.GetRgnBox(RGN, lpRect); {$ENDIF} end; function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean; {$IFDEF MSWINDOWS} begin Result := Windows.PtInRegion(RGN, X, Y); {$ELSE} var ARect : TRect; APt : TPoint; begin GetRgnBox(RGN, @ARect); APt.X := X; APt.Y := Y; Result := LclIntf.PtInRect(ARect, APt); {$ENDIF} end; function SetWindowText(hWnd: HWND; lpString: PChar): BOOL; begin {$IFDEF MSWINDOWS} Result := Windows.SetWindowText(hWnd, lpString); {$ELSE} // Use FindControl, then assign to control's Text property? {$ENDIF} end; function GetBkColor(hDC: HDC): COLORREF; // Only used in: // OvcEF: TOvcBaseEntryField.efPaintPrim. // OvcLkOut (not yet ported). // O32LkOut (not yet ported). begin {$IFDEF MSWINDOWS} Result := Windows.GetBkColor(hDC); {$ELSE} // Since SetBkColor returns previous color, use it to get color. Result := SetBkColor(hDC, 0); //Set background color to black. SetBkColor(hDC, Result); //Restore background color {$ENDIF} end; function GetBkMode(hDC: HDC): Integer; begin {$IFDEF MSWINDOWS} Result := Windows.GetBkMode(hDC); {$ELSE} Result := TRANSPARENT; //For now // Result := SetBkMode(hDC, TRANSPARENT); //Use when widgetsets support it // SetBkMode(hDC, Result); {$ENDIF} end; function GetWindow(hWnd: HWND; uCmd: UINT): HWND; {$IFDEF MSWINDOWS} begin Result := Windows.GetWindow(hWnd, uCmd); {$ELSE} var AWinControl : TWinControl; begin Result := 0; AWinControl := FindControl(hWnd); if AWinControl <> nil then begin case uCmd of GW_HWNDNEXT : begin // FindNextControl is declared in protected section, so can't use it. // AWinControl := AWinControl.FindNextControl(AWinControl, True, False, False); // if AWinControl <> nil then // Result := AWinControl.Handle; end; GW_CHILD : begin if AWinControl.ControlCount > 0 then Result := TWinControl(AWinControl.Controls[0]).Handle; end; GW_HWNDLAST : begin if AWinControl.Parent <> nil then Result := TWinControl(AWinControl.Parent.Controls[Pred(AWinControl.Parent.ControlCount)]).Handle; end; end; end; {$ENDIF} end; function GetNextWindow(hWnd: HWND; uCmd: UINT): HWND; begin {$IFDEF MSWINDOWS} Result := Windows.GetNextWindow(hWnd, uCmd); {$ELSE} Result := GetWindow(hWnd, uCmd); {$ENDIF} end; function RedrawWindow(hWnd: HWND; lprcUpdate: PRect; hrgnUpdate: HRGN; flags: UINT): BOOL; begin {$IFDEF MSWINDOWS} Result := Windows.RedrawWindow(hWnd, lprcUpdate, hrgnUpdate, flags); {$ELSE} {$ENDIF} end; function GetWindowDC(hWnd: HWND): HDC; begin {$IFDEF MSWINDOWS} Result := Windows.GetWindowDC(hWnd); {$ELSE} {$ENDIF} end; function ScrollDC(DC: HDC; DX, DY: Integer; var Scroll, Clip: TRect; Rgn: HRGN; Update: PRect): BOOL; begin {$IFDEF MSWINDOWS} Result := Windows.ScrollDC(DC, DX, DY, Scroll, Clip, Rgn, Update); {$ELSE} {$ENDIF} end; function SetScrollRange(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: BOOL): BOOL; {$IFDEF MSWINDOWS} begin Result := Windows.SetScrollRange(hWnd, nBar, nMinPos, nMaxPos, bRedraw); end; {$ELSE} //GTK needs more information, so use SetScrollInfo var ScrInfo : TScrollInfo; begin ScrInfo.fMask := SIF_RANGE or SIF_UPDATEPOLICY; ScrInfo.nTrackPos := SB_POLICY_CONTINUOUS; ScrInfo.nMin := nMinPos; ScrInfo.nMax := nMaxPos; LclIntf.SetScrollInfo(hWnd, nBar, ScrInfo, True); Result := True; end; {$ENDIF} function GetTabbedTextExtent(hDC: HDC; lpString: PChar; nCount, nTabPositions: Integer; var lpnTabStopPositions): DWORD; begin {$IFDEF MSWINDOWS} Result := Windows.GetTabbedTextExtent(hDC, lpString, nCount, nTabPositions, lpnTabStopPositions); {$ELSE} Result := 0; //Not implemented yet (see comment below). {$ENDIF} end; function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar; nCount, nTabPositions: Integer; var lpnTabStopPositions; nTabOrigin: Integer): Longint; {$IFDEF MSWINDOWS} begin Result := Windows.TabbedTextOut(hDC, X, Y, lpString, nCount, nTabPositions, lpnTabStopPositions, nTabOrigin); {$ELSE} // TODO: Not yet implemented since not needed by Orpheus: // -Special case where nTabPositions is 0 and lpnTabStopPositions is nil. // -Special case where nTabPositions is 1 and >1 tab in string. // -Return value (height and width of string). // -Use of nTabOrigin. This is used in OvcVLB as a negative offset // with horizontal scrolling, but value passed is determined by // GetTabbedTextExtent, which is not yet implemented (above). Shouldn't // be needed if virtual list box doesn't have horizontal scrollbar. type TTabArray = array[1..1000] of Integer; {Assume no more than this many tabs} var OutX : Integer; TabCnt : Integer; StartPos : Integer; CharPos : Integer; OutCnt : Integer; TextSize : TSize; begin OutX := X; TabCnt := 0; StartPos := 0; for CharPos := 0 to Pred(nCount) do begin if (lpString[CharPos] = #9) or (CharPos = Pred(nCount)) then {Output text?} begin OutCnt := CharPos - StartPos; if CharPos = Pred(nCount) then {Include last char?} Inc(OutCnt); if (TabCnt > 0) and (TTabArray(lpnTabStopPositions)[TabCnt] < 0) then begin {Negative tab position means following text is right-aligned to it} GetTextExtentPoint(hDC, lpString+StartPos, OutCnt, TextSize); OutX := X + Abs(TTabArray(lpnTabStopPositions)[TabCnt]) - TextSize.cx; end; LclIntf.TextOut(hDC, OutX, Y, lpString+StartPos, OutCnt); StartPos := Succ(CharPos); if (lpString[CharPos] = #9) and (TabCnt < nTabPositions) then begin Inc(TabCnt); OutX := X + TTabArray(lpnTabStopPositions)[TabCnt]; end; end; end; Result := 0; //Just return this for now. {$ENDIF} end; function SetTextAlign(DC: HDC; Flags: UINT): UINT; begin {$IFDEF MSWINDOWS} Result := Windows.SetTextAlign(DC, Flags); {$ELSE} {$ENDIF} end; function GetMapMode(DC: HDC): Integer; begin {$IFDEF MSWINDOWS} Result := Windows.GetMapMode(DC); {$ELSE} {$ENDIF} end; function SetMapMode(DC: HDC; p2: Integer): Integer; begin {$IFDEF MSWINDOWS} Result := Windows.SetMapMode(DC, p2); {$ELSE} {$ENDIF} end; function LoadBitmap(hInstance: HINST; lpBitmapName: PAnsiChar): HBITMAP; begin {$IFDEF MSWINDOWS} Result := Windows.LoadBitmap(hInstance, lpBitmapName); {$ENDIF} end; function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR; begin {$IFDEF MSWINDOWS} Result := Windows.LoadCursor(hInstance, lpCursorName); {$ENDIF} end; function EnumThreadWindows(dwThreadId: DWORD; lpfn: TFNWndEnumProc; lParam: LPARAM): BOOL; // Only used in OvcMisc IsForegroundTask function, which is only // used in OvcSpeed (not yet ported). begin {$IFDEF MSWINDOWS} Result := Windows.EnumThreadWindows(dwThreadId, lpfn, lParam); {$ENDIF} end; procedure OutputDebugString(lpOutputString: PChar); begin {$IFDEF MSWINDOWS} Windows.OutputDebugString(lpOutputString); {$ENDIF} end; function SetViewportOrgEx(DC: HDC; X, Y: Integer; Point: PPoint): BOOL; // Only used in OvcMisc CopyParentImage procedure, which is only // used by TOvcCustomSpeedButton.Paint in OvcSpeed (not yet ported). begin {$IFDEF MSWINDOWS} Result := Windows.SetViewportOrgEx(DC, X, Y, Point); {$ENDIF} end; function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL; // GlobalAlloc, GlobalLock, and GlobalUnlock are only used in: // OvcEF: TOvcBaseEntryField.efCopyPrim and TOvcBaseEntryField.WMPaste. // OvcEdit (not yet ported). // OvcViewr (not yet ported). // Replace code in those units with calls to standard Clipboard methods? begin {$IFDEF MSWINDOWS} Result := Windows.GlobalAlloc(uFlags, dwBytes); {$ELSE} Result := THandle(GetMem(dwBytes)); {$ENDIF} end; function GlobalLock(hMem: HGLOBAL): Pointer; begin {$IFDEF MSWINDOWS} Result := Windows.GlobalLock(hMem); {$ELSE} Result := PAnsiChar(hMem); {$ENDIF} end; function GlobalUnlock(hMem: HGLOBAL): BOOL; begin {$IFDEF MSWINDOWS} Result := Windows.GlobalUnlock(hMem); {$ELSE} FreeMem(Pointer(hMem)); Result := True; {$ENDIF} end; function DestroyCursor(hCursor: HICON): BOOL; begin {$IFDEF MSWINDOWS} Result := Windows.DestroyCursor(hCursor); {$ENDIF} end; function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL; {Use control's Perform method to force it to respond to posted message. This doesn't work: Result := LclIntf.PostMessage(hWnd, Msg, wParam, lParam); } var AWinControl : TWinControl; begin Assert(hWnd <> 0, 'Window handle not assigned on entry to PostMessage'); AWinControl := FindOwnerControl(hWnd); // Assert(AWinControl <> nil, // 'Owner control not found in PostMessage ($' + IntToHex(Msg, 4) + ') '); if AWinControl <> nil then AWinControl.Perform(Msg, wParam, lParam); Result := True; end; function SendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; {Use control's Perform method to force it to respond to sent message. This doesn't work: Result := LclIntf.SendMessage(hWnd, Msg, wParam, lParam); } var AWinControl : TWinControl; begin Assert(hWnd <> 0, 'Window handle not assigned on entry to SendMessage'); AWinControl := FindOwnerControl(hWnd); // Assert(AWinControl <> nil, // 'Owner control not found in SendMessage ($' + IntToHex(Msg, 4) + ') '); if AWinControl <> nil then Result := AWinControl.Perform(Msg, wParam, lParam); end; procedure RecreateWnd(const AWinControl:TWinControl); // Calls to Controls.RecreateWnd shouldn't be needed with GTK widgetset, // so just ignore them. begin {$IFDEF MSWINDOWS} Controls.RecreateWnd(AWinControl); {$ENDIF} end; {These belong in Classes unit} function MakeObjectInstance(Method: TWndMethod): Pointer; begin end; procedure FreeObjectInstance(ObjectInstance: Pointer); begin end; function AllocateHWnd(Method: TWndMethod): HWND; begin end; procedure DeallocateHWnd(Wnd: HWND); begin end; {This belongs in System unit} function FindClassHInstance(ClassType: TClass): LongWord; begin (* Result := System.MainInstance; *) Result := System.HInstance; end; {This belongs in ExtCtrls unit} procedure Frame3D(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor: TColor; Width: Integer); begin Canvas.Frame3D(Rect, Width, bvLowered); {Need a way of determining whether to pass bvNone, bvLowered, bvRaised, or bvSpace based on TopColor and BottomColor. See Delphi help for Frame3D.} end; {This should be a TCanvas method} procedure BrushCopy(DestCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap; const Source: TRect; Color: TColor); begin StretchBlt(DestCanvas.Handle, Dest.Left, Dest.Top, Dest.Right - Dest.Left, Dest.Bottom - Dest.Top, Bitmap.Canvas.Handle, Source.Left, Source.Top, Source.Right - Source.Left, Source.Bottom - Source.Top, SrcCopy); end; {This belongs in Buttons unit} function DrawButtonFace(Canvas: TCanvas; const Client: TRect; BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown, IsFocused: Boolean): TRect; {Draw a push button. Style, IsRounded and IsFocused params appear to be left over from Win 3.1, so ignore them.} var ARect : TRect; begin ARect := Client; {The way LCL TCustomSpeedButton draws a button} if IsDown then begin if WidgetSet.LCLPlatform <> lpCarbon then Canvas.Frame3D(ARect, BevelWidth, bvLowered) else //bvLowered currently not supported on Carbon. Canvas.Frame3D(ARect, BevelWidth, bvRaised) end else Canvas.Frame3D(ARect, BevelWidth, bvRaised); Result := Client; //Should reduce dimensions by edges and bevels. end; {Additional routines} {$IFDEF LINUX} function SearchForBrowser(const BrowserFileName : string) : string; {Search path for specified browser file name, returning its expanded file name that includes path to it.} begin Result := SearchFileInPath(BrowserFileName, '', GetEnvironmentVariable('PATH'), PathSeparator, [sffDontSearchInBasePath]); end; function GetBrowserPath : string; {Return path to first browser found.} begin Result := SearchForBrowser('firefox'); if Result = '' then Result := SearchForBrowser('konqueror'); {KDE browser} if Result = '' then Result := SearchForBrowser('epiphany'); {GNOME browser} if Result = '' then Result := SearchForBrowser('mozilla'); if Result = '' then Result := SearchForBrowser('opera'); end; {$ENDIF} end.