mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 16:36:01 +02:00
wince interface: several fixes from Christian Ulrich
* closing a application * window styles + GetPixel and SetPixel git-svn-id: trunk@10207 -
This commit is contained in:
parent
9757e008dd
commit
d4dd6c0196
@ -135,13 +135,13 @@ End;
|
||||
procedure TWinCEWidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer;
|
||||
AColor: TGraphicsColor);
|
||||
begin
|
||||
|
||||
Windows.SetPixel(CanvasHandle, X, Y, AColor);
|
||||
end;
|
||||
|
||||
function TWinCEWidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer
|
||||
): TGraphicsColor;
|
||||
begin
|
||||
Result:=clNone;
|
||||
Result := Windows.GetPixel(CanvasHandle, X, Y);
|
||||
end;
|
||||
|
||||
procedure TWinCEWidgetSet.DCRedraw(CanvasHandle: HDC);
|
||||
@ -298,6 +298,7 @@ end;
|
||||
procedure TWinCEWidgetSet.AppTerminate;
|
||||
begin
|
||||
AppTerminated := True;
|
||||
PostQuitMessage(0);
|
||||
end;
|
||||
|
||||
function TWinCEWidgetSet.InitHintFont(HintFont: TObject): Boolean;
|
||||
|
@ -5,7 +5,8 @@ unit winceproc;
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Classes, LMessages, LCLType, LCLProc, Controls, Forms, Menus,WinCEWinAPIEmu;
|
||||
Windows, Classes, LMessages, LCLType, LCLProc, Controls, Forms, Menus,
|
||||
WinCEWinAPIEmu;
|
||||
|
||||
Type
|
||||
TEventType = (etNotify, etKey, etKeyPress, etMouseWheel, etMouseUpDown);
|
||||
@ -283,27 +284,48 @@ end;
|
||||
|
||||
function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD;
|
||||
begin
|
||||
Result := WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
|
||||
case Style of
|
||||
bsSizeable, bsSizeToolWin:
|
||||
Result := Result or (WS_OVERLAPPED or WS_THICKFRAME or WS_CAPTION);
|
||||
bsSingle, bsToolWindow:
|
||||
Result := Result or (WS_OVERLAPPED or WS_BORDER or WS_CAPTION);
|
||||
bsDialog:
|
||||
Result := Result or (WS_POPUP or WS_BORDER or WS_CAPTION);
|
||||
bsNone:
|
||||
Result := Result or WS_POPUP;
|
||||
case Application.ApplicationType of
|
||||
atDesktop,atHandheld:
|
||||
begin
|
||||
Result := WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
|
||||
case Style of
|
||||
bsSizeable, bsSizeToolWin:
|
||||
Result := Result or (WS_OVERLAPPED or WS_THICKFRAME or WS_CAPTION);
|
||||
bsSingle, bsToolWindow:
|
||||
Result := Result or (WS_OVERLAPPED or WS_BORDER or WS_CAPTION);
|
||||
bsDialog:
|
||||
Result := Result or (WS_POPUP or WS_BORDER or WS_CAPTION);
|
||||
bsNone:
|
||||
Result := Result or WS_POPUP;
|
||||
end;
|
||||
end;
|
||||
atPDA,atSmartphone,atDefault:
|
||||
begin
|
||||
Result := WS_VISIBLE;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD;
|
||||
begin
|
||||
Result := 0;
|
||||
case Style of
|
||||
bsDialog:
|
||||
Result := WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE;
|
||||
bsToolWindow, bsSizeToolWin:
|
||||
Result := WS_EX_TOOLWINDOW;
|
||||
case Application.ApplicationType of
|
||||
atDesktop,atHandheld:
|
||||
begin
|
||||
case Style of
|
||||
bsDialog:
|
||||
Result := WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE;
|
||||
bsToolWindow, bsSizeToolWin:
|
||||
Result := WS_EX_TOOLWINDOW;
|
||||
end;
|
||||
end;
|
||||
atPDA,atSmartphone,atDefault:
|
||||
begin
|
||||
case Style of
|
||||
bsDialog:
|
||||
Result := WS_EX_CAPTIONOKBTN;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -206,9 +206,9 @@ begin
|
||||
if GetDesigningBorderStyle(AForm) in [bsNone, bsSingle, bsSizeable] then
|
||||
begin
|
||||
if biMinimize in BorderIcons then
|
||||
Result := Result or WS_MINIMIZEBOX;
|
||||
Result := Result or WS_MINIMIZE;
|
||||
if biMaximize in BorderIcons then
|
||||
Result := Result or WS_MAXIMIZEBOX;
|
||||
Result := Result or WS_MAXIMIZE;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user