paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 21:55:56 +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+}
// 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 @@ type
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}

10
lcl/calendar.pp
View File

@ -30,6 +30,12 @@ unit Calendar;
{$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 @@ begin
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

9
lcl/dbgrids.pas
View File

@ -34,6 +34,13 @@ unit DBGrids;
{$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 @@ begin
//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}

12
lcl/defaulttranslator.pas
View File

@ -32,11 +32,17 @@ localization found.
}
{$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 @@ uses Menus;
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 @@ begin
(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

8
lcl/dirsel.pas
View File

@ -24,6 +24,12 @@ unit DirSel;
{$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 @@ var
implementation
const
{$IFDEF Win32}
{$IFDEF WINDOWS}
FindMask = '*.*';
{$ELSE}
FindMask = '*';

6
lcl/fileutil.pas
View File

@ -23,6 +23,12 @@ unit FileUtil;
{$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

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 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 @@ end;
function TCustomGrid.InternalNeedBorder: boolean;
begin
{$IFDEF WIN32}
{$IFDEF WINDOWS}
result := FFlat and (FGridBorderStyle = bsSingle);
{$ELSE}
result := FGridBorderStyle = bsSingle;
@ -2184,7 +2191,7 @@ function TCustomGrid.ScrollBarIsVisible(Which: Integer): Boolean;
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 @@ end;
function TCustomGrid.GetSystemMetricsGapSize(const Index: Integer): Integer;
begin
{$ifdef Win32}
{$ifdef WINDOWS}
result := 0;
{$else}
result := 3;
@ -5245,7 +5252,7 @@ begin
end;
procedure TCustomGrid.EditorShowChar(Ch: Char);
{$ifndef win32}
{$ifndef WINDOWS}
var
msg: TGridMessage;
{$endif}
@ -5255,7 +5262,7 @@ begin
//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.

2
lcl/include/customnotebook.inc
View File

@ -450,7 +450,7 @@ begin
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;

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

@ -43,7 +43,7 @@ Interface
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 @@ Uses
// WinCEWSCheckLst,
// WinCEWSCListBox,
// WinCEWSComCtrls,
WinCEWSControls,
// WinCEWSControls,
// WinCEWSDbCtrls,
// WinCEWSDBGrids,
// WinCEWSDialogs,
@ -105,7 +105,7 @@ Uses
// WinCEWSExtCtrls,
// WinCEWSExtDlgs,
// WinCEWSFileCtrl,
WinCEWSForms,
// WinCEWSForms,
// WinCEWSGrids,
// WinCEWSImgList,
// WinCEWSMaskEdit,

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

@ -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 @@ function TWinCEWidgetSet.ReplaceBitmapMask(var Image, Mask: HBitmap;
begin
Result:=inherited ReplaceBitmapMask(Image, Mask, NewMask);
end;
}
//##apiwiz##epi## // Do not remove

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

@ -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 GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRec
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

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

@ -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 @@ begin
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;
procedure TWinCEWidgetSet.AppWaitMessage;

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

@ -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 @@ end;
function TWinCEWidgetSet.WindowFromPoint(Point: TPoint): HWND;
begin
Result:=inherited WindowFromPoint(Point);
end;
end;}
//##apiwiz##epi## // Do not remove

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

@ -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 TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean;
function VkKeyScan(AChar: Char): Short; override;
Function WindowFromPoint(Point : TPoint) : HWND; override;
}
//##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+}
{$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,8 +74,14 @@ function CharUpper(c: char): char; inline;
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 @@ var
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));

8
lcl/lclproc.pas
View File

@ -27,6 +27,12 @@ unit LCLProc;
{$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 @@ begin
// 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);

14
lcl/lcltype.pp
View File

@ -38,6 +38,12 @@ unit LCLType;
{$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 @@ uses
{$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 @@ type
TRTLCriticalSection = pointer;
{$ifndef win32}
{$ifndef WINDOWS}
{$IFDEF CPU64}
// temp solution for 32bit system.Thandle
THandle = type PtrInt;
@ -1461,7 +1467,7 @@ const
SYS_COLOR_BASE = TColorRef($80000000);
{$ifndef win32}
{$ifndef WINDOWS}
R2_BLACK = 0;
R2_COPYPEN = 1;
R2_MASKNOTPEN = 2;

12
lcl/lmessages.pp
View File

@ -27,12 +27,18 @@ unit LMessages;
{$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 @@ type
Result: LRESULT;
end;
{$ifndef win32}
{$ifndef WINDOWS}
TLMNoParams = record
Msg: Cardinal;
Unused: array[0..1] of PtrInt;

8
lcl/translations.pas
View File

@ -41,6 +41,12 @@ unit Translations;
{$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 @@ implementation
// 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);