mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-10 04:49:07 +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/Video.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/fp.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 \
|
||||
AXTextAttributedString CGImageProperties CGImageSource \
|
||||
UniversalAccess HostTime
|
||||
exampledirs=examples
|
||||
|
||||
[libs]
|
||||
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