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

fixes for compiling wince

Browse Source 
git-svn-id: trunk@8757 -
This commit is contained in:
mattias 2006-02-17 13:57:15 +00:00
parent afa4591abd
commit c17929dd5f
19 changed files with 148 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lcl/asyncprocess.pp
View File

@ -25,6 +25,12 @@ unit AsyncProcess;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
interface interface
uses uses
@ -54,17 +60,22 @@ type
implementation implementation
{$ifdef WIN32} {$ifdef WINDOWS}
uses Windows; uses Windows;
function TAsyncProcess.GetNumBytesAvailable: dword; function TAsyncProcess.GetNumBytesAvailable: dword;
begin begin
{$ifdef wince}
// Windows CE doesn´t have the API function PeekNamedPipe
Result := 0;
{$else}
if not (poUsePipes in Options) then if not (poUsePipes in Options) then
Result := 0 Result := 0
else else
if not PeekNamedPipe(Output.Handle, nil, 0, nil, @Result, nil) then if not PeekNamedPipe(Output.Handle, nil, 0, nil, @Result, nil) then
Result := 0; Result := 0;
{$endif}
end; end;
{$else} {$else}

10
lcl/calendar.pp
View File

@ -30,6 +30,12 @@ unit Calendar;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
interface interface
uses uses
@ -222,13 +228,13 @@ begin
end; end;
procedure TCustomCalendar.SetDateTime(const AValue: TDateTime); procedure TCustomCalendar.SetDateTime(const AValue: TDateTime);
{$IFDEF WIN32} {$IFDEF WINDOWS}
var var
CalendarMinDate,CalendarMaxDate: integer; CalendarMinDate,CalendarMaxDate: integer;
{$ENDIF} {$ENDIF}
begin begin
if AValue=FDate then exit; 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 CalendarMinDate:=-53787;// 14 sep 1752, start of Gregorian calendar in England
CalendarMaxDate:=trunc(MaxDateTime); CalendarMaxDate:=trunc(MaxDateTime);
if not ((AValue>=CalendarMinDate)and(AValue<=CalendarMaxDate)) then if not ((AValue>=CalendarMinDate)and(AValue<=CalendarMaxDate)) then

9
lcl/dbgrids.pas
View File

@ -34,6 +34,13 @@ unit DBGrids;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$define EnableIsSeq} {$define EnableIsSeq}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
interface interface
uses uses
@ -1267,7 +1274,7 @@ begin
//ScrollBarPosition(SB_VERT, aPos); //ScrollBarPosition(SB_VERT, aPos);
FillChar(ScrollInfo, SizeOf(ScrollInfo), 0); FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
ScrollInfo.cbSize := SizeOf(ScrollInfo); ScrollInfo.cbSize := SizeOf(ScrollInfo);
{$ifdef WIN32} {$ifdef WINDOWS}
ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL; ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
ScrollInfo.ntrackPos := 0; ScrollInfo.ntrackPos := 0;
{$else} {$else}

12
lcl/defaulttranslator.pas
View File

@ -32,11 +32,17 @@ localization found.
} }
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
interface interface
uses uses
Classes, SysUtils, LResources, GetText, Controls, typinfo Classes, SysUtils, LResources, GetText, Controls, typinfo
{$IFDEF MSWINDOWS},Windows{$ENDIF}; {$IFDEF WINDOWS},Windows{$ENDIF};
{$IFDEF TRANSLATESTRING} {$IFDEF TRANSLATESTRING}
type type
TDefaultTranslator=class(TAbstractTranslator) TDefaultTranslator=class(TAbstractTranslator)
@ -54,7 +60,7 @@ uses Menus;
function FindLocaleFileName:string; function FindLocaleFileName:string;
var LANG,lng:string; var LANG,lng:string;
i: Integer; i: Integer;
{$IFDEF Win32} {$IFDEF WINDOWS}
Buffer:array[1..4]of char; Buffer:array[1..4]of char;
{$ENDIF} {$ENDIF}
begin begin
@ -66,7 +72,7 @@ begin
(paramstr(i)='-l') or (paramstr(i)='-l') or
(paramstr(i)='--lang') then LANG:=ParamStr(i+1); (paramstr(i)='--lang') then LANG:=ParamStr(i+1);
end; end;
{$IFDEF Win32} {$IFDEF WINDOWS}
//Modified code from lazconf.inc //Modified code from lazconf.inc
if LANG='' then if LANG='' then
begin begin

