paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 05:18:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

wince:

Browse Source 
- implement monitor search functions,
  - fix calling conventions from stdcall to cdecl where is needed

git-svn-id: trunk@19267 -
This commit is contained in:
paul 2009-04-07 07:30:09 +00:00
parent 263fa6c078
commit 4e17e34447
11 changed files with 59 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/forms.pp
View File

@ -26,7 +26,7 @@
unit Forms;
{$mode objfpc}{$H+}
{$mode objfpc}{$H+}{$macro on}
interface
@ -1456,6 +1456,11 @@ procedure Register;
implementation
{$ifdef WinCE}
{$define extdecl := cdecl}
{$else}
{$define extdecl := stdcall}
{$endif}
uses
WSForms; // Widgetset uses circle is allowed

31
lcl/include/screen.inc
View File

@ -28,7 +28,7 @@ const
);
function EnumMonitors(hMonitor: HMONITOR; hdcMonitor: HDC; lprcMonitor: PRect;
dwData: LPARAM): LongBool; stdcall;
dwData: LPARAM): LongBool; extdecl;
var
Screen: TScreen absolute dwData;
Monitor: TMonitor;
@ -39,6 +39,19 @@ begin
Result := True;
end;
function EnumFontsNoDups(var LogFont: TEnumLogFontEx; var Metric: TNewTextMetricEx;
FontType: Longint; Data: LParam): LongInt; extdecl;
var
L: TStrings;
S: String;
begin
L := TStrings(PtrInt(Data));
S := LogFont.elfLogFont.lfFaceName;
if L.IndexOf(S) < 0 then
L.Add(S);
Result := 1;
end;
{------------------------------------------------------------------------------
Method: TScreen.Create
Params: AOwner: the owner of the class
@ -420,22 +433,6 @@ begin
Result := nil;
end;
function EnumFontsNoDups(
var LogFont: TEnumLogFontEx;
var Metric: TNewTextMetricEx;
FontType: Longint;
Data: LParam):LongInt; stdcall;
var
L: TStrings;
S: String;
begin
L := TStrings(PtrInt(Data));
S := LogFont.elfLogFont.lfFaceName;
if L.IndexOf(S)<0 then
L.Add(S);
result := 1;
end;
procedure GetScreenFontsList(FontList: TStrings);
var
lf: TLogFont;

2
lcl/interfaces/wince/wincecallback.inc
View File

@ -180,7 +180,7 @@ type
Handles the messages sent to the specified window, in parameter Window, by
Windows or other applications
------------------------------------------------------------------------------}
Function
function
{$ifdef MSG_DEBUG}
RealWindowProc
{$else}

7
lcl/interfaces/wince/wincedef.pp
View File

@ -110,8 +110,11 @@ type
TimerFunc: TFNTimerProc; // owner function to handle timer
end;
function EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MONITORENUMPROC; dwData: LPARAM): LongBool; external KernelDLL name 'EnumDisplayMonitors';
function GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): LongBool; external KernelDLL name 'GetMonitorInfo';
function EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MONITORENUMPROC; dwData: LPARAM): LongBool; cdecl; external KernelDLL name 'EnumDisplayMonitors';
function GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): LongBool; cdecl; external KernelDLL name 'GetMonitorInfo';
function MonitorFromWindow(hWnd: HWND; dwFlags: DWORD): HMONITOR; cdecl; external KernelDLL name 'MonitorFromWindow';
function MonitorFromRect(lprcScreenCoords: PRect; dwFlags: DWord): HMONITOR; cdecl; external KernelDLL name 'MonitorFromRect';
function MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord): HMONITOR; cdecl; external KernelDLL name 'MonitorFromPoint';
var
// FTimerData contains the currently running timers

2
lcl/interfaces/wince/winceextra.pp
View File

@ -83,7 +83,7 @@ const
{$ifdef win32}
function ImageList_Copy(himlDst: HIMAGELIST; iDst: longint; himlSrc: HIMAGELIST; Src: longint; uFlags: UINT): BOOL; stdcall; external 'comctl32';
{$else}
function ImageList_Copy(himlDst: HIMAGELIST; iDst: longint; himlSrc: HIMAGELIST; Src: longint; uFlags: UINT): BOOL; stdcall; external KernelDLL;
function ImageList_Copy(himlDst: HIMAGELIST; iDst: longint; himlSrc: HIMAGELIST; Src: longint; uFlags: UINT): BOOL; cdecl; external KernelDLL;
{$endif}
const

