PageRenderTime 16ms CodeModel.GetById 14ms app.highlight 1ms RepoModel.GetById 0ms app.codeStats 0ms

/packages/univint/examples/controldemo.pas

https://github.com/slibre/freepascal
Pascal | 205 lines | 116 code | 48 blank | 41 comment | 6 complexity | 34f0456d5690a5d642302cecbfa48d6e MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
  1{
  2 controldemo.pas
  3
  4 *****************************************************************************
  5 *                                                                           *
  6 *  This demonstration program is public domain, which means no copyright,   *
  7 * but also no warranty!                                                     *
  8 *                                                                           *
  9 *  This program is distributed in the hope that it will be useful,          *
 10 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 11 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 12 *                                                                           *
 13 *****************************************************************************
 14
 15 This application will create a window with two buttons in it
 16
 17 When you click the button 'Hello Button',
 18  it will show or hide (alternating with each click) a text on the window
 19
 20 When you click the button 'Show Dialog', it will show a modal message dialog
 21
 22 Author: Felipe Monteiro de Carvalho
 23
 24 Contributors: Ingemar Ragnemalm
 25}
 26program controldemo;
 27
 28{$mode delphi}
 29
 30uses
 31 SysUtils, MacOSAll, MacPas;
 32
 33var
 34  mainWindow: WindowRef;
 35  contentView: HIViewRef;
 36  button1, button2: ControlRef;
 37  staticText: ControlRef;
 38  showTextFlag: Boolean = false;
 39
 40const
 41  kButtonHello = 'HELO';
 42  kButtonMessage = 'MSGE';
 43
 44{ implementation of the functions }
 45
 46{ Functions to easely generate carbon structures }
 47
 48function GetQDRect(Left, Top, Width, Height: Integer): MacOSAll.Rect;
 49begin
 50  result.Left := Left;
 51  result.Top := Top;
 52  result.Right := Left + Width;
 53  result.Bottom := Top + Height;
 54end;
 55
 56{ Shows a message box }
 57
 58procedure DoShowMessage(ATitle, AMsg: string);
 59var
 60  outItemHit: SInt16;
 61  err: OSErr;
 62begin
 63  err := StandardAlert(kAlertNoteAlert, ATitle, AMsg, nil, outItemHit);
 64end;
 65
 66{ Event handling routines }
 67
 68{  Here we alternate the visibility status of the static text
 69  with each button click }
 70function ButtonHelloPressed: OSStatus;
 71begin
 72  result := 0;
 73
 74  showTextFlag := not showTextFlag;
 75
 76  if showTextFlag then HIViewSetVisible(staticText, True)
 77  else HIViewSetVisible(staticText, False);
 78end;
 79
 80function ButtonMessagePressed: OSStatus;
 81begin
 82  result := 0;
 83
 84  DoShowMessage('Standard message dialog', 'This dialog is modal');
 85end;
 86
 87{ Message handling function }
 88
 89function WindowCommandHandler(nextHandler: EventHandlerCallRef; theEvent: EventRef; userDataPtr: UnivPtr): OSStatus; cdecl;
 90var
 91  status: OSStatus;
 92  ignoreresult: OSStatus;
 93  aCommand: HICommand;
 94begin
 95  status := eventNotHandledErr;
 96
 97  ignoreresult := GetEventParameter(theEvent, kEventParamDirectObject,
 98   typeHICommand, nil, sizeof(aCommand), nil, @aCommand);
 99
100  if aCommand.commandID = FOUR_CHAR_CODE(kButtonHello) then status := ButtonHelloPressed()
101  else if aCommand.commandID = FOUR_CHAR_CODE(kButtonMessage) then status := ButtonMessagePressed();
102
103  result := status;
104end;
105
106{ Initialization and finalization routines }
107
108procedure Initialize;
109var
110  status, ignoreResult: OSStatus;
111  cmdEvent: EventTypeSpec;
112  eventHandler: EventHandlerUPP;
113  fontStyle: ControlFontStyleRec;
114  psn: ProcessSerialNumber;
115begin
116  psn.highLongOfPSN:=0;
117  psn.lowLongOfPSN:=kCurrentProcess;
118  TransformProcessType( psn, kProcessTransformToForegroundApplication );
119  setFrontProcess( psn );
120  status := CreateNewWindow(kDocumentWindowClass,
121   (kWindowStandardDocumentAttributes or kWindowStandardHandlerAttribute
122    or kWindowCompositingAttribute),
123   GetQDRect(100, 100, 350, 350), mainWindow);
124
125  if (status <> noErr) or (mainWindow = nil) then
126  begin
127    DoShowMessage('Error', 'CreateNewWindow failed');
128    Exit;
129  end;
130
131  ignoreResult := SetWindowTitleWithCFString(mainWindow, CFSTRP('Carbon FPC Controls Demo'));
132
133  ignoreResult := HIViewFindByID(HIViewGetRoot(mainWindow), kHIViewWindowContentID, contentView);
134
135  { Add events }
136
137  cmdEvent.eventClass := kEventClassCommand;
138  cmdEvent.eventKind := kEventCommandProcess;
139  eventHandler := NewEventHandlerUPP(@WindowCommandHandler);
140  ignoreResult := InstallEventHandler(GetWindowEventTarget(mainWindow),
141   eventHandler, 1, @cmdEvent, nil, nil);
142
143  { Creates the hello button }
144
145  ignoreResult := CreatePushButtonControl(nil, GetQDRect(50, 200, 100, 50),
146   CFSTRP('Hello Button'), button1);
147
148  ignoreResult := HIViewAddSubview(contentView, button1);
149  ignoreResult := SetControlCommandID(button1, FOUR_CHAR_CODE(kButtonHello));
150  ignoreResult := HIViewSetVisible(button1, TRUE);
151
152  { Creates the message button }
153
154  ignoreResult := CreatePushButtonControl(nil, GetQDRect(200, 200, 100, 50),
155   CFSTRP('Show Dialog'), button2);
156
157  ignoreResult := HIViewAddSubview(contentView, button2);
158  ignoreResult := SetControlCommandID(button2, FOUR_CHAR_CODE(kButtonMessage));
159  ignoreResult := HIViewSetVisible(button2, TRUE);
160
161  { Creates the text control }
162
163  fontStyle.flags := kControlUseJustMask or kControlUseSizeMask;
164  fontStyle.just := teCenter;
165  fontStyle.size := 30;
166
167  ignoreResult := CreateStaticTextControl(mainWindow,
168   GetQDRect(0, 50, 350, 50), nil, @fontStyle, staticText);
169
170  ignoreResult := HIViewAddSubview(contentView, staticText);
171  ignoreResult := HIViewSetVisible(staticText, FALSE);
172
173  HIViewSetText(staticText, CFSTRP('Hello Controls!'));
174
175  { Shows the window }
176
177  ShowWindow(mainWindow);
178end;
179
180procedure DoCloseWindow(theWind: WindowRef);
181var
182  theEvent: EventRef;
183begin
184  CreateEvent(nil, kEventClassWindow, kEventWindowClose, GetCurrentEventTime, kEventAttributeNone, theEvent);
185  SetEventParameter(theEvent, kEventParamDirectObject, typeWindowRef, sizeof(WindowRef), theWind);
186  SendEventToEventTarget(theEvent, GetWindowEventTarget(theWind));
187end;
188
189{ Closes all windows, so they have time to save any user data (none in this case) }
190
191procedure Finalize;
192begin
193  DoCloseWindow(mainWindow);
194end;
195
196{ Main program section }
197
198begin
199  Initialize();
200
201  RunApplicationEventLoop();
202
203  Finalize();
204end.
205