mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 12:39:24 +02:00
Added carbon controls example
git-svn-id: trunk@7785 -
This commit is contained in:
parent
3d5d454a05
commit
ab7dcb0011
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -3751,6 +3751,8 @@ packages/extra/univint/UnicodeUtilities.pas svneol=native#text/plain
|
|||||||
packages/extra/univint/UniversalAccess.pas svneol=native#text/plain
|
packages/extra/univint/UniversalAccess.pas svneol=native#text/plain
|
||||||
packages/extra/univint/Video.pas svneol=native#text/plain
|
packages/extra/univint/Video.pas svneol=native#text/plain
|
||||||
packages/extra/univint/WorldScript.pas svneol=native#text/plain
|
packages/extra/univint/WorldScript.pas svneol=native#text/plain
|
||||||
|
packages/extra/univint/examples/Makefile.fpc -text
|
||||||
|
packages/extra/univint/examples/controldemo.pas -text
|
||||||
packages/extra/univint/fenv.pas svneol=native#text/plain
|
packages/extra/univint/fenv.pas svneol=native#text/plain
|
||||||
packages/extra/univint/fp.pas svneol=native#text/plain
|
packages/extra/univint/fp.pas svneol=native#text/plain
|
||||||
packages/extra/univint/vBLAS.pas svneol=native#text/plain
|
packages/extra/univint/vBLAS.pas svneol=native#text/plain
|
||||||
|
@ -82,6 +82,7 @@ implicitunits=ABActions ABAddressBook ABGlobals ABPeoplePicker ABTypedefs \
|
|||||||
CGImageDestination AXValueConstants AXAttributeConstants \
|
CGImageDestination AXValueConstants AXAttributeConstants \
|
||||||
AXTextAttributedString CGImageProperties CGImageSource \
|
AXTextAttributedString CGImageProperties CGImageSource \
|
||||||
UniversalAccess HostTime
|
UniversalAccess HostTime
|
||||||
|
exampledirs=examples
|
||||||
|
|
||||||
[libs]
|
[libs]
|
||||||
libversion=2.0.0
|
libversion=2.0.0
|
||||||
|
22
packages/extra/univint/examples/Makefile.fpc
Normal file
22
packages/extra/univint/examples/Makefile.fpc
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
#
|
||||||
|
# Makefile.fpc for Free Pascal Universal Interfaces Examples
|
||||||
|
#
|
||||||
|
|
||||||
|
[target]
|
||||||
|
dirs=
|
||||||
|
programs=controldemo
|
||||||
|
|
||||||
|
[require]
|
||||||
|
packages=univint
|
||||||
|
|
||||||
|
[clean]
|
||||||
|
units=controldemo
|
||||||
|
|
||||||
|
[install]
|
||||||
|
fpcpackage=y
|
||||||
|
|
||||||
|
[default]
|
||||||
|
fpcdir=../../../..
|
||||||
|
|
||||||
|
[rules]
|
||||||
|
.NOTPARALLEL:
|
200
packages/extra/univint/examples/controldemo.pas
Normal file
200
packages/extra/univint/examples/controldemo.pas
Normal file
@ -0,0 +1,200 @@
|
|||||||
|
{
|
||||||
|
controldemo.pas
|
||||||
|
|
||||||
|
*****************************************************************************
|
||||||
|
* *
|
||||||
|
* This demonstration program is public domain, which means no copyright, *
|
||||||
|
* but also no warranty! *
|
||||||
|
* *
|
||||||
|
* This program is distributed in the hope that it will be useful, *
|
||||||
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||||
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||||
|
* *
|
||||||
|
*****************************************************************************
|
||||||
|
|
||||||
|
This application will create a window with two buttons in it
|
||||||
|
|
||||||
|
When you click the button 'Hello Button',
|
||||||
|
it will show or hide (alternating with each click) a text on the window
|
||||||
|
|
||||||
|
When you click the button 'Show Dialog', it will show a modal message dialog
|
||||||
|
|
||||||
|
Author: Felipe Monteiro de Carvalho
|
||||||
|
|
||||||
|
Contributors: Ingemar Ragnemalm
|
||||||
|
}
|
||||||
|
program controldemo;
|
||||||
|
|
||||||
|
{$mode delphi}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, FPCMacOSAll, MacPas;
|
||||||
|
|
||||||
|
var
|
||||||
|
mainWindow: WindowRef;
|
||||||
|
contentView: HIViewRef;
|
||||||
|
button1, button2: ControlRef;
|
||||||
|
staticText: ControlRef;
|
||||||
|
showTextFlag: Boolean = false;
|
||||||
|
|
||||||
|
const
|
||||||
|
kButtonHello = 'HELO';
|
||||||
|
kButtonMessage = 'MSGE';
|
||||||
|
|
||||||
|
{ implementation of the functions }
|
||||||
|
|
||||||
|
{ Functions to easely generate carbon structures }
|
||||||
|
|
||||||
|
function GetQDRect(Left, Top, Width, Height: Integer): FPCMacOSAll.Rect;
|
||||||
|
begin
|
||||||
|
result.Left := Left;
|
||||||
|
result.Top := Top;
|
||||||
|
result.Right := Left + Width;
|
||||||
|
result.Bottom := Top + Height;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Shows a message box }
|
||||||
|
|
||||||
|
procedure DoShowMessage(ATitle, AMsg: string);
|
||||||
|
var
|
||||||
|
outItemHit: SInt16;
|
||||||
|
err: OSErr;
|
||||||
|
begin
|
||||||
|
err := StandardAlert(kAlertNoteAlert, ATitle, AMsg, nil, outItemHit);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Event handling routines }
|
||||||
|
|
||||||
|
{ Here we alternate the visibility status of the static text
|
||||||
|
with each button click }
|
||||||
|
function ButtonHelloPressed: OSStatus;
|
||||||
|
begin
|
||||||
|
result := 0;
|
||||||
|
|
||||||
|
showTextFlag := not showTextFlag;
|
||||||
|
|
||||||
|
if showTextFlag then HIViewSetVisible(staticText, True)
|
||||||
|
else HIViewSetVisible(staticText, False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ButtonMessagePressed: OSStatus;
|
||||||
|
begin
|
||||||
|
result := 0;
|
||||||
|
|
||||||
|
DoShowMessage('Standard message dialog', 'This dialog is modal');
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Message handling function }
|
||||||
|
|
||||||
|
function WindowCommandHandler(nextHandler: EventHandlerCallRef; theEvent: EventRef; userDataPtr: UnivPtr): OSStatus; cdecl;
|
||||||
|
var
|
||||||
|
status: OSStatus;
|
||||||
|
ignoreresult: OSStatus;
|
||||||
|
aCommand: HICommand;
|
||||||
|
begin
|
||||||
|
status := eventNotHandledErr;
|
||||||
|
|
||||||
|
ignoreresult := GetEventParameter(theEvent, kEventParamDirectObject,
|
||||||
|
typeHICommand, nil, sizeof(aCommand), nil, @aCommand);
|
||||||
|
|
||||||
|
if aCommand.commandID = FOUR_CHAR_CODE(kButtonHello) then status := ButtonHelloPressed()
|
||||||
|
else if aCommand.commandID = FOUR_CHAR_CODE(kButtonMessage) then status := ButtonMessagePressed();
|
||||||
|
|
||||||
|
result := status;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Initialization and finalization routines }
|
||||||
|
|
||||||
|
procedure Initialize;
|
||||||
|
var
|
||||||
|
status, ignoreResult: OSStatus;
|
||||||
|
cmdEvent: EventTypeSpec;
|
||||||
|
eventHandler: EventHandlerUPP;
|
||||||
|
fontStyle: ControlFontStyleRec;
|
||||||
|
begin
|
||||||
|
status := CreateNewWindow(kDocumentWindowClass,
|
||||||
|
(kWindowStandardDocumentAttributes or kWindowStandardHandlerAttribute
|
||||||
|
or kWindowCompositingAttribute),
|
||||||
|
GetQDRect(100, 100, 350, 350), mainWindow);
|
||||||
|
|
||||||
|
if (status <> noErr) or (mainWindow = nil) then
|
||||||
|
begin
|
||||||
|
DoShowMessage('Error', 'CreateNewWindow failed');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
ignoreResult := SetWindowTitleWithCFString(mainWindow, CFSTRP('Carbon FPC Controls Demo'));
|
||||||
|
|
||||||
|
ignoreResult := HIViewFindByID(HIViewGetRoot(mainWindow), kHIViewWindowContentID, contentView);
|
||||||
|
|
||||||
|
{ Add events }
|
||||||
|
|
||||||
|
cmdEvent.eventClass := kEventClassCommand;
|
||||||
|
cmdEvent.eventKind := kEventCommandProcess;
|
||||||
|
eventHandler := NewEventHandlerUPP(@WindowCommandHandler);
|
||||||
|
ignoreResult := InstallEventHandler(GetWindowEventTarget(mainWindow),
|
||||||
|
eventHandler, 1, @cmdEvent, nil, nil);
|
||||||
|
|
||||||
|
{ Creates the hello button }
|
||||||
|
|
||||||
|
ignoreResult := CreatePushButtonControl(nil, GetQDRect(50, 200, 100, 50),
|
||||||
|
CFSTRP('Hello Button'), button1);
|
||||||
|
|
||||||
|
ignoreResult := HIViewAddSubview(contentView, button1);
|
||||||
|
ignoreResult := SetControlCommandID(button1, FOUR_CHAR_CODE(kButtonHello));
|
||||||
|
ignoreResult := HIViewSetVisible(button1, TRUE);
|
||||||
|
|
||||||
|
{ Creates the message button }
|
||||||
|
|
||||||
|
ignoreResult := CreatePushButtonControl(nil, GetQDRect(200, 200, 100, 50),
|
||||||
|
CFSTRP('Show Dialog'), button2);
|
||||||
|
|
||||||
|
ignoreResult := HIViewAddSubview(contentView, button2);
|
||||||
|
ignoreResult := SetControlCommandID(button2, FOUR_CHAR_CODE(kButtonMessage));
|
||||||
|
ignoreResult := HIViewSetVisible(button2, TRUE);
|
||||||
|
|
||||||
|
{ Creates the text control }
|
||||||
|
|
||||||
|
fontStyle.flags := kControlUseJustMask or kControlUseSizeMask;
|
||||||
|
fontStyle.just := teCenter;
|
||||||
|
fontStyle.size := 30;
|
||||||
|
|
||||||
|
ignoreResult := CreateStaticTextControl(mainWindow,
|
||||||
|
GetQDRect(0, 50, 350, 50), nil, @fontStyle, staticText);
|
||||||
|
|
||||||
|
ignoreResult := HIViewAddSubview(contentView, staticText);
|
||||||
|
ignoreResult := HIViewSetVisible(staticText, FALSE);
|
||||||
|
|
||||||
|
HIViewSetText(staticText, CFSTRP('Hello Controls!'));
|
||||||
|
|
||||||
|
{ Shows the window }
|
||||||
|
|
||||||
|
ShowWindow(mainWindow);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure DoCloseWindow(theWind: WindowRef);
|
||||||
|
var
|
||||||
|
theEvent: EventRef;
|
||||||
|
begin
|
||||||
|
CreateEvent(nil, kEventClassWindow, kEventWindowClose, GetCurrentEventTime, kEventAttributeNone, theEvent);
|
||||||
|
SetEventParameter(theEvent, kEventParamDirectObject, typeWindowRef, sizeof(WindowRef), theWind);
|
||||||
|
SendEventToEventTarget(theEvent, GetWindowEventTarget(theWind));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Closes all windows, so they have time to save any user data (none in this case) }
|
||||||
|
|
||||||
|
procedure Finalize;
|
||||||
|
begin
|
||||||
|
DoCloseWindow(mainWindow);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Main program section }
|
||||||
|
|
||||||
|
begin
|
||||||
|
Initialize();
|
||||||
|
|
||||||
|
RunApplicationEventLoop();
|
||||||
|
|
||||||
|
Finalize();
|
||||||
|
end.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user