2
lcl/interfaces/wince/winceint.pp
View File

@ -12,7 +12,7 @@
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *

15
lcl/interfaces/wince/wincewinapi.inc
View File

@ -1889,6 +1889,21 @@ begin
PWideChar(WideLPCaption), UType);
end;
function TWinCEWidgetSet.MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord): HMONITOR;
begin
Result := WinCEDef.MonitorFromPoint(ptScreenCoords, dwFlags);
end;
function TWinCEWidgetSet.MonitorFromRect(lprcScreenCoords: PRect; dwFlags: DWord): HMONITOR;
begin
Result := WinCEDef.MonitorFromRect(lprcScreenCoords, dwFlags);
end;
function TWinCEWidgetSet.MonitorFromWindow(hWnd: HWND; dwFlags: DWord): HMONITOR;
begin
Result := WinCEDef.MonitorFromWindow(hWnd, dwFlags);
end;
{------------------------------------------------------------------------------
Method: MoveToEx
Params: DC - handle of device context

3
lcl/interfaces/wince/wincewinapih.inc
View File

@ -163,6 +163,9 @@ procedure LeaveCriticalSection(var CritSection: TCriticalSection); override;
function LineTo(DC: HDC; X, Y: Integer): Boolean; override;
function MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer; override;
function MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord): HMONITOR; override;
function MonitorFromRect(lprcScreenCoords: PRect; dwFlags: DWord): HMONITOR; override;
function MonitorFromWindow(hWnd: HWND; dwFlags: DWord): HMONITOR; override;
function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; override;
{function MoveWindowOrgEx(DC: HDC; dX, dY: Integer): Boolean; override;}
function PeekMessage(var lpMsg : TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean; override;

2
lcl/interfaces/wince/wincewsforms.pp
View File

@ -152,7 +152,7 @@ end;
function ScrollWindowPtr(hWnd:HWND; XAmount:longint; YAmount:longint; lpRect: pointer; lpClipRect: pointer):WINBOOL; stdcall; external 'user32' name 'ScrollWindow';
{$else}
function ScrollWindowPtr(hWnd:HWND; dx:longint; dy:longint; prcScroll: lpRECT; prcClip: lpRECT;
hrgnUpdate: HRGN; prcUpdate: LPRECT; flags:UINT):longint; external KernelDll name 'ScrollWindowEx';
hrgnUpdate: HRGN; prcUpdate: LPRECT; flags:UINT):longint; cdecl; external KernelDll name 'ScrollWindowEx';
{$endif}
class procedure TWinCEWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;

2
lcl/interfaces/wince/wincewsstdctrls.pp
View File

@ -376,7 +376,7 @@ end;
//roozbeh:there are still some issues with group box!
function GroupBoxPanelWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
LParam: Windows.LParam): LResult; {$ifdef win32}stdcall{$else}cdecl{$endif};
begin
// handle paint messages for theming
case Msg of

16
lcl/lcltype.pp
View File

@ -36,7 +36,7 @@ the Delphi Windows unit. This is only done for compatibiltiy.
unit LCLType;
{$mode objfpc}{$H+}
{$mode objfpc}{$H+}{$macro on}
interface
@ -54,6 +54,12 @@ uses
{$endif WINDOWS}
Classes, SysUtils;
{$ifdef WinCE}
{$define extdecl := cdecl}
{$else}
{$define extdecl := stdcall}
{$endif}
type
{$IFDEF USE_UTF8BIDI_LCL}
TUTF8Char = UTF8BIDI.TUTF8Char;
@ -2196,13 +2202,13 @@ type
end;
FontEnumProc = function (var ELogFont:TEnumLogFont; var Metric:TNewTextMetric;
FontType:longint; Data:LParam):longint; stdcall;
FontType:longint; Data:LParam):longint; extdecl;
FontEnumExProc = function (var ELogFont: TEnumLogFontEx; var Metric: TNewTextMetricEx;
FontType: Longint; Data:LParam):Longint; stdcall;
FontType: Longint; Data:LParam):Longint; extdecl;
MonitorEnumProc = function(hMonitor: HMONITOR; hdcMonitor: HDC; lprcMonitor: PRect;
dwData: LPARAM): LongBool; stdcall;
MonitorEnumProc = function(hMonitor: HMONITOR; hdcMonitor: HDC; lprcMonitor: PRect;
dwData: LPARAM): LongBool; extdecl;
PWndClassExA = ^TWndClassExA;
PWndClassExW = ^TWndClassExW;