8
lcl/dirsel.pas
View File

@ -24,6 +24,12 @@ unit DirSel;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
interface interface
uses uses
@ -70,7 +76,7 @@ var
implementation implementation
const const
{$IFDEF Win32} {$IFDEF WINDOWS}
FindMask = '*.*'; FindMask = '*.*';
{$ELSE} {$ELSE}
FindMask = '*'; FindMask = '*';

6
lcl/fileutil.pas
View File

@ -23,6 +23,12 @@ unit FileUtil;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
interface interface
uses uses

17
lcl/grids.pas
View File

@ -35,6 +35,13 @@ The log was moved to end of file, search for: The_Log
{$define UseClipRect} {$define UseClipRect}
{$define LooseCount} {$define LooseCount}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
unit Grids; unit Grids;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
@ -1565,7 +1572,7 @@ end;
function TCustomGrid.InternalNeedBorder: boolean; function TCustomGrid.InternalNeedBorder: boolean;
begin begin
{$IFDEF WIN32} {$IFDEF WINDOWS}
result := FFlat and (FGridBorderStyle = bsSingle); result := FFlat and (FGridBorderStyle = bsSingle);
{$ELSE} {$ELSE}
result := FGridBorderStyle = bsSingle; result := FGridBorderStyle = bsSingle;
@ -2184,7 +2191,7 @@ function TCustomGrid.ScrollBarIsVisible(Which: Integer): Boolean;
begin begin
Result:=false; Result:=false;
if HandleAllocated then begin if HandleAllocated then begin
{$IFNDEF WIN32} {$IFNDEF WINDOWS}
Result:= getScrollbarVisible(handle, Which); Result:= getScrollbarVisible(handle, Which);
{$ELSE} {$ELSE}
// Is up to the widgetset to implement GetScrollbarvisible // Is up to the widgetset to implement GetScrollbarvisible
@ -3450,7 +3457,7 @@ end;
function TCustomGrid.GetSystemMetricsGapSize(const Index: Integer): Integer; function TCustomGrid.GetSystemMetricsGapSize(const Index: Integer): Integer;
begin begin
{$ifdef Win32} {$ifdef WINDOWS}
result := 0; result := 0;
{$else} {$else}
result := 3; result := 3;
@ -5245,7 +5252,7 @@ begin
end; end;
procedure TCustomGrid.EditorShowChar(Ch: Char); procedure TCustomGrid.EditorShowChar(Ch: Char);
{$ifndef win32} {$ifndef WINDOWS}
var var
msg: TGridMessage; msg: TGridMessage;
{$endif} {$endif}
@ -5255,7 +5262,7 @@ begin
//DebugLn('Posting editor LM_CHAR, ch=',ch, ' ', InttoStr(Ord(ch))); //DebugLn('Posting editor LM_CHAR, ch=',ch, ' ', InttoStr(Ord(ch)));
if EditorCanProcessKey(ch) and not EditorIsReadOnly then begin if EditorCanProcessKey(ch) and not EditorIsReadOnly then begin
EditorShow(true); EditorShow(true);
{$ifdef WIN32} {$ifdef WINDOWS}
// lcl win32 interface does a big mess with the message // lcl win32 interface does a big mess with the message
// as we only need the message to be handled by destination // as we only need the message to be handled by destination
// then we send it directly to it bypassing the queue. // then we send it directly to it bypassing the queue.

