Hello,
This patch makes Windows CE interface compile while keeping
compatibility with FPC 2.0.2.
The WinCE widgetset is a empty shell, but it compiles with the arm cross
compiler and runs on the emulator without problems.
Felipe
Index: lcl/asyncprocess.pp
===================================================================
--- lcl/asyncprocess.pp (revision 8747)
+++ lcl/asyncprocess.pp (working copy)
@@ -25,6 +25,12 @@
{$mode objfpc}{$H+}
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
uses
@@ -54,17 +60,22 @@
implementation
-{$ifdef WIN32}
+{$ifdef WINDOWS}
uses Windows;
function TAsyncProcess.GetNumBytesAvailable: dword;
begin
+{$ifdef wince}
+ // Windows CE doesn´t have the API function PeekNamedPipe
+ Result := 0;
+{$else}
if not (poUsePipes in Options) then
Result := 0
else
if not PeekNamedPipe(Output.Handle, nil, 0, nil, @Result, nil) then
Result := 0;
+{$endif}
end;
{$else}
Index: lcl/calendar.pp
===================================================================
--- lcl/calendar.pp (revision 8747)
+++ lcl/calendar.pp (working copy)
@@ -30,6 +30,12 @@
{$mode objfpc}{$H+}
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
uses
@@ -222,13 +228,13 @@
end;
procedure TCustomCalendar.SetDateTime(const AValue: TDateTime);
-{$IFDEF WIN32}
+{$IFDEF WINDOWS}
var
CalendarMinDate,CalendarMaxDate: integer;
{$ENDIF}
begin
if AValue=FDate then exit;
- {$IFDEF WIN32} // TODO: move this test to the win32 interface?
+ {$IFDEF WINDOWS} // TODO: move this test to the win32 interface?
CalendarMinDate:=-53787;// 14 sep 1752, start of Gregorian calendar in
England
CalendarMaxDate:=trunc(MaxDateTime);
if not ((AValue>=CalendarMinDate)and(AValue<=CalendarMaxDate)) then
Index: lcl/dbgrids.pas
===================================================================
--- lcl/dbgrids.pas (revision 8747)
+++ lcl/dbgrids.pas (working copy)
@@ -34,6 +34,13 @@
{$mode objfpc}{$H+}
{$define EnableIsSeq}
+
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
uses
@@ -1267,7 +1274,7 @@
//ScrollBarPosition(SB_VERT, aPos);
FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
ScrollInfo.cbSize := SizeOf(ScrollInfo);
- {$ifdef WIN32}
+ {$ifdef WINDOWS}
ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
ScrollInfo.ntrackPos := 0;
{$else}
Index: lcl/defaulttranslator.pas
===================================================================
--- lcl/defaulttranslator.pas (revision 8747)
+++ lcl/defaulttranslator.pas (working copy)
@@ -32,11 +32,17 @@
}
{$mode objfpc}{$H+}
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
uses
Classes, SysUtils, LResources, GetText, Controls, typinfo
- {$IFDEF MSWINDOWS},Windows{$ENDIF};
+ {$IFDEF WINDOWS},Windows{$ENDIF};
{$IFDEF TRANSLATESTRING}
type
TDefaultTranslator=class(TAbstractTranslator)
@@ -54,7 +60,7 @@
function FindLocaleFileName:string;
var LANG,lng:string;
i: Integer;
- {$IFDEF Win32}
+ {$IFDEF WINDOWS}
Buffer:array[1..4]of char;
{$ENDIF}
begin
@@ -66,7 +72,7 @@
(paramstr(i)='-l') or
(paramstr(i)='--lang') then LANG:=ParamStr(i+1);
end;
- {$IFDEF Win32}
+ {$IFDEF WINDOWS}
//Modified code from lazconf.inc
if LANG='' then
begin
Index: lcl/dirsel.pas
===================================================================
--- lcl/dirsel.pas (revision 8747)
+++ lcl/dirsel.pas (working copy)
@@ -24,6 +24,12 @@
{$mode objfpc}{$H+}
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
uses
@@ -70,7 +76,7 @@
implementation
const
- {$IFDEF Win32}
+ {$IFDEF WINDOWS}
FindMask = '*.*';
{$ELSE}
FindMask = '*';
Index: lcl/fileutil.pas
===================================================================
--- lcl/fileutil.pas (revision 8747)
+++ lcl/fileutil.pas (working copy)
@@ -23,6 +23,12 @@
{$mode objfpc}{$H+}
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
uses
@@ -99,7 +105,7 @@
implementation
-{$IFNDEF windows}
+{$IFNDEF WINDOWS}
uses
Unix, BaseUnix;
{$ENDIF}
Index: lcl/grids.pas
===================================================================
--- lcl/grids.pas (revision 8747)
+++ lcl/grids.pas (working copy)
@@ -35,6 +35,13 @@
{$define UseClipRect}
{$define LooseCount}
+
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
unit Grids;
{$mode objfpc}{$H+}
@@ -1565,7 +1572,7 @@
function TCustomGrid.InternalNeedBorder: boolean;
begin
- {$IFDEF WIN32}
+ {$IFDEF WINDOWS}
result := FFlat and (FGridBorderStyle = bsSingle);
{$ELSE}
result := FGridBorderStyle = bsSingle;
@@ -2184,7 +2191,7 @@
begin
Result:=false;
if HandleAllocated then begin
- {$IFNDEF WIN32}
+ {$IFNDEF WINDOWS}
Result:= getScrollbarVisible(handle, Which);
{$ELSE}
// Is up to the widgetset to implement GetScrollbarvisible
@@ -3450,7 +3457,7 @@
function TCustomGrid.GetSystemMetricsGapSize(const Index: Integer): Integer;
begin
- {$ifdef Win32}
+ {$ifdef WINDOWS}
result := 0;
{$else}
result := 3;
@@ -5245,7 +5252,7 @@
end;
procedure TCustomGrid.EditorShowChar(Ch: Char);
-{$ifndef win32}
+{$ifndef WINDOWS}
var
msg: TGridMessage;
{$endif}
@@ -5255,7 +5262,7 @@
//DebugLn('Posting editor LM_CHAR, ch=',ch, ' ', InttoStr(Ord(ch)));
if EditorCanProcessKey(ch) and not EditorIsReadOnly then begin
EditorShow(true);
- {$ifdef WIN32}
+ {$ifdef WINDOWS}
// lcl win32 interface does a big mess with the message
// as we only need the message to be handled by destination
// then we send it directly to it bypassing the queue.
Index: lcl/include/customnotebook.inc
===================================================================
--- lcl/include/customnotebook.inc (revision 8747)
+++ lcl/include/customnotebook.inc (working copy)
@@ -450,7 +450,7 @@
if PageIndex = -1 then
FPageIndex := Index;
- {$ifndef WIN32}
+ {$ifndef WINDOWS}
// TODO: remove when gtk widgetset fixed to show tabpage tab upon
// AddPage, instead of needing TabPage.Visible := true
APage.Visible := true;
Index: lcl/interfaces/wince/winceint.pp
===================================================================
--- lcl/interfaces/wince/winceint.pp (revision 8747)
+++ lcl/interfaces/wince/winceint.pp (working copy)
@@ -43,7 +43,7 @@
Uses
Types, Classes, ComCtrls, Controls, Buttons, Dialogs, ExtCtrls, Forms,
GraphMath, GraphType, InterfaceBase, LCLIntf, LCLType,
- LMessages, StdCtrls, SysUtils, Graphics, Menus;
+ LMessages, StdCtrls, SysUtils, Graphics, Menus, Windows;
Type
{ WinCE interface-object class }
@@ -96,7 +96,7 @@
// WinCEWSCheckLst,
// WinCEWSCListBox,
// WinCEWSComCtrls,
- WinCEWSControls,
+// WinCEWSControls,
// WinCEWSDbCtrls,
// WinCEWSDBGrids,
// WinCEWSDialogs,
@@ -105,7 +105,7 @@
// WinCEWSExtCtrls,
// WinCEWSExtDlgs,
// WinCEWSFileCtrl,
- WinCEWSForms,
+// WinCEWSForms,
// WinCEWSGrids,
// WinCEWSImgList,
// WinCEWSMaskEdit,
Index: lcl/interfaces/wince/wincelclintf.inc
===================================================================
--- lcl/interfaces/wince/wincelclintf.inc (revision 8747)
+++ lcl/interfaces/wince/wincelclintf.inc (working copy)
@@ -33,7 +33,7 @@
******************************************************************************}
//##apiwiz##sps## // Do not remove
-function TWinCEWidgetSet.DrawSplitter(DC: HDC; const ARect: TRect;
+{function TWinCEWidgetSet.DrawSplitter(DC: HDC; const ARect: TRect;
Horizontal: boolean): boolean;
begin
Result:=inherited DrawSplitter(DC, ARect, Horizontal);
@@ -88,6 +88,6 @@
begin
Result:=inherited ReplaceBitmapMask(Image, Mask, NewMask);
end;
-
+}
//##apiwiz##epi## // Do not remove
Index: lcl/interfaces/wince/wincelclintfh.inc
===================================================================
--- lcl/interfaces/wince/wincelclintfh.inc (revision 8747)
+++ lcl/interfaces/wince/wincelclintfh.inc (working copy)
@@ -27,7 +27,7 @@
}
//##apiwiz##sps## // Do not remove
-function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean):
boolean; override;
+{function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean):
boolean; override;
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
@@ -43,6 +43,6 @@
function IntfSendsUTF8KeyPress: boolean; override;
function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap):
boolean; override;
-
+}
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
Index: lcl/interfaces/wince/winceobject.inc
===================================================================
--- lcl/interfaces/wince/winceobject.inc (revision 8747)
+++ lcl/interfaces/wince/winceobject.inc (working copy)
@@ -26,13 +26,22 @@
{ TWinCEWidgetSet }
+{------------------------------------------------------------------------------
+ Method: TWinCEWidgetSet.Create
+ Params: None
+ Returns: Nothing
+
+ Constructor for the class.
+
------------------------------------------------------------------------------}
constructor TWinCEWidgetSet.Create;
begin
+ Inherited Create;
end;
destructor TWinCEWidgetSet.Destroy;
begin
+
inherited Destroy;
end;
@@ -73,9 +82,24 @@
end;
+{------------------------------------------------------------------------------
+ Method: TWinCEWidgetSet.AppProcessMessages
+ Params: None
+ Returns: Nothing
+
+ Handle all pending messages
+
------------------------------------------------------------------------------}
procedure TWinCEWidgetSet.AppProcessMessages;
-begin
-
+var
+ AMessage: TMsg;
+ AccelTable: HACCEL;
+ retVal, index: dword;
+Begin
+ while Windows.PeekMessage(AMessage, HWnd(Nil), 0, 0,PM_REMOVE) do
+ begin
+ Windows.TranslateMessage(@AMessage);
+ Windows.DispatchMessage(@AMessage);
+ end;
end;
procedure TWinCEWidgetSet.AppWaitMessage;
Index: lcl/interfaces/wince/wincewinapi.inc
===================================================================
--- lcl/interfaces/wince/wincewinapi.inc (revision 8747)
+++ lcl/interfaces/wince/wincewinapi.inc (working copy)
@@ -33,7 +33,7 @@
******************************************************************************}
//##apiwiz##sps## // Do not remove
-function TWinCEWidgetSet.Arc(DC: HDC; Left, Top, width, height, angle1,
+{function TWinCEWidgetSet.Arc(DC: HDC; Left, Top, width, height, angle1,
angle2: Integer): Boolean;
begin
Result:=inherited Arc(DC, Left, Top, width, height, angle1, angle2);
@@ -934,6 +934,6 @@
function TWinCEWidgetSet.WindowFromPoint(Point: TPoint): HWND;
begin
Result:=inherited WindowFromPoint(Point);
-end;
+end;}
//##apiwiz##epi## // Do not remove
Index: lcl/interfaces/wince/wincewinapih.inc
===================================================================
--- lcl/interfaces/wince/wincewinapih.inc (revision 8747)
+++ lcl/interfaces/wince/wincewinapih.inc (working copy)
@@ -37,7 +37,7 @@
******************************************************************************}
//##apiwiz##sps## // Do not remove
-function Arc(DC: HDC; Left,Top,width,height,angle1,angle2 : Integer): Boolean;
override;
+{function Arc(DC: HDC; Left,Top,width,height,angle1,angle2 : Integer):
Boolean; override;
function AngleChord(DC: HDC; x,y,width,height,angle1,angle2 : Integer):
Boolean; override;
function BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc; override;
@@ -222,7 +222,7 @@
function VkKeyScan(AChar: Char): Short; override;
Function WindowFromPoint(Point : TPoint) : HWND; override;
-
+}
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
Index: lcl/lclintf.pas
===================================================================
--- lcl/lclintf.pas (revision 8747)
+++ lcl/lclintf.pas (working copy)
@@ -39,6 +39,12 @@
{$mode objfpc}{$H+}
{$inline on}
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
uses
@@ -68,9 +74,15 @@
function MsgKeyDataToShiftState(KeyData: Longint): TShiftState;
-{$IFDEF win32}
-function GetTickCount: DWord; stdcall; external 'kernel32.dll' name
'GetTickCount';
+{$IFDEF WINDOWS}
+
+{$IFDEF Win32}
+function GetTickCount:DWORD; stdcall; external 'kernel32.dll' name
'GetTickCount';
{$ELSE}
+function GetTickCount:DWORD; stdcall; external KernelDLL name 'GetTickCount';
+{$ENDIF}
+
+{$ELSE}
function GetTickCount: DWord;
{$ENDIF}
@@ -87,7 +99,7 @@
LowerCaseChars: array[char] of char;
UpperCaseChars: array[char] of char;
-{$IFNDEF Win32}
+{$IFNDEF WINDOWS}
function GetTickCount: DWord;
begin
Result := DWord(Trunc(Now * 24 * 60 * 60 * 1000));
Index: lcl/lclproc.pas
===================================================================
--- lcl/lclproc.pas (revision 8747)
+++ lcl/lclproc.pas (working copy)
@@ -27,6 +27,12 @@
{$mode objfpc}{$H+}
{$inline on}
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
uses
@@ -2129,7 +2135,7 @@
// fpc 2.1.1 stores string constants as array of char so maybe this
// will work for without ifdef (once available in 2.0.x too):
// move(lineending, dest^, sizeof(LineEnding));
-{$IFDEF win32}
+{$IFDEF WINDOWS}
begin
move(lineending[1], dest^, length(LineEnding));
inc(dest^, length(LineEnding)-1);
Index: lcl/lcltype.pp
===================================================================
--- lcl/lcltype.pp (revision 8747)
+++ lcl/lcltype.pp (working copy)
@@ -38,6 +38,12 @@
{$mode objfpc}{$H+}
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
@@ -49,9 +55,9 @@
{$IFDEF USE_UTF8BIDI_LCL}
UTF8BIDI,
{$ENDIF USE_UTF8BIDI_LCL}
-{$ifdef win32}
+{$ifdef WINDOWS}
windows,
-{$endif win32}
+{$endif WINDOWS}
Classes, SysUtils;
type
@@ -76,7 +82,7 @@
TRTLCriticalSection = pointer;
-{$ifndef win32}
+{$ifndef WINDOWS}
{$IFDEF CPU64}
// temp solution for 32bit system.Thandle
THandle = type PtrInt;
@@ -1461,7 +1467,7 @@
SYS_COLOR_BASE = TColorRef($80000000);
-{$ifndef win32}
+{$ifndef WINDOWS}
R2_BLACK = 0;
R2_COPYPEN = 1;
R2_MASKNOTPEN = 2;
Index: lcl/lmessages.pp
===================================================================
--- lcl/lmessages.pp (revision 8747)
+++ lcl/lmessages.pp (working copy)
@@ -27,12 +27,18 @@
{$mode objfpc}{$H+}
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
uses Classes, SysUtils, LCLType, GraphType
- {$ifdef win32}
+ {$ifdef WINDOWS}
,messages
- {$endif win32}
+ {$endif WINDOWS}
;
const
@@ -369,7 +375,7 @@
Result: LRESULT;
end;
-{$ifndef win32}
+{$ifndef WINDOWS}
TLMNoParams = record
Msg: Cardinal;
Unused: array[0..1] of PtrInt;
Index: lcl/translations.pas
===================================================================
--- lcl/translations.pas (revision 8747)
+++ lcl/translations.pas (working copy)
@@ -41,6 +41,12 @@
{$mode objfpc}{$H+}{$INLINE ON}
+// FPC <= 2.0.2 compatibility code
+// WINDOWS define was added after FPC 2.0.2
+{$ifdef win32}
+ {$define WINDOWS}
+{$endif}
+
interface
uses
@@ -91,7 +97,7 @@
// GetLanguageIDs is part of the fcl in 2.0.1 and later
{$ifdef ver2_0_0}
-{$ifdef win32}
+{$ifdef WINDOWS}
uses
windows;
procedure GetLanguageIDs(var Lang, FallbackLang: string);
