/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

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