2
lcl/include/customnotebook.inc
View File

@ -450,7 +450,7 @@ begin
if PageIndex = -1 then if PageIndex = -1 then
FPageIndex := Index; FPageIndex := Index;
{$ifndef WIN32} {$ifndef WINDOWS}
// TODO: remove when gtk widgetset fixed to show tabpage tab upon // TODO: remove when gtk widgetset fixed to show tabpage tab upon
// AddPage, instead of needing TabPage.Visible := true // AddPage, instead of needing TabPage.Visible := true
APage.Visible := true; APage.Visible := true;

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

@ -43,7 +43,7 @@ Interface
Uses Uses
Types, Classes, ComCtrls, Controls, Buttons, Dialogs, ExtCtrls, Forms, Types, Classes, ComCtrls, Controls, Buttons, Dialogs, ExtCtrls, Forms,
GraphMath, GraphType, InterfaceBase, LCLIntf, LCLType, GraphMath, GraphType, InterfaceBase, LCLIntf, LCLType,
LMessages, StdCtrls, SysUtils, Graphics, Menus; LMessages, StdCtrls, SysUtils, Graphics, Menus, Windows;
Type Type
{ WinCE interface-object class } { WinCE interface-object class }
@ -96,7 +96,7 @@ Uses
// WinCEWSCheckLst, // WinCEWSCheckLst,
// WinCEWSCListBox, // WinCEWSCListBox,
// WinCEWSComCtrls, // WinCEWSComCtrls,
WinCEWSControls, // WinCEWSControls,
// WinCEWSDbCtrls, // WinCEWSDbCtrls,
// WinCEWSDBGrids, // WinCEWSDBGrids,
// WinCEWSDialogs, // WinCEWSDialogs,
@ -105,7 +105,7 @@ Uses
// WinCEWSExtCtrls, // WinCEWSExtCtrls,
// WinCEWSExtDlgs, // WinCEWSExtDlgs,
// WinCEWSFileCtrl, // WinCEWSFileCtrl,
WinCEWSForms, // WinCEWSForms,
// WinCEWSGrids, // WinCEWSGrids,
// WinCEWSImgList, // WinCEWSImgList,
// WinCEWSMaskEdit, // WinCEWSMaskEdit,

4
lcl/interfaces/wince/wincelclintf.inc
View File

@ -33,7 +33,7 @@
******************************************************************************} ******************************************************************************}
//##apiwiz##sps## // Do not remove //##apiwiz##sps## // Do not remove
function TWinCEWidgetSet.DrawSplitter(DC: HDC; const ARect: TRect; {function TWinCEWidgetSet.DrawSplitter(DC: HDC; const ARect: TRect;
Horizontal: boolean): boolean; Horizontal: boolean): boolean;
begin begin
Result:=inherited DrawSplitter(DC, ARect, Horizontal); Result:=inherited DrawSplitter(DC, ARect, Horizontal);
@ -88,6 +88,6 @@ function TWinCEWidgetSet.ReplaceBitmapMask(var Image, Mask: HBitmap;
begin begin
Result:=inherited ReplaceBitmapMask(Image, Mask, NewMask); Result:=inherited ReplaceBitmapMask(Image, Mask, NewMask);
end; end;
}
//##apiwiz##epi## // Do not remove //##apiwiz##epi## // Do not remove

4
lcl/interfaces/wince/wincelclintfh.inc
View File

@ -27,7 +27,7 @@
} }
//##apiwiz##sps## // Do not remove //##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; function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
Str: PChar; Count: Longint; Dx: PInteger): Boolean; override; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
@ -43,6 +43,6 @@ function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRec
function IntfSendsUTF8KeyPress: boolean; override; function IntfSendsUTF8KeyPress: boolean; override;
function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean; override; function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean; override;
}
//##apiwiz##eps## // Do not remove, no wizard declaration after this line //##apiwiz##eps## // Do not remove, no wizard declaration after this line

28
lcl/interfaces/wince/winceobject.inc
View File

@ -26,13 +26,22 @@
{ TWinCEWidgetSet } { TWinCEWidgetSet }
{------------------------------------------------------------------------------
Method: TWinCEWidgetSet.Create
Params: None
Returns: Nothing
Constructor for the class.
------------------------------------------------------------------------------}
constructor TWinCEWidgetSet.Create; constructor TWinCEWidgetSet.Create;
begin begin
Inherited Create;
end; end;
destructor TWinCEWidgetSet.Destroy; destructor TWinCEWidgetSet.Destroy;
begin begin
inherited Destroy; inherited Destroy;
end; end;
@ -73,9 +82,24 @@ begin
end; end;
procedure TWinCEWidgetSet.AppProcessMessages; {------------------------------------------------------------------------------
begin Method: TWinCEWidgetSet.AppProcessMessages
Params: None
Returns: Nothing
Handle all pending messages
------------------------------------------------------------------------------}
procedure TWinCEWidgetSet.AppProcessMessages;
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; end;
procedure TWinCEWidgetSet.AppWaitMessage; procedure TWinCEWidgetSet.AppWaitMessage;

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

@ -33,7 +33,7 @@
******************************************************************************} ******************************************************************************}
//##apiwiz##sps## // Do not remove //##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; angle2: Integer): Boolean;
begin begin
Result:=inherited Arc(DC, Left, Top, width, height, angle1, angle2); Result:=inherited Arc(DC, Left, Top, width, height, angle1, angle2);
@ -934,6 +934,6 @@ end;
function TWinCEWidgetSet.WindowFromPoint(Point: TPoint): HWND; function TWinCEWidgetSet.WindowFromPoint(Point: TPoint): HWND;
begin begin
Result:=inherited WindowFromPoint(Point); Result:=inherited WindowFromPoint(Point);
end; end;}
//##apiwiz##epi## // Do not remove //##apiwiz##epi## // Do not remove

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

@ -37,7 +37,7 @@
******************************************************************************} ******************************************************************************}
//##apiwiz##sps## // Do not remove //##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 AngleChord(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean; override;
function BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc; override; function BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc; override;
@ -222,7 +222,7 @@ Function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean;
function VkKeyScan(AChar: Char): Short; override; function VkKeyScan(AChar: Char): Short; override;
Function WindowFromPoint(Point : TPoint) : HWND; override; Function WindowFromPoint(Point : TPoint) : HWND; override;
}
//##apiwiz##eps## // Do not remove, no wizard declaration after this line //##apiwiz##eps## // Do not remove, no wizard declaration after this line

18
lcl/lclintf.pas
View File

@ -39,6 +39,12 @@ unit LCLIntf;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$inline on} {$inline on}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
interface interface
uses uses
@ -68,8 +74,14 @@ function CharUpper(c: char): char; inline;
function MsgKeyDataToShiftState(KeyData: Longint): TShiftState; function MsgKeyDataToShiftState(KeyData: Longint): TShiftState;
{$IFDEF win32} {$IFDEF WINDOWS}
function GetTickCount: DWord; stdcall; external 'kernel32.dll' name 'GetTickCount';
{$IFDEF Win32}
function GetTickCount:DWORD; stdcall; external 'kernel32.dll' name 'GetTickCount';
{$ELSE}
function GetTickCount:DWORD; stdcall; external KernelDLL name 'GetTickCount';
{$ENDIF}
{$ELSE} {$ELSE}
function GetTickCount: DWord; function GetTickCount: DWord;
{$ENDIF} {$ENDIF}
@ -87,7 +99,7 @@ var
LowerCaseChars: array[char] of char; LowerCaseChars: array[char] of char;
UpperCaseChars: array[char] of char; UpperCaseChars: array[char] of char;
{$IFNDEF Win32} {$IFNDEF WINDOWS}
function GetTickCount: DWord; function GetTickCount: DWord;
begin begin
Result := DWord(Trunc(Now * 24 * 60 * 60 * 1000)); Result := DWord(Trunc(Now * 24 * 60 * 60 * 1000));

8
lcl/lclproc.pas
View File

@ -27,6 +27,12 @@ unit LCLProc;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$inline on} {$inline on}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
interface interface
uses uses
@ -2129,7 +2135,7 @@ begin
// fpc 2.1.1 stores string constants as array of char so maybe this // 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): // will work for without ifdef (once available in 2.0.x too):
// move(lineending, dest^, sizeof(LineEnding)); // move(lineending, dest^, sizeof(LineEnding));
{$IFDEF win32} {$IFDEF WINDOWS}
begin begin
move(lineending[1], dest^, length(LineEnding)); move(lineending[1], dest^, length(LineEnding));
inc(dest^, length(LineEnding)-1); inc(dest^, length(LineEnding)-1);

14
lcl/lcltype.pp
View File

@ -38,6 +38,12 @@ unit LCLType;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
interface interface
@ -49,9 +55,9 @@ uses
{$IFDEF USE_UTF8BIDI_LCL} {$IFDEF USE_UTF8BIDI_LCL}
UTF8BIDI, UTF8BIDI,
{$ENDIF USE_UTF8BIDI_LCL} {$ENDIF USE_UTF8BIDI_LCL}
{$ifdef win32} {$ifdef WINDOWS}
windows, windows,
{$endif win32} {$endif WINDOWS}
Classes, SysUtils; Classes, SysUtils;
type type
@ -76,7 +82,7 @@ type
TRTLCriticalSection = pointer; TRTLCriticalSection = pointer;
{$ifndef win32} {$ifndef WINDOWS}
{$IFDEF CPU64} {$IFDEF CPU64}
// temp solution for 32bit system.Thandle // temp solution for 32bit system.Thandle
THandle = type PtrInt; THandle = type PtrInt;
@ -1461,7 +1467,7 @@ const
SYS_COLOR_BASE = TColorRef($80000000); SYS_COLOR_BASE = TColorRef($80000000);
{$ifndef win32} {$ifndef WINDOWS}
R2_BLACK = 0; R2_BLACK = 0;
R2_COPYPEN = 1; R2_COPYPEN = 1;
R2_MASKNOTPEN = 2; R2_MASKNOTPEN = 2;

12
lcl/lmessages.pp
View File

@ -27,12 +27,18 @@ unit LMessages;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
// FPC <= 2.0.2 compatibility code
// WINDOWS define was added after FPC 2.0.2
{$ifdef win32}
{$define WINDOWS}
{$endif}
interface interface
uses Classes, SysUtils, LCLType, GraphType uses Classes, SysUtils, LCLType, GraphType
{$ifdef win32} {$ifdef WINDOWS}
,messages ,messages
{$endif win32} {$endif WINDOWS}
; ;
const const
@ -369,7 +375,7 @@ type
Result: LRESULT; Result: LRESULT;
end; end;
{$ifndef win32} {$ifndef WINDOWS}
TLMNoParams = record TLMNoParams = record
Msg: Cardinal; Msg: Cardinal;
Unused: array[0..1] of PtrInt; Unused: array[0..1] of PtrInt;

8
lcl/translations.pas
View File

@ -41,6 +41,12 @@ unit Translations;
{$mode objfpc}{$H+}{$INLINE ON} {$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 interface
uses uses
@ -91,7 +97,7 @@ implementation
// GetLanguageIDs is part of the fcl in 2.0.1 and later // GetLanguageIDs is part of the fcl in 2.0.1 and later
{$ifdef ver2_0_0} {$ifdef ver2_0_0}
{$ifdef win32} {$ifdef WINDOWS}
uses uses
windows; windows;
procedure GetLanguageIDs(var Lang, FallbackLang: string); procedure GetLanguageIDs(var Lang, FallbackLang: string);