fpviews.pas 82 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Views and view-related functions for the IDE
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  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. unit FPViews;
  13. interface
  14. uses
  15. Dos,Objects,Drivers,Commands,HelpCtx,Views,Menus,Dialogs,App,
  16. {$ifdef EDITORS}
  17. Editors,
  18. {$else}
  19. WEditor,
  20. {$endif}
  21. WHlpView,
  22. Comphook,
  23. FPConst,FPUsrScr;
  24. type
  25. {$IFNDEF EDITORS}
  26. TEditor = TCodeEditor; PEditor = PCodeEditor;
  27. {$ENDIF}
  28. PCenterDialog = ^TCenterDialog;
  29. TCenterDialog = object(TDialog)
  30. constructor Init(var Bounds: TRect; ATitle: TTitleStr);
  31. end;
  32. PIntegerLine = ^TIntegerLine;
  33. TIntegerLine = object(TInputLine)
  34. constructor Init(var Bounds: TRect; AMin, AMax: longint);
  35. end;
  36. TFPWindow = object(TWindow)
  37. procedure HandleEvent(var Event: TEvent); virtual;
  38. end;
  39. PIDEHelpWindow = ^TIDEHelpWindow;
  40. TIDEHelpWindow = object(THelpWindow)
  41. function GetPalette: PPalette; virtual;
  42. end;
  43. PSourceEditor = ^TSourceEditor;
  44. TSourceEditor = object(TFileEditor)
  45. {$ifndef EDITORS}
  46. function IsReservedWord(const S: string): boolean; virtual;
  47. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  48. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
  49. {$endif}
  50. procedure HandleEvent(var Event: TEvent); virtual;
  51. procedure LocalMenu(P: TPoint); virtual;
  52. function GetLocalMenu: PMenu; virtual;
  53. function GetCommandTarget: PView; virtual;
  54. private
  55. LastLocalCmd : word;
  56. end;
  57. PSourceWindow = ^TSourceWindow;
  58. TSourceWindow = object(TFPWindow)
  59. Editor : PSourceEditor;
  60. Indicator : PIndicator;
  61. constructor Init(var Bounds: TRect; AFileName: string);
  62. procedure SetTitle(ATitle: string); virtual;
  63. procedure UpdateTitle; virtual;
  64. procedure HandleEvent(var Event: TEvent); virtual;
  65. procedure SetState(AState: Word; Enable: Boolean); virtual;
  66. procedure Update; virtual;
  67. procedure UpdateCommands; virtual;
  68. function GetPalette: PPalette; virtual;
  69. destructor Done; virtual;
  70. end;
  71. PClipboardWindow = ^TClipboardWindow;
  72. TClipboardWindow = object(TSourceWindow)
  73. constructor Init;
  74. procedure Close; virtual;
  75. destructor Done; virtual;
  76. end;
  77. PAdvancedMenuBox = ^TAdvancedMenuBox;
  78. TAdvancedMenuBox = object(TMenuBox)
  79. function NewSubView(var Bounds: TRect; AMenu: PMenu;
  80. AParentMenu: PMenuView): PMenuView; virtual;
  81. function Execute: Word; virtual;
  82. end;
  83. PAdvancedMenuPopUp = ^TAdvancedMenuPopup;
  84. TAdvancedMenuPopUp = object(TMenuPopup)
  85. function NewSubView(var Bounds: TRect; AMenu: PMenu;
  86. AParentMenu: PMenuView): PMenuView; virtual;
  87. function Execute: Word; virtual;
  88. end;
  89. PAdvancedMenuBar = ^TAdvancedMenuBar;
  90. TAdvancedMenuBar = object(TMenuBar)
  91. constructor Init(var Bounds: TRect; AMenu: PMenu);
  92. function NewSubView(var Bounds: TRect; AMenu: PMenu;
  93. AParentMenu: PMenuView): PMenuView; virtual;
  94. procedure Update; virtual;
  95. procedure HandleEvent(var Event: TEvent); virtual;
  96. function Execute: Word; virtual;
  97. end;
  98. PAdvancedStaticText = ^TAdvancedStaticText;
  99. TAdvancedStaticText = object(TStaticText)
  100. procedure SetText(S: string); virtual;
  101. end;
  102. PAdvancedListBox = ^TAdvancedListBox;
  103. TAdvancedListBox = object(TListBox)
  104. Default: boolean;
  105. procedure HandleEvent(var Event: TEvent); virtual;
  106. end;
  107. TLocalMenuListBox = object(TAdvancedListBox)
  108. procedure HandleEvent(var Event: TEvent); virtual;
  109. procedure LocalMenu(P: TPoint); virtual;
  110. function GetLocalMenu: PMenu; virtual;
  111. function GetCommandTarget: PView; virtual;
  112. private
  113. LastLocalCmd: word;
  114. end;
  115. PColorStaticText = ^TColorStaticText;
  116. TColorStaticText = object(TAdvancedStaticText)
  117. Color: word;
  118. DontWrap: boolean;
  119. Delta: TPoint;
  120. constructor Init(var Bounds: TRect; AText: String; AColor: word);
  121. procedure Draw; virtual;
  122. end;
  123. PUnsortedStringCollection = ^TUnsortedStringCollection;
  124. TUnsortedStringCollection = object(TCollection)
  125. function At(Index: Integer): PString;
  126. procedure FreeItem(Item: Pointer); virtual;
  127. end;
  128. PHSListBox = ^THSListBox;
  129. THSListBox = object(TLocalMenuListBox)
  130. constructor Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
  131. end;
  132. PDlgWindow = ^TDlgWindow;
  133. TDlgWindow = object(TDialog)
  134. constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
  135. end;
  136. PAdvancedStatusLine = ^TAdvancedStatusLine;
  137. TAdvancedStatusLine = object(TStatusLine)
  138. StatusText: PString;
  139. function GetStatusText: string; virtual;
  140. procedure SetStatusText(S: string); virtual;
  141. procedure ClearStatusText; virtual;
  142. procedure Draw; virtual;
  143. end;
  144. PMessageItem = ^TMessageItem;
  145. TMessageItem = object(TObject)
  146. TClass : longint;
  147. Text : PString;
  148. Module : PString;
  149. ID : longint;
  150. constructor Init(AClass: longint; AText, AModule: string; AID: longint);
  151. function GetText(MaxLen: integer): string; virtual;
  152. procedure Selected; virtual;
  153. function GetModuleName: string; virtual;
  154. destructor Done; virtual;
  155. end;
  156. PMessageListBox = ^TMessageListBox;
  157. TMessageListBox = object(THSListBox)
  158. Transparent: boolean;
  159. NoSelection: boolean;
  160. MaxWidth: integer;
  161. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  162. procedure AddItem(P: PMessageItem); virtual;
  163. function GetText(Item: Integer; MaxLen: Integer): String; virtual;
  164. procedure Clear; virtual;
  165. procedure TrackSource; virtual;
  166. procedure GotoSource; virtual;
  167. procedure Draw; virtual;
  168. procedure HandleEvent(var Event: TEvent); virtual;
  169. function GetLocalMenu: PMenu; virtual;
  170. destructor Done; virtual;
  171. end;
  172. PCompilerMessage = ^TCompilerMessage;
  173. TCompilerMessage = object(TMessageItem)
  174. function GetText(MaxLen: Integer): String; virtual;
  175. end;
  176. PProgramInfoWindow = ^TProgramInfoWindow;
  177. TProgramInfoWindow = object(TDlgWindow)
  178. InfoST: PColorStaticText;
  179. LogLB : PMessageListBox;
  180. constructor Init;
  181. procedure AddMessage(AClass: longint; Msg, Module: string; Line: longint);
  182. procedure SizeLimits(var Min, Max: TPoint); virtual;
  183. procedure Close; virtual;
  184. procedure HandleEvent(var Event: TEvent); virtual;
  185. procedure Update; virtual;
  186. destructor Done; virtual;
  187. end;
  188. PTabItem = ^TTabItem;
  189. TTabItem = record
  190. Next : PTabItem;
  191. View : PView;
  192. Dis : boolean;
  193. end;
  194. PTabDef = ^TTabDef;
  195. TTabDef = record
  196. Next : PTabDef;
  197. Name : PString;
  198. Items : PTabItem;
  199. DefItem : PView;
  200. ShortCut : char;
  201. end;
  202. PTab = ^TTab;
  203. TTab = object(TGroup)
  204. TabDefs : PTabDef;
  205. ActiveDef : integer;
  206. DefCount : word;
  207. constructor Init(var Bounds: TRect; ATabDef: PTabDef);
  208. function AtTab(Index: integer): PTabDef; virtual;
  209. procedure SelectTab(Index: integer); virtual;
  210. function TabCount: integer;
  211. function Valid(Command: Word): Boolean; virtual;
  212. procedure ChangeBounds(var Bounds: TRect); virtual;
  213. procedure HandleEvent(var Event: TEvent); virtual;
  214. function GetPalette: PPalette; virtual;
  215. procedure Draw; virtual;
  216. procedure SetState(AState: Word; Enable: Boolean); virtual;
  217. destructor Done; virtual;
  218. private
  219. InDraw: boolean;
  220. end;
  221. PScreenView = ^TScreenView;
  222. TScreenView = object(TScroller)
  223. Screen: PScreen;
  224. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  225. AScreen: PScreen);
  226. procedure Draw; virtual;
  227. procedure Update; virtual;
  228. procedure HandleEvent(var Event: TEvent); virtual;
  229. end;
  230. PScreenWindow = ^TScreenWindow;
  231. TScreenWindow = object(TFPWindow)
  232. ScreenView : PScreenView;
  233. constructor Init(AScreen: PScreen; ANumber: integer);
  234. destructor Done; virtual;
  235. end;
  236. function SearchFreeWindowNo: integer;
  237. procedure InsertOK(ADialog: PDialog);
  238. procedure InsertButtons(ADialog: PDialog);
  239. procedure ErrorBox(S: string; Params: pointer);
  240. procedure WarningBox(S: string; Params: pointer);
  241. procedure InformationBox(S: string; Params: pointer);
  242. function ConfirmBox(S: string; Params: pointer; CanCancel: boolean): word;
  243. function IsThereAnyEditor: boolean;
  244. function IsThereAnyWindow: boolean;
  245. function FirstEditorWindow: PSourceWindow;
  246. function EditorWindowFile(const Name : String): PSourceWindow;
  247. function SearchMenuItem(Menu: PMenu; Cmd: word): PMenuItem;
  248. procedure SetMenuItemParam(Menu: PMenuItem; Param: string);
  249. function IsSubMenu(P: PMenuItem): boolean;
  250. function IsSeparator(P: PMenuItem): boolean;
  251. function UpdateMenu(M: PMenu): boolean;
  252. function SearchSubMenu(M: PMenu; Index: integer): PMenuItem;
  253. procedure AppendMenuItem(M: PMenu; I: PMenuItem);
  254. procedure RemoveMenuItem(Menu: PMenu; I: PMenuItem);
  255. function GetMenuItemBefore(Menu:PMenu; BeforeOf: PMenuItem): PMenuItem;
  256. function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
  257. procedure DisposeTabItem(P: PTabItem);
  258. function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
  259. procedure DisposeTabDef(P: PTabDef);
  260. function GetEditorCurWord(Editor: PEditor): string;
  261. procedure InitReservedWords;
  262. procedure DoneReservedWords;
  263. procedure TranslateMouseClick(View: PView; var Event: TEvent);
  264. function GetNextEditorBounds(var Bounds: TRect): boolean;
  265. function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: integer): PSourceWindow;
  266. function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: integer): PSourceWindow;
  267. const
  268. SourceCmds : TCommandSet =
  269. ([cmSave,cmSaveAs,cmCompile]);
  270. EditorCmds : TCommandSet =
  271. ([cmFind,cmReplace,cmSearchAgain,cmJumpLine,cmHelpTopicSearch]);
  272. CompileCmds : TCommandSet =
  273. ([cmMake,cmBuild,cmRun]);
  274. CalcClipboard : extended = 0;
  275. OpenFileName : string = '';
  276. OpenFileLastExt : string = '*.pas';
  277. NewEditorOpened: boolean = false;
  278. var MsgParms : array[1..10] of
  279. record
  280. case byte of
  281. 0 : (Ptr : pointer);
  282. 1 : (Long: longint);
  283. end;
  284. implementation
  285. uses
  286. Keyboard,Memory,MsgBox,Validate,
  287. Tokens,FPSwitch,FPSymbol,FPDebug,
  288. FPVars,FPUtils,FPHelp,FPCompile;
  289. const
  290. NoNameCount : integer = 0;
  291. ReservedWords : PUnsortedStringCollection = nil;
  292. function IsThereAnyEditor: boolean;
  293. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  294. begin
  295. EditorWindow:=(P^.HelpCtx=hcSourceWindow);
  296. end;
  297. begin
  298. IsThereAnyEditor:=Desktop^.FirstThat(@EditorWindow)<>nil;
  299. end;
  300. function IsThereAnyHelpWindow: boolean;
  301. begin
  302. IsThereAnyHelpWindow:=(HelpWindow<>nil) and (HelpWindow^.GetState(sfVisible));
  303. end;
  304. function IsThereAnyWindow: boolean;
  305. var _Is: boolean;
  306. begin
  307. _Is:=Message(Desktop,evBroadcast,cmSearchWindow,nil)<>nil;
  308. _Is:=_Is or ( (ClipboardWindow<>nil) and ClipboardWindow^.GetState(sfVisible));
  309. IsThereAnyWindow:=_Is;
  310. end;
  311. function FirstEditorWindow: PSourceWindow;
  312. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  313. begin
  314. EditorWindow:=(P^.HelpCtx=hcSourceWindow);
  315. end;
  316. begin
  317. FirstEditorWindow:=pointer(Desktop^.FirstThat(@EditorWindow));
  318. end;
  319. function EditorWindowFile(const Name : String): PSourceWindow;
  320. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  321. begin
  322. EditorWindow:=(TypeOf(P^)=TypeOf(TSourceWindow)) and
  323. (PSourceWindow(P)^.Editor^.FileName=Name);
  324. end;
  325. begin
  326. EditorWindowFile:=pointer(Desktop^.FirstThat(@EditorWindow));
  327. end;
  328. procedure InsertButtons(ADialog: PDialog);
  329. var R : TRect;
  330. W,H : integer;
  331. X : integer;
  332. X1,X2: Sw_integer;
  333. begin
  334. with ADialog^ do
  335. begin
  336. GetExtent(R);
  337. W:=R.B.X-R.A.X; H:=(R.B.Y-R.A.Y);
  338. R.Assign(0,0,W,H+3); ChangeBounds(R);
  339. X:=W div 2; X1:=X div 2+1; X2:=X+X1-1;
  340. R.Assign(X1-3,H,X1+7,H+2);
  341. Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
  342. R.Assign(X2-7,H,X2+3,H+2);
  343. Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  344. SelectNext(true);
  345. end;
  346. end;
  347. procedure InsertOK(ADialog: PDialog);
  348. var BW: Sw_integer;
  349. R: TRect;
  350. begin
  351. with ADialog^ do
  352. begin
  353. GetBounds(R); R.Grow(0,1); Inc(R.B.Y);
  354. ChangeBounds(R);
  355. BW:=10;
  356. R.A.Y:=R.B.Y-2; R.B.Y:=R.A.Y+2;
  357. R.A.X:=R.A.X+(R.B.X-R.A.X-BW) div 2; R.B.X:=R.A.X+BW;
  358. Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
  359. SelectNext(true);
  360. end;
  361. end;
  362. function GetEditorCurWord(Editor: PEditor): string;
  363. var S: string;
  364. PS,PE: byte;
  365. function Trim(S: string): string;
  366. const TrimChars : set of char = [#0,#9,' ',#255];
  367. begin
  368. while (length(S)>0) and (S[1] in TrimChars) do Delete(S,1,1);
  369. while (length(S)>0) and (S[length(S)] in TrimChars) do Delete(S,length(S),1);
  370. Trim:=S;
  371. end;
  372. const AlphaNum : set of char = ['A'..'Z','0'..'9','_'];
  373. begin
  374. with Editor^ do
  375. begin
  376. {$ifdef EDITORS}
  377. S:='';
  378. {$else}
  379. S:=GetLineText(CurPos.Y);
  380. PS:=CurPos.X; while (PS>0) and (Upcase(S[PS]) in AlphaNum) do Dec(PS);
  381. PE:=CurPos.X; while (PE<length(S)) and (Upcase(S[PE+1]) in AlphaNum) do Inc(PE);
  382. S:=Trim(copy(S,PS+1,PE-PS));
  383. {$endif}
  384. end;
  385. GetEditorCurWord:=S;
  386. end;
  387. {*****************************************************************************
  388. Tab
  389. *****************************************************************************}
  390. function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
  391. var P: PTabItem;
  392. begin
  393. New(P); FillChar(P^,SizeOf(P^),0);
  394. P^.Next:=ANext; P^.View:=AView;
  395. NewTabItem:=P;
  396. end;
  397. procedure DisposeTabItem(P: PTabItem);
  398. begin
  399. if P<>nil then
  400. begin
  401. if P^.View<>nil then Dispose(P^.View, Done);
  402. Dispose(P);
  403. end;
  404. end;
  405. function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
  406. var P: PTabDef;
  407. x: byte;
  408. begin
  409. New(P);
  410. P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
  411. x:=pos('~',AName);
  412. if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
  413. else P^.ShortCut:=#0;
  414. P^.DefItem:=ADefItem;
  415. NewTabDef:=P;
  416. end;
  417. procedure DisposeTabDef(P: PTabDef);
  418. var PI,X: PTabItem;
  419. begin
  420. DisposeStr(P^.Name);
  421. PI:=P^.Items;
  422. while PI<>nil do
  423. begin
  424. X:=PI^.Next;
  425. DisposeTabItem(PI);
  426. PI:=X;
  427. end;
  428. Dispose(P);
  429. end;
  430. {*****************************************************************************
  431. Reserved Words
  432. *****************************************************************************}
  433. function GetReservedWordCount: integer;
  434. var
  435. Count,I: integer;
  436. begin
  437. Count:=0;
  438. for I:=ord(Low(TokenInfo)) to ord(High(TokenInfo)) do
  439. with TokenInfo[TToken(I)] do
  440. if (str<>'') and (str[1] in['A'..'Z']) then
  441. Inc(Count);
  442. GetReservedWordCount:=Count;
  443. end;
  444. function GetReservedWord(Index: integer): string;
  445. var
  446. Count,Idx,I: integer;
  447. S: string;
  448. begin
  449. Idx:=-1;
  450. Count:=-1;
  451. I:=ord(Low(TokenInfo));
  452. while (I<=ord(High(TokenInfo))) and (Idx=-1) do
  453. with TokenInfo[TToken(I)] do
  454. begin
  455. if (str<>'') and (str[1] in['A'..'Z']) then
  456. begin
  457. Inc(Count);
  458. if Count=Index then
  459. Idx:=I;
  460. end;
  461. Inc(I);
  462. end;
  463. if Idx=-1 then
  464. S:=''
  465. else
  466. S:=TokenInfo[TToken(Idx)].str;
  467. GetReservedWord:=S;
  468. end;
  469. procedure InitReservedWords;
  470. var S,WordS: string;
  471. Idx,I: integer;
  472. begin
  473. New(ReservedWords, Init(50,10));
  474. for I:=1 to GetReservedWordCount do
  475. begin
  476. WordS:=GetReservedWord(I-1); Idx:=length(WordS);
  477. while ReservedWords^.Count<Idx do
  478. ReservedWords^.Insert(NewStr(#0));
  479. S:=ReservedWords^.At(Idx-1)^;
  480. ReservedWords^.AtFree(Idx-1);
  481. ReservedWords^.AtInsert(Idx-1,NewStr(S+WordS+#0));
  482. end;
  483. end;
  484. procedure DoneReservedWords;
  485. begin
  486. if assigned(ReservedWords) then
  487. dispose(ReservedWords,done);
  488. end;
  489. function IsFPReservedWord(S: string): boolean;
  490. var _Is: boolean;
  491. Idx: integer;
  492. P: PString;
  493. begin
  494. Idx:=length(S); _Is:=false;
  495. if (Idx>0) and (ReservedWords<>nil) and (ReservedWords^.Count>=Idx) then
  496. begin
  497. S:=UpcaseStr(S);
  498. P:=ReservedWords^.At(Idx-1);
  499. _Is:=Pos(#0+S+#0,P^)>0;
  500. end;
  501. IsFPReservedWord:=_Is;
  502. end;
  503. {*****************************************************************************
  504. SearchWindow
  505. *****************************************************************************}
  506. function SearchWindowWithNo(No: integer): PWindow;
  507. var P: PSourceWindow;
  508. begin
  509. P:=Message(Desktop,evBroadcast,cmSearchWindow+No,nil);
  510. if pointer(P)=pointer(Desktop) then P:=nil;
  511. SearchWindowWithNo:=P;
  512. end;
  513. function SearchFreeWindowNo: integer;
  514. var No: integer;
  515. begin
  516. No:=1;
  517. while (No<10) and (SearchWindowWithNo(No)<>nil) do
  518. Inc(No);
  519. if No=10 then No:=0;
  520. SearchFreeWindowNo:=No;
  521. end;
  522. {*****************************************************************************
  523. TCenterDialog
  524. *****************************************************************************}
  525. constructor TCenterDialog.Init(var Bounds: TRect; ATitle: TTitleStr);
  526. begin
  527. inherited Init(Bounds,ATitle);
  528. Options:=Options or ofCentered;
  529. end;
  530. {*****************************************************************************
  531. TIntegerLine
  532. *****************************************************************************}
  533. constructor TIntegerLine.Init(var Bounds: TRect; AMin, AMax: longint);
  534. begin
  535. inherited Init(Bounds, Bounds.B.X-Bounds.A.X-1);
  536. Validator:=New(PRangeValidator, Init(AMin, AMax));
  537. end;
  538. {*****************************************************************************
  539. SourceEditor
  540. *****************************************************************************}
  541. {$ifndef EDITORS}
  542. function TSourceEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  543. var Count: integer;
  544. begin
  545. case SpecClass of
  546. ssCommentPrefix : Count:=3;
  547. ssCommentSuffix : Count:=2;
  548. ssStringPrefix : Count:=1;
  549. ssStringSuffix : Count:=1;
  550. ssAsmPrefix : Count:=1;
  551. ssAsmSuffix : Count:=1;
  552. ssDirectivePrefix : Count:=1;
  553. ssDirectiveSuffix : Count:=1;
  554. end;
  555. GetSpecSymbolCount:=Count;
  556. end;
  557. function TSourceEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
  558. var S: string[20];
  559. begin
  560. case SpecClass of
  561. ssCommentPrefix :
  562. case Index of
  563. 0 : S:='{';
  564. 1 : S:='(*';
  565. 2 : S:='//';
  566. end;
  567. ssCommentSuffix :
  568. case Index of
  569. 0 : S:='}';
  570. 1 : S:='*)';
  571. end;
  572. ssStringPrefix :
  573. S:='''';
  574. ssStringSuffix :
  575. S:='''';
  576. ssAsmPrefix :
  577. S:='asm';
  578. ssAsmSuffix :
  579. S:='end';
  580. ssDirectivePrefix :
  581. S:='{$';
  582. ssDirectiveSuffix :
  583. S:='}';
  584. end;
  585. GetSpecSymbol:=S;
  586. end;
  587. function TSourceEditor.IsReservedWord(const S: string): boolean;
  588. begin
  589. IsReservedWord:=IsFPReservedWord(S);
  590. end;
  591. {$endif EDITORS}
  592. procedure TSourceEditor.LocalMenu(P: TPoint);
  593. var M: PMenu;
  594. MV: PAdvancedMenuPopUp;
  595. R: TRect;
  596. Re: word;
  597. begin
  598. M:=GetLocalMenu;
  599. if M=nil then Exit;
  600. if LastLocalCmd<>0 then
  601. M^.Default:=SearchMenuItem(M,LastLocalCmd);
  602. Desktop^.GetExtent(R);
  603. MakeGlobal(P,R.A); {Desktop^.MakeLocal(R.A,R.A);}
  604. New(MV, Init(R, M));
  605. Re:=Application^.ExecView(MV);
  606. if M^.Default=nil then LastLocalCmd:=0
  607. else LastLocalCmd:=M^.Default^.Command;
  608. Dispose(MV, Done);
  609. if Re<>0 then
  610. Message(GetCommandTarget,evCommand,Re,@Self);
  611. end;
  612. function TSourceEditor.GetLocalMenu: PMenu;
  613. var M: PMenu;
  614. begin
  615. M:=NewMenu(
  616. NewItem('Cu~t~','Shift+Del',kbShiftDel,cmCut,hcCut,
  617. NewItem('~C~opy','Ctrl+Ins',kbCtrlIns,cmCopy,hcCopy,
  618. NewItem('~P~aste','Shift+Ins',kbShiftIns,cmPaste,hcPaste,
  619. NewItem('C~l~ear','Ctrl+Del',kbCtrlDel,cmClear,hcClear,
  620. NewLine(
  621. NewItem('Open ~f~ile at cursor','',kbNoKey,cmOpenAtCursor,hcOpenAtCursor,
  622. NewItem('~B~rowse symbol at cursor','',kbNoKey,cmBrowseAtCursor,hcBrowseAtCursor,
  623. NewItem('Topic ~s~earch','Ctrl+F1',kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
  624. NewLine(
  625. NewItem('~O~ptions...','',kbNoKey,cmEditorOptions,hcEditorOptions,
  626. nil)))))))))));
  627. GetLocalMenu:=M;
  628. end;
  629. function TSourceEditor.GetCommandTarget: PView;
  630. begin
  631. GetCommandTarget:=@Self;
  632. end;
  633. procedure TSourceEditor.HandleEvent(var Event: TEvent);
  634. var DontClear: boolean;
  635. P: TPoint;
  636. S: string;
  637. begin
  638. TranslateMouseClick(@Self,Event);
  639. case Event.What of
  640. evMouseDown :
  641. if MouseInView(Event.Where) and (Event.Buttons=mbRightButton) then
  642. begin
  643. MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
  644. LocalMenu(P);
  645. ClearEvent(Event);
  646. end;
  647. evKeyDown :
  648. begin
  649. DontClear:=false;
  650. case Event.KeyCode of
  651. kbAltF10 : Message(@Self,evCommand,cmLocalMenu,@Self);
  652. else DontClear:=true;
  653. end;
  654. if DontClear=false then ClearEvent(Event);
  655. end;
  656. evCommand :
  657. begin
  658. DontClear:=false;
  659. case Event.Command of
  660. cmLocalMenu :
  661. begin
  662. P:=CurPos; Inc(P.X); Inc(P.Y);
  663. LocalMenu(P);
  664. end;
  665. cmBrowseAtCursor:
  666. begin
  667. S:=LowerCaseStr(GetEditorCurWord(@Self));
  668. OpenOneSymbolBrowser(S);
  669. end;
  670. cmOpenAtCursor :
  671. begin
  672. S:=LowerCaseStr(GetEditorCurWord(@Self));
  673. OpenFileName:=S+'.pp'+ListSeparator+
  674. S+'.pas'+ListSeparator+
  675. S+'.inc';
  676. Message(Application,evCommand,cmOpen,nil);
  677. end;
  678. cmEditorOptions :
  679. Message(Application,evCommand,cmEditorOptions,@Self);
  680. cmHelp :
  681. Message(@Self,evCommand,cmHelpTopicSearch,@Self);
  682. cmHelpTopicSearch :
  683. HelpTopicSearch(@Self);
  684. else DontClear:=true;
  685. end;
  686. if not DontClear then ClearEvent(Event);
  687. end;
  688. end;
  689. inherited HandleEvent(Event);
  690. end;
  691. procedure TFPWindow.HandleEvent(var Event: TEvent);
  692. begin
  693. case Event.What of
  694. evBroadcast :
  695. case Event.Command of
  696. cmUpdate :
  697. ReDraw;
  698. cmSearchWindow+1..cmSearchWindow+99 :
  699. if (Event.Command-cmSearchWindow=Number) then
  700. ClearEvent(Event);
  701. end;
  702. end;
  703. inherited HandleEvent(Event);
  704. end;
  705. function TIDEHelpWindow.GetPalette: PPalette;
  706. const P: string[length(CIDEHelpDialog)] = CIDEHelpDialog;
  707. begin
  708. GetPalette:=@P;
  709. end;
  710. constructor TSourceWindow.Init(var Bounds: TRect; AFileName: string);
  711. var HSB,VSB: PScrollBar;
  712. R: TRect;
  713. LoadFile: boolean;
  714. begin
  715. inherited Init(Bounds,AFileName,SearchFreeWindowNo);
  716. Options:=Options or ofTileAble;
  717. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  718. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  719. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  720. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  721. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  722. New(Indicator, Init(R));
  723. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  724. Insert(Indicator);
  725. GetExtent(R); R.Grow(-1,-1);
  726. LoadFile:=AFileName<>'';
  727. if not LoadFile then
  728. begin SetTitle('noname'+IntToStrZ(NonameCount,2)+'.pas'); Inc(NonameCount); end;
  729. New(Editor, Init(R, HSB, VSB, Indicator,AFileName));
  730. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  731. if LoadFile then
  732. if Editor^.LoadFile=false then
  733. ErrorBox(#3'Error reading file.',nil);
  734. Insert(Editor);
  735. UpdateTitle;
  736. end;
  737. procedure TSourceWindow.UpdateTitle;
  738. var Name: string;
  739. begin
  740. if Editor^.FileName<>'' then
  741. begin Name:=SmartPath(Editor^.FileName); SetTitle(Name); end;
  742. end;
  743. procedure TSourceWindow.SetTitle(ATitle: string);
  744. begin
  745. if Title<>nil then DisposeStr(Title);
  746. Title:=NewStr(ATitle);
  747. Frame^.DrawView;
  748. end;
  749. procedure TSourceWindow.HandleEvent(var Event: TEvent);
  750. var DontClear: boolean;
  751. begin
  752. case Event.What of
  753. evBroadcast :
  754. case Event.Command of
  755. cmUpdate :
  756. Update;
  757. cmUpdateTitle :
  758. UpdateTitle;
  759. cmSearchWindow :
  760. if @Self<>ClipboardWindow then
  761. ClearEvent(Event);
  762. end;
  763. evCommand :
  764. begin
  765. DontClear:=false;
  766. case Event.Command of
  767. cmSave :
  768. if Editor^.IsClipboard=false then
  769. Editor^.Save;
  770. cmSaveAs :
  771. if Editor^.IsClipboard=false then
  772. Editor^.SaveAs;
  773. else DontClear:=true;
  774. end;
  775. if DontClear=false then ClearEvent(Event);
  776. end;
  777. end;
  778. inherited HandleEvent(Event);
  779. end;
  780. procedure TSourceWindow.SetState(AState: Word; Enable: Boolean);
  781. var OldState: word;
  782. begin
  783. OldState:=State;
  784. inherited SetState(AState,Enable);
  785. if ((AState xor State) and sfActive)<>0 then
  786. UpdateCommands;
  787. end;
  788. procedure TSourceWindow.UpdateCommands;
  789. var Active: boolean;
  790. begin
  791. Active:=GetState(sfActive);
  792. if Editor^.IsClipboard=false then
  793. begin
  794. SetCmdState(SourceCmds+CompileCmds,Active);
  795. SetCmdState(EditorCmds,Active);
  796. end;
  797. if Active=false then
  798. SetCmdState(ToClipCmds+FromClipCmds+UndoCmds,false);
  799. end;
  800. procedure TSourceWindow.Update;
  801. begin
  802. ReDraw;
  803. end;
  804. function TSourceWindow.GetPalette: PPalette;
  805. const P: string[length(CSourceWindow)] = CSourceWindow;
  806. begin
  807. GetPalette:=@P;
  808. end;
  809. destructor TSourceWindow.Done;
  810. begin
  811. Message(Application,evBroadcast,cmSourceWndClosing,@Self);
  812. inherited Done;
  813. Message(Application,evBroadcast,cmUpdate,@Self);
  814. end;
  815. constructor TClipboardWindow.Init;
  816. var R: TRect;
  817. HSB,VSB: PScrollBar;
  818. begin
  819. Desktop^.GetExtent(R);
  820. inherited Init(R, '');
  821. SetTitle('Clipboard');
  822. HelpCtx:=hcClipboardWindow;
  823. Number:=wnNoNumber;
  824. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  825. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  826. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  827. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  828. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  829. New(Indicator, Init(R));
  830. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  831. Insert(Indicator);
  832. GetExtent(R); R.Grow(-1,-1);
  833. New(Editor, Init(R, HSB, VSB, Indicator, ''));
  834. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  835. Insert(Editor);
  836. Hide;
  837. Clipboard:=Editor;
  838. end;
  839. procedure TClipboardWindow.Close;
  840. begin
  841. Hide;
  842. end;
  843. destructor TClipboardWindow.Done;
  844. begin
  845. inherited Done;
  846. Clipboard:=nil;
  847. ClipboardWindow:=nil;
  848. end;
  849. function TAdvancedMenuBox.NewSubView(var Bounds: TRect; AMenu: PMenu;
  850. AParentMenu: PMenuView): PMenuView;
  851. begin
  852. NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
  853. end;
  854. function TAdvancedMenuBox.Execute: word;
  855. type
  856. MenuAction = (DoNothing, DoSelect, DoReturn);
  857. var
  858. AutoSelect: Boolean;
  859. Action: MenuAction;
  860. Ch: Char;
  861. Result: Word;
  862. ItemShown, P: PMenuItem;
  863. Target: PMenuView;
  864. R: TRect;
  865. E: TEvent;
  866. MouseActive: Boolean;
  867. function IsDisabled(Item: PMenuItem): boolean;
  868. var Found: boolean;
  869. begin
  870. Found:=Item^.Disabled or IsSeparator(Item);
  871. if (Found=false) and (IsSubMenu(Item)=false) then
  872. Found:=CommandEnabled(Item^.Command)=false;
  873. IsDisabled:=Found;
  874. end;
  875. procedure TrackMouse;
  876. var
  877. Mouse: TPoint;
  878. R: TRect;
  879. OldC: PMenuItem;
  880. begin
  881. MakeLocal(E.Where, Mouse);
  882. OldC:=Current;
  883. Current := Menu^.Items;
  884. while Current <> nil do
  885. begin
  886. GetItemRect(Current, R);
  887. if R.Contains(Mouse) then
  888. begin
  889. MouseActive := True;
  890. Break;
  891. end;
  892. Current := Current^.Next;
  893. end;
  894. if (Current<>nil) and IsDisabled(Current) then
  895. begin
  896. Current:={OldC}nil;
  897. MouseActive:=false;
  898. end;
  899. end;
  900. procedure TrackKey(FindNext: Boolean);
  901. procedure NextItem;
  902. begin
  903. Current := Current^.Next;
  904. if Current = nil then Current := Menu^.Items;
  905. end;
  906. procedure PrevItem;
  907. var
  908. P: PMenuItem;
  909. begin
  910. P := Current;
  911. if P = Menu^.Items then P := nil;
  912. repeat NextItem until Current^.Next = P;
  913. end;
  914. begin
  915. if Current <> nil then
  916. repeat
  917. if FindNext then NextItem else PrevItem;
  918. until (Current^.Name <> nil) and (IsDisabled(Current)=false);
  919. end;
  920. function MouseInOwner: Boolean;
  921. var
  922. Mouse: TPoint;
  923. R: TRect;
  924. begin
  925. MouseInOwner := False;
  926. if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
  927. begin
  928. ParentMenu^.MakeLocal(E.Where, Mouse);
  929. ParentMenu^.GetItemRect(ParentMenu^.Current, R);
  930. MouseInOwner := R.Contains(Mouse);
  931. end;
  932. end;
  933. function MouseInMenus: Boolean;
  934. var
  935. P: PMenuView;
  936. begin
  937. P := ParentMenu;
  938. while (P <> nil) and (P^.MouseInView(E.Where)=false) do
  939. P := P^.ParentMenu;
  940. MouseInMenus := P <> nil;
  941. end;
  942. function TopMenu: PMenuView;
  943. var
  944. P: PMenuView;
  945. begin
  946. P := @Self;
  947. while P^.ParentMenu <> nil do P := P^.ParentMenu;
  948. TopMenu := P;
  949. end;
  950. begin
  951. AutoSelect := False; E.What:=evNothing;
  952. Result := 0;
  953. ItemShown := nil;
  954. Current := Menu^.Default;
  955. MouseActive := False;
  956. if UpdateMenu(Menu) then
  957. begin
  958. if Current<>nil then
  959. if Current^.Disabled then
  960. TrackKey(true);
  961. repeat
  962. Action := DoNothing;
  963. GetEvent(E);
  964. case E.What of
  965. evMouseDown:
  966. if MouseInView(E.Where) or MouseInOwner then
  967. begin
  968. TrackMouse;
  969. if Size.Y = 1 then AutoSelect := True;
  970. end else Action := DoReturn;
  971. evMouseUp:
  972. begin
  973. TrackMouse;
  974. if MouseInOwner then
  975. Current := Menu^.Default
  976. else
  977. if (Current <> nil) and (Current^.Name <> nil) then
  978. Action := DoSelect
  979. else
  980. if MouseActive or MouseInView(E.Where) then Action := DoReturn
  981. else
  982. begin
  983. Current := Menu^.Default;
  984. if Current = nil then Current := Menu^.Items;
  985. Action := DoNothing;
  986. end;
  987. end;
  988. evMouseMove:
  989. if E.Buttons <> 0 then
  990. begin
  991. TrackMouse;
  992. if not (MouseInView(E.Where) or MouseInOwner) and
  993. MouseInMenus then Action := DoReturn;
  994. end;
  995. evKeyDown:
  996. case CtrlToArrow(E.KeyCode) of
  997. kbUp, kbDown:
  998. if Size.Y <> 1 then
  999. TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
  1000. if E.KeyCode = kbDown then AutoSelect := True;
  1001. kbLeft, kbRight:
  1002. if ParentMenu = nil then
  1003. TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
  1004. Action := DoReturn;
  1005. kbHome, kbEnd:
  1006. if Size.Y <> 1 then
  1007. begin
  1008. Current := Menu^.Items;
  1009. if E.KeyCode = kbEnd then TrackKey(False);
  1010. end;
  1011. kbEnter:
  1012. begin
  1013. if Size.Y = 1 then AutoSelect := True;
  1014. Action := DoSelect;
  1015. end;
  1016. kbEsc:
  1017. begin
  1018. Action := DoReturn;
  1019. if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
  1020. ClearEvent(E);
  1021. end;
  1022. else
  1023. Target := @Self;
  1024. Ch := GetAltChar(E.KeyCode);
  1025. if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
  1026. P := Target^.FindItem(Ch);
  1027. if P = nil then
  1028. begin
  1029. P := TopMenu^.HotKey(E.KeyCode);
  1030. if (P <> nil) and CommandEnabled(P^.Command) then
  1031. begin
  1032. Result := P^.Command;
  1033. Action := DoReturn;
  1034. end
  1035. end else
  1036. if Target = @Self then
  1037. begin
  1038. if Size.Y = 1 then AutoSelect := True;
  1039. Action := DoSelect;
  1040. Current := P;
  1041. end else
  1042. if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
  1043. Action := DoReturn;
  1044. end;
  1045. evCommand:
  1046. if E.Command = cmMenu then
  1047. begin
  1048. AutoSelect := False;
  1049. if ParentMenu <> nil then Action := DoReturn;
  1050. end else Action := DoReturn;
  1051. end;
  1052. if ItemShown <> Current then
  1053. begin
  1054. ItemShown := Current;
  1055. DrawView;
  1056. end;
  1057. if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
  1058. if Current <> nil then with Current^ do if Name <> nil then
  1059. if Command = 0 then
  1060. begin
  1061. if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
  1062. GetItemRect(Current, R);
  1063. R.A.X := R.A.X + Origin.X;
  1064. R.A.Y := R.B.Y + Origin.Y;
  1065. R.B := Owner^.Size;
  1066. if Size.Y = 1 then Dec(R.A.X);
  1067. Target := TopMenu^.NewSubView(R, SubMenu, @Self);
  1068. Result := Owner^.ExecView(Target);
  1069. Dispose(Target, Done);
  1070. end else if Action = DoSelect then Result := Command;
  1071. if (Result <> 0) and CommandEnabled(Result) then
  1072. begin
  1073. Action := DoReturn;
  1074. ClearEvent(E);
  1075. end
  1076. else
  1077. Result := 0;
  1078. until Action = DoReturn;
  1079. end;
  1080. if E.What <> evNothing then
  1081. if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
  1082. if Current <> nil then
  1083. begin
  1084. Menu^.Default := Current;
  1085. Current := nil;
  1086. DrawView;
  1087. end;
  1088. Execute := Result;
  1089. end;
  1090. function TAdvancedMenuPopup.NewSubView(var Bounds: TRect; AMenu: PMenu;
  1091. AParentMenu: PMenuView): PMenuView;
  1092. begin
  1093. NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
  1094. end;
  1095. function TAdvancedMenuPopup.Execute: word;
  1096. type
  1097. MenuAction = (DoNothing, DoSelect, DoReturn);
  1098. var
  1099. AutoSelect: Boolean;
  1100. Action: MenuAction;
  1101. Ch: Char;
  1102. Result: Word;
  1103. ItemShown, P: PMenuItem;
  1104. Target: PMenuView;
  1105. R: TRect;
  1106. E: TEvent;
  1107. MouseActive: Boolean;
  1108. function IsDisabled(Item: PMenuItem): boolean;
  1109. var Found: boolean;
  1110. begin
  1111. Found:=Item^.Disabled or IsSeparator(Item);
  1112. if (Found=false) and (IsSubMenu(Item)=false) then
  1113. Found:=CommandEnabled(Item^.Command)=false;
  1114. IsDisabled:=Found;
  1115. end;
  1116. procedure TrackMouse;
  1117. var
  1118. Mouse: TPoint;
  1119. R: TRect;
  1120. OldC: PMenuItem;
  1121. begin
  1122. MakeLocal(E.Where, Mouse);
  1123. OldC:=Current;
  1124. Current := Menu^.Items;
  1125. while Current <> nil do
  1126. begin
  1127. GetItemRect(Current, R);
  1128. if R.Contains(Mouse) then
  1129. begin
  1130. MouseActive := True;
  1131. Break;
  1132. end;
  1133. Current := Current^.Next;
  1134. end;
  1135. if (Current<>nil) and IsDisabled(Current) then
  1136. begin
  1137. Current:={OldC}nil;
  1138. MouseActive:=false;
  1139. end;
  1140. end;
  1141. procedure TrackKey(FindNext: Boolean);
  1142. procedure NextItem;
  1143. begin
  1144. Current := Current^.Next;
  1145. if Current = nil then Current := Menu^.Items;
  1146. end;
  1147. procedure PrevItem;
  1148. var
  1149. P: PMenuItem;
  1150. begin
  1151. P := Current;
  1152. if P = Menu^.Items then P := nil;
  1153. repeat NextItem until Current^.Next = P;
  1154. end;
  1155. begin
  1156. if Current <> nil then
  1157. repeat
  1158. if FindNext then NextItem else PrevItem;
  1159. until (Current^.Name <> nil) and (IsDisabled(Current)=false);
  1160. end;
  1161. function MouseInOwner: Boolean;
  1162. var
  1163. Mouse: TPoint;
  1164. R: TRect;
  1165. begin
  1166. MouseInOwner := False;
  1167. if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
  1168. begin
  1169. ParentMenu^.MakeLocal(E.Where, Mouse);
  1170. ParentMenu^.GetItemRect(ParentMenu^.Current, R);
  1171. MouseInOwner := R.Contains(Mouse);
  1172. end;
  1173. end;
  1174. function MouseInMenus: Boolean;
  1175. var
  1176. P: PMenuView;
  1177. begin
  1178. P := ParentMenu;
  1179. while (P <> nil) and (P^.MouseInView(E.Where)=false) do
  1180. P := P^.ParentMenu;
  1181. MouseInMenus := P <> nil;
  1182. end;
  1183. function TopMenu: PMenuView;
  1184. var
  1185. P: PMenuView;
  1186. begin
  1187. P := @Self;
  1188. while P^.ParentMenu <> nil do P := P^.ParentMenu;
  1189. TopMenu := P;
  1190. end;
  1191. begin
  1192. AutoSelect := False; E.What:=evNothing;
  1193. Result := 0;
  1194. ItemShown := nil;
  1195. Current := Menu^.Default;
  1196. MouseActive := False;
  1197. if UpdateMenu(Menu) then
  1198. begin
  1199. if Current<>nil then
  1200. if Current^.Disabled then
  1201. TrackKey(true);
  1202. repeat
  1203. Action := DoNothing;
  1204. GetEvent(E);
  1205. case E.What of
  1206. evMouseDown:
  1207. if MouseInView(E.Where) or MouseInOwner then
  1208. begin
  1209. TrackMouse;
  1210. if Size.Y = 1 then AutoSelect := True;
  1211. end else Action := DoReturn;
  1212. evMouseUp:
  1213. begin
  1214. TrackMouse;
  1215. if MouseInOwner then
  1216. Current := Menu^.Default
  1217. else
  1218. if (Current <> nil) and (Current^.Name <> nil) then
  1219. Action := DoSelect
  1220. else
  1221. if MouseActive or MouseInView(E.Where) then Action := DoReturn
  1222. else
  1223. begin
  1224. Current := Menu^.Default;
  1225. if Current = nil then Current := Menu^.Items;
  1226. Action := DoNothing;
  1227. end;
  1228. end;
  1229. evMouseMove:
  1230. if E.Buttons <> 0 then
  1231. begin
  1232. TrackMouse;
  1233. if not (MouseInView(E.Where) or MouseInOwner) and
  1234. MouseInMenus then Action := DoReturn;
  1235. end;
  1236. evKeyDown:
  1237. case CtrlToArrow(E.KeyCode) of
  1238. kbUp, kbDown:
  1239. if Size.Y <> 1 then
  1240. TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
  1241. if E.KeyCode = kbDown then AutoSelect := True;
  1242. kbLeft, kbRight:
  1243. if ParentMenu = nil then
  1244. TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
  1245. Action := DoReturn;
  1246. kbHome, kbEnd:
  1247. if Size.Y <> 1 then
  1248. begin
  1249. Current := Menu^.Items;
  1250. if E.KeyCode = kbEnd then TrackKey(False);
  1251. end;
  1252. kbEnter:
  1253. begin
  1254. if Size.Y = 1 then AutoSelect := True;
  1255. Action := DoSelect;
  1256. end;
  1257. kbEsc:
  1258. begin
  1259. Action := DoReturn;
  1260. if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
  1261. ClearEvent(E);
  1262. end;
  1263. else
  1264. Target := @Self;
  1265. Ch := GetAltChar(E.KeyCode);
  1266. if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
  1267. P := Target^.FindItem(Ch);
  1268. if P = nil then
  1269. begin
  1270. P := TopMenu^.HotKey(E.KeyCode);
  1271. if (P <> nil) and CommandEnabled(P^.Command) then
  1272. begin
  1273. Result := P^.Command;
  1274. Action := DoReturn;
  1275. end
  1276. end else
  1277. if Target = @Self then
  1278. begin
  1279. if Size.Y = 1 then AutoSelect := True;
  1280. Action := DoSelect;
  1281. Current := P;
  1282. end else
  1283. if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
  1284. Action := DoReturn;
  1285. end;
  1286. evCommand:
  1287. if E.Command = cmMenu then
  1288. begin
  1289. AutoSelect := False;
  1290. if ParentMenu <> nil then Action := DoReturn;
  1291. end else Action := DoReturn;
  1292. end;
  1293. if ItemShown <> Current then
  1294. begin
  1295. ItemShown := Current;
  1296. DrawView;
  1297. end;
  1298. if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
  1299. if Current <> nil then with Current^ do if Name <> nil then
  1300. if Command = 0 then
  1301. begin
  1302. if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
  1303. GetItemRect(Current, R);
  1304. R.A.X := R.A.X + Origin.X;
  1305. R.A.Y := R.B.Y + Origin.Y;
  1306. R.B := Owner^.Size;
  1307. if Size.Y = 1 then Dec(R.A.X);
  1308. Target := TopMenu^.NewSubView(R, SubMenu, @Self);
  1309. Result := Owner^.ExecView(Target);
  1310. Dispose(Target, Done);
  1311. end else if Action = DoSelect then Result := Command;
  1312. if (Result <> 0) and CommandEnabled(Result) then
  1313. begin
  1314. Action := DoReturn;
  1315. ClearEvent(E);
  1316. end
  1317. else
  1318. Result := 0;
  1319. until Action = DoReturn;
  1320. end;
  1321. if E.What <> evNothing then
  1322. if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
  1323. if Current <> nil then
  1324. begin
  1325. Menu^.Default := Current;
  1326. Current := nil;
  1327. DrawView;
  1328. end;
  1329. Execute := Result;
  1330. end;
  1331. constructor TAdvancedMenuBar.Init(var Bounds: TRect; AMenu: PMenu);
  1332. begin
  1333. inherited Init(Bounds, AMenu);
  1334. EventMask:=EventMask or evBroadcast;
  1335. end;
  1336. function TAdvancedMenuBar.NewSubView(var Bounds: TRect; AMenu: PMenu;
  1337. AParentMenu: PMenuView): PMenuView;
  1338. begin
  1339. NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
  1340. end;
  1341. procedure TAdvancedMenuBar.Update;
  1342. begin
  1343. UpdateMenu(Menu);
  1344. DrawView;
  1345. end;
  1346. procedure TAdvancedMenuBar.HandleEvent(var Event: TEvent);
  1347. begin
  1348. case Event.What of
  1349. evBroadcast :
  1350. case Event.Command of
  1351. cmUpdate : Update;
  1352. end;
  1353. end;
  1354. inherited HandleEvent(Event);
  1355. end;
  1356. function TAdvancedMenuBar.Execute: word;
  1357. type
  1358. MenuAction = (DoNothing, DoSelect, DoReturn);
  1359. var
  1360. AutoSelect: Boolean;
  1361. Action: MenuAction;
  1362. Ch: Char;
  1363. Result: Word;
  1364. ItemShown, P: PMenuItem;
  1365. Target: PMenuView;
  1366. R: TRect;
  1367. E: TEvent;
  1368. MouseActive: Boolean;
  1369. function IsDisabled(Item: PMenuItem): boolean;
  1370. var Dis : boolean;
  1371. begin
  1372. Dis:=Item^.Disabled or IsSeparator(Item);
  1373. if (Dis=false) and (IsSubMenu(Item)=false) then
  1374. Dis:=CommandEnabled(Item^.Command)=false;
  1375. IsDisabled:=Dis;
  1376. end;
  1377. procedure TrackMouse;
  1378. var
  1379. Mouse: TPoint;
  1380. R: TRect;
  1381. OldC: PMenuItem;
  1382. begin
  1383. MakeLocal(E.Where, Mouse);
  1384. OldC:=Current;
  1385. Current := Menu^.Items;
  1386. while Current <> nil do
  1387. begin
  1388. GetItemRect(Current, R);
  1389. if R.Contains(Mouse) then
  1390. begin
  1391. MouseActive := True;
  1392. Break;
  1393. end;
  1394. Current := Current^.Next;
  1395. end;
  1396. if (Current<>nil) and IsDisabled(Current) then
  1397. Current:=nil;
  1398. end;
  1399. procedure TrackKey(FindNext: Boolean);
  1400. procedure NextItem;
  1401. begin
  1402. Current := Current^.Next;
  1403. if Current = nil then Current := Menu^.Items;
  1404. end;
  1405. procedure PrevItem;
  1406. var
  1407. P: PMenuItem;
  1408. begin
  1409. P := Current;
  1410. if P = Menu^.Items then P := nil;
  1411. repeat NextItem until Current^.Next = P;
  1412. end;
  1413. begin
  1414. if Current <> nil then
  1415. repeat
  1416. if FindNext then NextItem else PrevItem;
  1417. until (Current^.Name <> nil) and (IsDisabled(Current)=false);
  1418. end;
  1419. function MouseInOwner: Boolean;
  1420. var
  1421. Mouse: TPoint;
  1422. R: TRect;
  1423. begin
  1424. MouseInOwner := False;
  1425. if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
  1426. begin
  1427. ParentMenu^.MakeLocal(E.Where, Mouse);
  1428. ParentMenu^.GetItemRect(ParentMenu^.Current, R);
  1429. MouseInOwner := R.Contains(Mouse);
  1430. end;
  1431. end;
  1432. function MouseInMenus: Boolean;
  1433. var
  1434. P: PMenuView;
  1435. begin
  1436. P := ParentMenu;
  1437. while (P <> nil) and not P^.MouseInView(E.Where) do P := P^.ParentMenu;
  1438. MouseInMenus := P <> nil;
  1439. end;
  1440. function TopMenu: PMenuView;
  1441. var
  1442. P: PMenuView;
  1443. begin
  1444. P := @Self;
  1445. while P^.ParentMenu <> nil do P := P^.ParentMenu;
  1446. TopMenu := P;
  1447. end;
  1448. begin
  1449. AutoSelect := False; E.What:=evNothing;
  1450. Result := 0;
  1451. ItemShown := nil;
  1452. Current := Menu^.Default;
  1453. MouseActive := False;
  1454. if UpdateMenu(Menu) then
  1455. begin
  1456. if Current<>nil then
  1457. if Current^.Disabled then
  1458. TrackKey(true);
  1459. repeat
  1460. Action := DoNothing;
  1461. GetEvent(E);
  1462. case E.What of
  1463. evMouseDown:
  1464. if MouseInView(E.Where) or MouseInOwner then
  1465. begin
  1466. TrackMouse;
  1467. if Size.Y = 1 then AutoSelect := True;
  1468. end else Action := DoReturn;
  1469. evMouseUp:
  1470. begin
  1471. TrackMouse;
  1472. if MouseInOwner then
  1473. Current := Menu^.Default
  1474. else
  1475. if (Current <> nil) and (Current^.Name <> nil) then
  1476. Action := DoSelect
  1477. else
  1478. if MouseActive or MouseInView(E.Where) then Action := DoReturn
  1479. else
  1480. begin
  1481. Current := Menu^.Default;
  1482. if Current = nil then Current := Menu^.Items;
  1483. Action := DoNothing;
  1484. end;
  1485. end;
  1486. evMouseMove:
  1487. if E.Buttons <> 0 then
  1488. begin
  1489. TrackMouse;
  1490. if not (MouseInView(E.Where) or MouseInOwner) and
  1491. MouseInMenus then Action := DoReturn;
  1492. end;
  1493. evKeyDown:
  1494. case CtrlToArrow(E.KeyCode) of
  1495. kbUp, kbDown:
  1496. if Size.Y <> 1 then
  1497. TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
  1498. if E.KeyCode = kbDown then AutoSelect := True;
  1499. kbLeft, kbRight:
  1500. if ParentMenu = nil then
  1501. TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
  1502. Action := DoReturn;
  1503. kbHome, kbEnd:
  1504. if Size.Y <> 1 then
  1505. begin
  1506. Current := Menu^.Items;
  1507. if E.KeyCode = kbEnd then TrackKey(False);
  1508. end;
  1509. kbEnter:
  1510. begin
  1511. if Size.Y = 1 then AutoSelect := True;
  1512. Action := DoSelect;
  1513. end;
  1514. kbEsc:
  1515. begin
  1516. Action := DoReturn;
  1517. if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
  1518. ClearEvent(E);
  1519. end;
  1520. else
  1521. Target := @Self;
  1522. Ch := GetAltChar(E.KeyCode);
  1523. if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
  1524. P := Target^.FindItem(Ch);
  1525. if P = nil then
  1526. begin
  1527. P := TopMenu^.HotKey(E.KeyCode);
  1528. if (P <> nil) and CommandEnabled(P^.Command) then
  1529. begin
  1530. Result := P^.Command;
  1531. Action := DoReturn;
  1532. end
  1533. end else
  1534. if Target = @Self then
  1535. begin
  1536. if Size.Y = 1 then AutoSelect := True;
  1537. Action := DoSelect;
  1538. Current := P;
  1539. end else
  1540. if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
  1541. Action := DoReturn;
  1542. end;
  1543. evCommand:
  1544. if E.Command = cmMenu then
  1545. begin
  1546. AutoSelect := False;
  1547. if ParentMenu <> nil then Action := DoReturn;
  1548. end else Action := DoReturn;
  1549. end;
  1550. if ItemShown <> Current then
  1551. begin
  1552. ItemShown := Current;
  1553. DrawView;
  1554. end;
  1555. if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
  1556. if Current <> nil then with Current^ do if Name <> nil then
  1557. if Command = 0 then
  1558. begin
  1559. if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
  1560. GetItemRect(Current, R);
  1561. R.A.X := R.A.X + Origin.X;
  1562. R.A.Y := R.B.Y + Origin.Y;
  1563. R.B := Owner^.Size;
  1564. if Size.Y = 1 then Dec(R.A.X);
  1565. Target := TopMenu^.NewSubView(R, SubMenu, @Self);
  1566. Result := Owner^.ExecView(Target);
  1567. Dispose(Target, Done);
  1568. end else if Action = DoSelect then Result := Command;
  1569. if (Result <> 0) and CommandEnabled(Result) then
  1570. begin
  1571. Action := DoReturn;
  1572. ClearEvent(E);
  1573. end
  1574. else
  1575. Result := 0;
  1576. until Action = DoReturn;
  1577. end;
  1578. if E.What <> evNothing then
  1579. if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
  1580. if Current <> nil then
  1581. begin
  1582. Menu^.Default := Current;
  1583. Current := nil;
  1584. DrawView;
  1585. end;
  1586. Execute := Result;
  1587. end;
  1588. procedure ErrorBox(S: string; Params: pointer);
  1589. begin
  1590. MessageBox(S,Params,mfError+mfInsertInApp+mfOKButton);
  1591. end;
  1592. procedure WarningBox(S: string; Params: pointer);
  1593. begin
  1594. MessageBox(S,Params,mfWarning+mfInsertInApp+mfOKButton);
  1595. end;
  1596. procedure InformationBox(S: string; Params: pointer);
  1597. begin
  1598. MessageBox(S,Params,mfInformation+mfInsertInApp+mfOKButton);
  1599. end;
  1600. function ConfirmBox(S: string; Params: pointer; CanCancel: boolean): word;
  1601. begin
  1602. ConfirmBox:=MessageBox(S,Params,mfConfirmation+mfInsertInApp+mfYesButton+mfNoButton+integer(CanCancel)*mfCancelButton);
  1603. end;
  1604. function IsSeparator(P: PMenuItem): boolean;
  1605. begin
  1606. IsSeparator:=(P<>nil) and (P^.Name=nil) and (P^.HelpCtx=hcNoContext);
  1607. end;
  1608. function IsSubMenu(P: PMenuItem): boolean;
  1609. begin
  1610. IsSubMenu:=(P<>nil) and (P^.Name<>nil) and (P^.Command=0) and (P^.SubMenu<>nil);
  1611. end;
  1612. function SearchMenuItem(Menu: PMenu; Cmd: word): PMenuItem;
  1613. var P,I: PMenuItem;
  1614. begin
  1615. I:=nil;
  1616. if Menu=nil then P:=nil else P:=Menu^.Items;
  1617. while (P<>nil) and (I=nil) do
  1618. begin
  1619. if IsSubMenu(P) then
  1620. I:=SearchMenuItem(P^.SubMenu,Cmd);
  1621. if I=nil then
  1622. if P^.Command=Cmd then I:=P else
  1623. P:=P^.Next;
  1624. end;
  1625. SearchMenuItem:=I;
  1626. end;
  1627. procedure SetMenuItemParam(Menu: PMenuItem; Param: string);
  1628. begin
  1629. if Menu=nil then Exit;
  1630. if Menu^.Param<>nil then DisposeStr(Menu^.Param);
  1631. Menu^.Param:=NewStr(Param);
  1632. end;
  1633. function UpdateMenu(M: PMenu): boolean;
  1634. var P: PMenuItem;
  1635. IsEnabled: boolean;
  1636. begin
  1637. if M=nil then begin UpdateMenu:=false; Exit; end;
  1638. P:=M^.Items; IsEnabled:=false;
  1639. while (P<>nil) do
  1640. begin
  1641. if IsSubMenu(P) then
  1642. P^.Disabled:=not UpdateMenu(P^.SubMenu);
  1643. if (IsSeparator(P)=false) and (P^.Disabled=false) and (Application^.CommandEnabled(P^.Command)=true) then
  1644. IsEnabled:=true;
  1645. P:=P^.Next;
  1646. end;
  1647. UpdateMenu:=IsEnabled;
  1648. end;
  1649. function SearchSubMenu(M: PMenu; Index: integer): PMenuItem;
  1650. var P,C: PMenuItem;
  1651. Count: integer;
  1652. begin
  1653. P:=nil; Count:=-1;
  1654. if M<>nil then C:=M^.Items else C:=nil;
  1655. while (C<>nil) and (P=nil) do
  1656. begin
  1657. if IsSubMenu(C) then
  1658. begin
  1659. Inc(Count);
  1660. if Count=Index then P:=C;
  1661. end;
  1662. C:=C^.Next;
  1663. end;
  1664. SearchSubMenu:=P;
  1665. end;
  1666. procedure AppendMenuItem(M: PMenu; I: PMenuItem);
  1667. var P: PMenuItem;
  1668. begin
  1669. if (M=nil) or (I=nil) then Exit;
  1670. I^.Next:=nil;
  1671. if M^.Items=nil then M^.Items:=I else
  1672. begin
  1673. P:=M^.Items;
  1674. while (P^.Next<>nil) do P:=P^.Next;
  1675. P^.Next:=I;
  1676. end;
  1677. end;
  1678. procedure DisposeMenuItem(P: PMenuItem);
  1679. begin
  1680. if P<>nil then
  1681. begin
  1682. if IsSubMenu(P) then DisposeMenu(P^.SubMenu) else
  1683. if IsSeparator(P)=false then
  1684. if P^.Param<>nil then DisposeStr(P^.Param);
  1685. if P^.Name<>nil then DisposeStr(P^.Name);
  1686. Dispose(P);
  1687. end;
  1688. end;
  1689. procedure RemoveMenuItem(Menu: PMenu; I: PMenuItem);
  1690. var P,PrevP: PMenuItem;
  1691. begin
  1692. if (Menu=nil) or (I=nil) then Exit;
  1693. P:=Menu^.Items; PrevP:=nil;
  1694. while (P<>nil) do
  1695. begin
  1696. if P=I then
  1697. begin
  1698. if Menu^.Items<>I then PrevP^.Next:=P^.Next
  1699. else Menu^.Items:=P^.Next;
  1700. DisposeMenuItem(P);
  1701. Break;
  1702. end;
  1703. PrevP:=P; P:=P^.Next;
  1704. end;
  1705. end;
  1706. function GetMenuItemBefore(Menu: PMenu; BeforeOf: PMenuItem): PMenuItem;
  1707. var P,C: PMenuItem;
  1708. begin
  1709. P:=nil;
  1710. if Menu<>nil then C:=Menu^.Items else C:=nil;
  1711. while (C<>nil) do
  1712. begin
  1713. if C^.Next=BeforeOf then begin P:=C; Break; end;
  1714. C:=C^.Next;
  1715. end;
  1716. GetMenuItemBefore:=P;
  1717. end;
  1718. procedure TAdvancedStaticText.SetText(S: string);
  1719. begin
  1720. if Text<>nil then DisposeStr(Text);
  1721. Text:=NewStr(S);
  1722. DrawView;
  1723. end;
  1724. procedure TAdvancedListBox.HandleEvent(var Event: TEvent);
  1725. begin
  1726. case Event.What of
  1727. evMouseDown :
  1728. if MouseInView(Event.Where) and (Event.Double) then
  1729. begin
  1730. inherited HandleEvent(Event);
  1731. if Range>Focused then SelectItem(Focused);
  1732. end;
  1733. evBroadcast :
  1734. case Event.Command of
  1735. cmListItemSelected :
  1736. Message(Owner,evBroadcast,cmDefault,nil);
  1737. end;
  1738. end;
  1739. inherited HandleEvent(Event);
  1740. end;
  1741. constructor TColorStaticText.Init(var Bounds: TRect; AText: String; AColor: word);
  1742. begin
  1743. inherited Init(Bounds,AText);
  1744. Color:=AColor;
  1745. end;
  1746. procedure TColorStaticText.Draw;
  1747. var
  1748. C: word;
  1749. Center: Boolean;
  1750. I, J, L, P, Y: Integer;
  1751. B: TDrawBuffer;
  1752. S: String;
  1753. T: string;
  1754. CurS: string;
  1755. TildeCount,Po: integer;
  1756. TempS: string;
  1757. begin
  1758. if Size.X=0 then Exit;
  1759. if DontWrap=false then
  1760. begin
  1761. C:=Color;
  1762. GetText(S);
  1763. L := Length(S);
  1764. P := 1;
  1765. Y := 0;
  1766. Center := False;
  1767. while Y < Size.Y do
  1768. begin
  1769. MoveChar(B, ' ', Lo(C), Size.X);
  1770. if P <= L then
  1771. begin
  1772. if S[P] = #3 then
  1773. begin
  1774. Center := True;
  1775. Inc(P);
  1776. end;
  1777. I := P;
  1778. repeat
  1779. J := P;
  1780. while (P <= L) and (S[P] = ' ') do Inc(P);
  1781. while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do Inc(P);
  1782. until (P > L) or (P >= I + Size.X) or (S[P] = #13);
  1783. TildeCount:=0; TempS:=copy(S,I,P-I);
  1784. repeat
  1785. Po:=Pos('~',TempS);
  1786. if Po>0 then begin Inc(TildeCount); Delete(TempS,1,Po); end;
  1787. until Po=0;
  1788. if P > I + Size.X + TildeCount then
  1789. if J > I then P := J else P := I + Size.X;
  1790. T:=copy(S,I,P-I);
  1791. if Center then J := (Size.X - {P + I}CStrLen(T)) div 2 else J := 0;
  1792. MoveCStr(B[J],T,C);
  1793. while (P <= L) and (S[P] = ' ') do Inc(P);
  1794. if (P <= L) and (S[P] = #13) then
  1795. begin
  1796. Center := False;
  1797. Inc(P);
  1798. if (P <= L) and (S[P] = #10) then Inc(P);
  1799. end;
  1800. end;
  1801. WriteLine(0, Y, Size.X, 1, B);
  1802. Inc(Y);
  1803. end;
  1804. end { Wrap=false } else
  1805. begin
  1806. C := Color;
  1807. GetText(S);
  1808. I:=1;
  1809. for Y:=0 to Size.Y-1 do
  1810. begin
  1811. MoveChar(B, ' ', Lo(C), Size.X);
  1812. CurS:='';
  1813. if S<>'' then
  1814. begin
  1815. P:=Pos(#13,S);
  1816. if P=0 then P:=length(S)+1;
  1817. CurS:=copy(S,1,P-1);
  1818. CurS:=copy(CurS,Delta.X+1,255);
  1819. CurS:=copy(CurS,1,MaxViewWidth);
  1820. Delete(S,1,P);
  1821. end;
  1822. if CurS<>'' then MoveCStr(B,CurS,C);
  1823. WriteLine(0,Y,Size.X,1,B);
  1824. end;
  1825. end;
  1826. end;
  1827. function TUnsortedStringCollection.At(Index: Integer): PString;
  1828. begin
  1829. At:=inherited At(Index);
  1830. end;
  1831. procedure TUnsortedStringCollection.FreeItem(Item: Pointer);
  1832. begin
  1833. if Item<>nil then DisposeStr(Item);
  1834. end;
  1835. constructor THSListBox.Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
  1836. begin
  1837. inherited Init(Bounds,ANumCols,AVScrollBar);
  1838. HScrollBar:=AHScrollBar;
  1839. end;
  1840. constructor TDlgWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
  1841. begin
  1842. inherited Init(Bounds,ATitle);
  1843. Number:=ANumber;
  1844. Flags:=Flags or (wfMove + wfGrow + wfClose + wfZoom);
  1845. end;
  1846. procedure TLocalMenuListBox.LocalMenu(P: TPoint);
  1847. var M: PMenu;
  1848. MV: PAdvancedMenuPopUp;
  1849. R: TRect;
  1850. Re: word;
  1851. begin
  1852. M:=GetLocalMenu;
  1853. if M=nil then Exit;
  1854. if LastLocalCmd<>0 then
  1855. M^.Default:=SearchMenuItem(M,LastLocalCmd);
  1856. Desktop^.GetExtent(R);
  1857. MakeGlobal(P,R.A); {Desktop^.MakeLocal(R.A,R.A);}
  1858. New(MV, Init(R, M));
  1859. Re:=Application^.ExecView(MV);
  1860. if M^.Default=nil then LastLocalCmd:=0
  1861. else LastLocalCmd:=M^.Default^.Command;
  1862. Dispose(MV, Done);
  1863. if Re<>0 then
  1864. Message(GetCommandTarget,evCommand,Re,@Self);
  1865. end;
  1866. function TLocalMenuListBox.GetLocalMenu: PMenu;
  1867. begin
  1868. GetLocalMenu:=nil;
  1869. Abstract;
  1870. end;
  1871. function TLocalMenuListBox.GetCommandTarget: PView;
  1872. begin
  1873. GetCommandTarget:=@Self;
  1874. end;
  1875. procedure TLocalMenuListBox.HandleEvent(var Event: TEvent);
  1876. var DontClear: boolean;
  1877. P: TPoint;
  1878. begin
  1879. case Event.What of
  1880. evMouseDown :
  1881. if MouseInView(Event.Where) and (Event.Buttons=mbRightButton) then
  1882. begin
  1883. MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
  1884. LocalMenu(P);
  1885. ClearEvent(Event);
  1886. end;
  1887. evKeyDown :
  1888. begin
  1889. DontClear:=false;
  1890. case Event.KeyCode of
  1891. kbAltF10 : Message(@Self,evCommand,cmLocalMenu,@Self);
  1892. else DontClear:=true;
  1893. end;
  1894. if DontClear=false then ClearEvent(Event);
  1895. end;
  1896. evCommand :
  1897. begin
  1898. DontClear:=false;
  1899. case Event.Command of
  1900. cmLocalMenu :
  1901. begin
  1902. P:=Cursor; Inc(P.X); Inc(P.Y);
  1903. LocalMenu(P);
  1904. end;
  1905. else DontClear:=true;
  1906. end;
  1907. if not DontClear then ClearEvent(Event);
  1908. end;
  1909. end;
  1910. inherited HandleEvent(Event);
  1911. end;
  1912. constructor TMessageListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1913. begin
  1914. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1915. NoSelection:=true;
  1916. end;
  1917. function TMessageListBox.GetLocalMenu: PMenu;
  1918. var M: PMenu;
  1919. begin
  1920. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1921. M:=NewMenu(
  1922. NewItem('~C~lear','',kbNoKey,cmMsgClear,hcMsgClear,
  1923. NewLine(
  1924. NewItem('~G~oto source','',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1925. NewItem('~T~rack source','',kbNoKey,cmMsgTrackSource,hcMsgTrackSource,
  1926. nil)))));
  1927. GetLocalMenu:=M;
  1928. end;
  1929. procedure TMessageListBox.HandleEvent(var Event: TEvent);
  1930. var DontClear: boolean;
  1931. begin
  1932. case Event.What of
  1933. evKeyDown :
  1934. begin
  1935. DontClear:=false;
  1936. case Event.KeyCode of
  1937. kbEnter :
  1938. if Owner<>pointer(SD) then
  1939. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1940. else DontClear:=true;
  1941. end;
  1942. if DontClear=false then ClearEvent(Event);
  1943. end;
  1944. evBroadcast :
  1945. case Event.Command of
  1946. cmListItemSelected :
  1947. if Event.InfoPtr=@Self then
  1948. Message(@Self,evCommand,cmMsgTrackSource,nil);
  1949. end;
  1950. evCommand :
  1951. begin
  1952. DontClear:=false;
  1953. case Event.Command of
  1954. cmMsgGotoSource :
  1955. if Range>0 then
  1956. GotoSource;
  1957. cmMsgTrackSource :
  1958. if Range>0 then
  1959. TrackSource;
  1960. cmMsgClear :
  1961. Clear;
  1962. else DontClear:=true;
  1963. end;
  1964. if DontClear=false then ClearEvent(Event);
  1965. end;
  1966. end;
  1967. inherited HandleEvent(Event);
  1968. end;
  1969. procedure TMessageListBox.AddItem(P: PMessageItem);
  1970. var W: integer;
  1971. begin
  1972. if List=nil then New(List, Init(500,500));
  1973. W:=length(P^.GetText(255));
  1974. if W>MaxWidth then
  1975. begin
  1976. MaxWidth:=W;
  1977. if HScrollBar<>nil then
  1978. HScrollBar^.SetRange(0,MaxWidth);
  1979. end;
  1980. List^.Insert(P);
  1981. SetRange(List^.Count);
  1982. if Focused=List^.Count-1-1 then
  1983. FocusItem(List^.Count-1);
  1984. DrawView;
  1985. end;
  1986. function TMessageListBox.GetText(Item: Integer; MaxLen: Integer): String;
  1987. var P: PMessageItem;
  1988. S: string;
  1989. begin
  1990. P:=List^.At(Item);
  1991. S:=P^.GetText(MaxLen);
  1992. GetText:=copy(S,1,MaxLen);
  1993. end;
  1994. procedure TMessageListBox.Clear;
  1995. begin
  1996. if List<>nil then Dispose(List, Done); List:=nil; MaxWidth:=0;
  1997. SetRange(0); DrawView;
  1998. end;
  1999. procedure TMessageListBox.TrackSource;
  2000. var W: PSourceWindow;
  2001. P: PMessageItem;
  2002. R: TRect;
  2003. begin
  2004. if Range=0 then Exit;
  2005. P:=List^.At(Focused);
  2006. if P^.ID=0 then Exit;
  2007. Desktop^.Lock;
  2008. GetNextEditorBounds(R);
  2009. if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
  2010. R.B.Y:=Owner^.Origin.Y;
  2011. W:=TryToOpenFile(@R,P^.GetModuleName,0,P^.ID-1);
  2012. if W<>nil then
  2013. begin
  2014. W^.Select;
  2015. W^.Editor^.SetHighlightRow(P^.ID-1);
  2016. end;
  2017. if Assigned(Owner) then
  2018. Owner^.Select;
  2019. Desktop^.UnLock;
  2020. end;
  2021. procedure TMessageListBox.GotoSource;
  2022. var W: PSourceWindow;
  2023. P: PMessageItem;
  2024. begin
  2025. if Range=0 then Exit;
  2026. P:=List^.At(Focused);
  2027. if P^.ID=0 then Exit;
  2028. Desktop^.Lock;
  2029. W:=TryToOpenFile(nil,P^.GetModuleName,0,P^.ID-1);
  2030. Message(Owner,evCommand,cmClose,nil);
  2031. Desktop^.UnLock;
  2032. end;
  2033. procedure TMessageListBox.Draw;
  2034. var
  2035. I, J, Item: Integer;
  2036. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2037. ColWidth, CurCol, Indent: Integer;
  2038. B: TDrawBuffer;
  2039. Text: String;
  2040. SCOff: Byte;
  2041. TC: byte;
  2042. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  2043. begin
  2044. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2045. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2046. begin
  2047. NormalColor := GetColor(1);
  2048. FocusedColor := GetColor(3);
  2049. SelectedColor := GetColor(4);
  2050. end else
  2051. begin
  2052. NormalColor := GetColor(2);
  2053. SelectedColor := GetColor(4);
  2054. end;
  2055. if Transparent then
  2056. begin MT(NormalColor); MT(SelectedColor); end;
  2057. if NoSelection then
  2058. SelectedColor:=NormalColor;
  2059. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2060. else Indent := 0;
  2061. ColWidth := Size.X div NumCols + 1;
  2062. for I := 0 to Size.Y - 1 do
  2063. begin
  2064. for J := 0 to NumCols-1 do
  2065. begin
  2066. Item := J*Size.Y + I + TopItem;
  2067. CurCol := J*ColWidth;
  2068. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2069. (Focused = Item) and (Range > 0) then
  2070. begin
  2071. Color := FocusedColor;
  2072. SetCursor(CurCol+1,I);
  2073. SCOff := 0;
  2074. end
  2075. else if (Item < Range) and IsSelected(Item) then
  2076. begin
  2077. Color := SelectedColor;
  2078. SCOff := 2;
  2079. end
  2080. else
  2081. begin
  2082. Color := NormalColor;
  2083. SCOff := 4;
  2084. end;
  2085. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2086. if Item < Range then
  2087. begin
  2088. Text := GetText(Item, ColWidth + Indent);
  2089. Text := Copy(Text,Indent,ColWidth);
  2090. MoveStr(B[CurCol+1], Text, Color);
  2091. if ShowMarkers then
  2092. begin
  2093. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2094. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2095. end;
  2096. end;
  2097. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2098. end;
  2099. WriteLine(0, I, Size.X, 1, B);
  2100. end;
  2101. end;
  2102. destructor TMessageListBox.Done;
  2103. begin
  2104. inherited Done;
  2105. if List<>nil then Dispose(List, Done);
  2106. end;
  2107. constructor TMessageItem.Init(AClass: longint; AText, AModule: string; AID: longint);
  2108. begin
  2109. inherited Init;
  2110. TClass:=AClass;
  2111. Text:=NewStr(AText);
  2112. Module:=NewStr(AModule);
  2113. ID:=AID;
  2114. end;
  2115. function TMessageItem.GetText(MaxLen: integer): string;
  2116. var S: string;
  2117. begin
  2118. if Text=nil then S:='' else S:=Text^;
  2119. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  2120. GetText:=S;
  2121. end;
  2122. procedure TMessageItem.Selected;
  2123. begin
  2124. end;
  2125. function TMessageItem.GetModuleName: string;
  2126. begin
  2127. GetModuleName:=GetStr(Module);
  2128. end;
  2129. destructor TMessageItem.Done;
  2130. begin
  2131. inherited Done;
  2132. if Text<>nil then DisposeStr(Text);
  2133. if Module<>nil then DisposeStr(Module);
  2134. end;
  2135. function TCompilerMessage.GetText(MaxLen: Integer): String;
  2136. var ClassS: string[20];
  2137. S: string;
  2138. begin
  2139. if TClass=
  2140. V_Fatal then ClassS:='Fatal' else if TClass =
  2141. V_Error then ClassS:='Error' else if TClass =
  2142. V_Normal then ClassS:='' else if TClass =
  2143. V_Warning then ClassS:='Warning' else if TClass =
  2144. V_Note then ClassS:='Note' else if TClass =
  2145. V_Hint then ClassS:='Hint' else if TClass =
  2146. V_Macro then ClassS:='Macro' else if TClass =
  2147. V_Procedure then ClassS:='Procedure' else if TClass =
  2148. V_Conditional then ClassS:='Conditional' else if TClass =
  2149. V_Info then ClassS:='Info' else if TClass =
  2150. V_Status then ClassS:='Status' else if TClass =
  2151. V_Used then ClassS:='Used' else if TClass =
  2152. V_Tried then ClassS:='Tried' else if TClass =
  2153. V_Debug then ClassS:='Debug'
  2154. else
  2155. ClassS:='???';
  2156. if ClassS<>'' then
  2157. ClassS:=RExpand(ClassS,0)+': ';
  2158. S:=ClassS;
  2159. if (Module<>nil) {and (ID<>0)} then
  2160. S:=S+Module^+' ('+IntToStr(ID)+'): ';
  2161. if Text<>nil then S:=ClassS+Text^;
  2162. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  2163. GetText:=S;
  2164. end;
  2165. constructor TProgramInfoWindow.Init;
  2166. var R,R2: TRect;
  2167. HSB,VSB: PScrollBar;
  2168. ST: PStaticText;
  2169. C: word;
  2170. const White = 15;
  2171. begin
  2172. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-13;
  2173. inherited Init(R, 'Program Information', wnNoNumber);
  2174. HelpCtx:=hcInfoWindow;
  2175. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+3;
  2176. C:=((Desktop^.GetColor(32+6) and $f0) or White)*256+Desktop^.GetColor(32+6);
  2177. New(InfoST, Init(R,'', C)); InfoST^.GrowMode:=gfGrowHiX;
  2178. InfoST^.DontWrap:=true;
  2179. Insert(InfoST);
  2180. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,3); R.B.Y:=R.A.Y+1;
  2181. New(ST, Init(R, CharStr('Ä', MaxViewWidth))); ST^.GrowMode:=gfGrowHiX; Insert(ST);
  2182. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,4);
  2183. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  2184. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  2185. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  2186. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2187. New(LogLB, Init(R,HSB,VSB));
  2188. LogLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2189. LogLB^.Transparent:=true;
  2190. Insert(LogLB);
  2191. Update;
  2192. end;
  2193. procedure TProgramInfoWindow.AddMessage(AClass: longint; Msg, Module: string; Line: longint);
  2194. begin
  2195. if AClass>=V_Info then Line:=0;
  2196. LogLB^.AddItem(New(PCompilerMessage, Init(AClass, Msg, Module, Line)));
  2197. end;
  2198. procedure TProgramInfoWindow.SizeLimits(var Min, Max: TPoint);
  2199. begin
  2200. inherited SizeLimits(Min,Max);
  2201. Min.X:=30; Min.Y:=9;
  2202. end;
  2203. procedure TProgramInfoWindow.Close;
  2204. begin
  2205. Hide;
  2206. end;
  2207. procedure TProgramInfoWindow.HandleEvent(var Event: TEvent);
  2208. begin
  2209. case Event.What of
  2210. evBroadcast :
  2211. case Event.Command of
  2212. cmUpdate :
  2213. Update;
  2214. end;
  2215. end;
  2216. inherited HandleEvent(Event);
  2217. end;
  2218. procedure TProgramInfoWindow.Update;
  2219. begin
  2220. InfoST^.SetText(
  2221. {#13+ }
  2222. ' Current module : '+MainFile+#13+
  2223. ' Last exit code : '+IntToStr(LastExitCode)+#13+
  2224. ' Available memory : '+IntToStrL(MemAvail div 1024,5)+'K'+#13+
  2225. ''
  2226. );
  2227. end;
  2228. destructor TProgramInfoWindow.Done;
  2229. begin
  2230. inherited Done;
  2231. ProgramInfoWindow:=nil;
  2232. end;
  2233. function TAdvancedStatusLine.GetStatusText: string;
  2234. var S: string;
  2235. begin
  2236. if StatusText=nil then S:='' else S:=StatusText^;
  2237. GetStatusText:=S;
  2238. end;
  2239. procedure TAdvancedStatusLine.SetStatusText(S: string);
  2240. begin
  2241. if StatusText<>nil then DisposeStr(StatusText);
  2242. StatusText:=NewStr(S);
  2243. DrawView;
  2244. end;
  2245. procedure TAdvancedStatusLine.ClearStatusText;
  2246. begin
  2247. SetStatusText('');
  2248. end;
  2249. procedure TAdvancedStatusLine.Draw;
  2250. var B: TDrawBuffer;
  2251. C: word;
  2252. S: string;
  2253. begin
  2254. S:=GetStatusText;
  2255. if S='' then inherited Draw else
  2256. begin
  2257. C:=GetColor(1);
  2258. MoveChar(B,' ',C,Size.X);
  2259. MoveStr(B[1],S,C);
  2260. WriteLine(0,0,Size.X,Size.Y,B);
  2261. end;
  2262. end;
  2263. constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
  2264. begin
  2265. inherited Init(Bounds);
  2266. Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
  2267. GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
  2268. TabDefs:=ATabDef;
  2269. ActiveDef:=-1;
  2270. SelectTab(0);
  2271. ReDraw;
  2272. end;
  2273. function TTab.TabCount: integer;
  2274. var i: integer;
  2275. P: PTabDef;
  2276. begin
  2277. I:=0; P:=TabDefs;
  2278. while (P<>nil) do
  2279. begin
  2280. Inc(I);
  2281. P:=P^.Next;
  2282. end;
  2283. TabCount:=I;
  2284. end;
  2285. function TTab.AtTab(Index: integer): PTabDef;
  2286. var i: integer;
  2287. P: PTabDef;
  2288. begin
  2289. i:=0; P:=TabDefs;
  2290. while (I<Index) do
  2291. begin
  2292. if P=nil then RunError($AA);
  2293. P:=P^.Next;
  2294. Inc(i);
  2295. end;
  2296. AtTab:=P;
  2297. end;
  2298. procedure TTab.SelectTab(Index: integer);
  2299. var P: PTabItem;
  2300. V: PView;
  2301. begin
  2302. if ActiveDef<>Index then
  2303. begin
  2304. if Owner<>nil then Owner^.Lock;
  2305. Lock;
  2306. { --- Update --- }
  2307. if TabDefs<>nil then
  2308. begin
  2309. DefCount:=1;
  2310. while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
  2311. end
  2312. else DefCount:=0;
  2313. if ActiveDef<>-1 then
  2314. begin
  2315. P:=AtTab(ActiveDef)^.Items;
  2316. while P<>nil do
  2317. begin
  2318. if P^.View<>nil then Delete(P^.View);
  2319. P:=P^.Next;
  2320. end;
  2321. end;
  2322. ActiveDef:=Index;
  2323. P:=AtTab(ActiveDef)^.Items;
  2324. while P<>nil do
  2325. begin
  2326. if P^.View<>nil then Insert(P^.View);
  2327. P:=P^.Next;
  2328. end;
  2329. V:=AtTab(ActiveDef)^.DefItem;
  2330. if V<>nil then V^.Select;
  2331. ReDraw;
  2332. { --- Update --- }
  2333. UnLock;
  2334. if Owner<>nil then Owner^.UnLock;
  2335. DrawView;
  2336. end;
  2337. end;
  2338. procedure TTab.ChangeBounds(var Bounds: TRect);
  2339. var D: TPoint;
  2340. procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
  2341. var
  2342. R: TRect;
  2343. begin
  2344. if P^.Owner=nil then Exit; { it think this is a bug in TV }
  2345. P^.CalcBounds(R, D);
  2346. P^.ChangeBounds(R);
  2347. end;
  2348. var
  2349. P: PTabItem;
  2350. I: integer;
  2351. begin
  2352. D.X := Bounds.B.X - Bounds.A.X - Size.X;
  2353. D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
  2354. inherited ChangeBounds(Bounds);
  2355. for I:=0 to TabCount-1 do
  2356. if I<>ActiveDef then
  2357. begin
  2358. P:=AtTab(I)^.Items;
  2359. while P<>nil do
  2360. begin
  2361. if P^.View<>nil then DoCalcChange(P^.View);
  2362. P:=P^.Next;
  2363. end;
  2364. end;
  2365. end;
  2366. procedure TTab.HandleEvent(var Event: TEvent);
  2367. var Index : integer;
  2368. I : integer;
  2369. X : integer;
  2370. Len : byte;
  2371. P : TPoint;
  2372. V : PView;
  2373. CallOrig: boolean;
  2374. LastV : PView;
  2375. FirstV: PView;
  2376. function FirstSelectable: PView;
  2377. var
  2378. FV : PView;
  2379. begin
  2380. FV := First;
  2381. while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
  2382. FV:=FV^.Next;
  2383. if FV<>nil then
  2384. if (FV^.Options and ofSelectable)=0 then FV:=nil;
  2385. FirstSelectable:=FV;
  2386. end;
  2387. function LastSelectable: PView;
  2388. var
  2389. LV : PView;
  2390. begin
  2391. LV := Last;
  2392. while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
  2393. LV:=LV^.Prev;
  2394. if LV<>nil then
  2395. if (LV^.Options and ofSelectable)=0 then LV:=nil;
  2396. LastSelectable:=LV;
  2397. end;
  2398. begin
  2399. if (Event.What and evMouseDown)<>0 then
  2400. begin
  2401. MakeLocal(Event.Where,P);
  2402. if P.Y<3 then
  2403. begin
  2404. Index:=-1; X:=1;
  2405. for i:=0 to DefCount-1 do
  2406. begin
  2407. Len:=CStrLen(AtTab(i)^.Name^);
  2408. if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
  2409. X:=X+Len+3;
  2410. end;
  2411. if Index<>-1 then
  2412. SelectTab(Index);
  2413. end;
  2414. end;
  2415. if Event.What=evKeyDown then
  2416. begin
  2417. Index:=-1;
  2418. case Event.KeyCode of
  2419. kbTab,kbShiftTab :
  2420. if GetState(sfSelected) then
  2421. begin
  2422. if Current<>nil then
  2423. begin
  2424. LastV:=LastSelectable; FirstV:=FirstSelectable;
  2425. if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
  2426. begin
  2427. if Owner<>nil then Owner^.SelectNext(true);
  2428. end else
  2429. if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
  2430. begin
  2431. Lock;
  2432. if Owner<>nil then Owner^.SelectNext(false);
  2433. UnLock;
  2434. end else
  2435. SelectNext(Event.KeyCode=kbShiftTab);
  2436. ClearEvent(Event);
  2437. end;
  2438. end;
  2439. else
  2440. for I:=0 to DefCount-1 do
  2441. begin
  2442. if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
  2443. then begin
  2444. Index:=I;
  2445. ClearEvent(Event);
  2446. Break;
  2447. end;
  2448. end;
  2449. end;
  2450. if Index<>-1 then
  2451. begin
  2452. Select;
  2453. SelectTab(Index);
  2454. V:=AtTab(ActiveDef)^.DefItem;
  2455. if V<>nil then V^.Focus;
  2456. end;
  2457. end;
  2458. CallOrig:=true;
  2459. if Event.What=evKeyDown then
  2460. begin
  2461. if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
  2462. then
  2463. else CallOrig:=false;
  2464. end;
  2465. if CallOrig then inherited HandleEvent(Event);
  2466. end;
  2467. function TTab.GetPalette: PPalette;
  2468. begin
  2469. GetPalette:=nil;
  2470. end;
  2471. procedure TTab.Draw;
  2472. var B : TDrawBuffer;
  2473. i : integer;
  2474. C1,C2,C3,C : word;
  2475. HeaderLen : integer;
  2476. X,X2 : integer;
  2477. Name : PString;
  2478. ActiveKPos : integer;
  2479. ActiveVPos : integer;
  2480. FC : char;
  2481. ClipR : TRect;
  2482. procedure SWriteBuf(X,Y,W,H: integer; var Buf);
  2483. var i: integer;
  2484. begin
  2485. if Y+H>Size.Y then H:=Size.Y-Y;
  2486. if X+W>Size.X then W:=Size.X-X;
  2487. if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
  2488. else for i:=1 to H do
  2489. Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
  2490. end;
  2491. procedure ClearBuf;
  2492. begin
  2493. MoveChar(B,' ',C1,Size.X);
  2494. end;
  2495. begin
  2496. if InDraw then Exit;
  2497. InDraw:=true;
  2498. { - Start of TGroup.Draw - }
  2499. if Buffer = nil then
  2500. begin
  2501. GetBuffer;
  2502. end;
  2503. { - Start of TGroup.Draw - }
  2504. C1:=GetColor(1); C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256; C3:=GetColor(8)+GetColor({9}8)*256;
  2505. HeaderLen:=0; for i:=0 to DefCount-1 do HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3; Dec(HeaderLen);
  2506. if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
  2507. { --- 1. sor --- }
  2508. ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
  2509. X:=1;
  2510. for i:=0 to DefCount-1 do
  2511. begin
  2512. Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
  2513. if i=ActiveDef
  2514. then begin
  2515. ActiveKPos:=X-1;
  2516. ActiveVPos:=X+X2+2;
  2517. if GetState(sfFocused) then C:=C3 else C:=C2;
  2518. end
  2519. else C:=C2;
  2520. MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
  2521. MoveChar(B[X-1],'³',C1,1);
  2522. end;
  2523. SWriteBuf(0,1,Size.X,1,B);
  2524. { --- 0. sor --- }
  2525. ClearBuf; MoveChar(B[0],'Ú',C1,1);
  2526. X:=1;
  2527. for i:=0 to DefCount-1 do
  2528. begin
  2529. if I<ActiveDef then FC:='Ú'
  2530. else FC:='¿';
  2531. X2:=CStrLen(AtTab(i)^.Name^)+2;
  2532. MoveChar(B[X+X2],{'Â'}FC,C1,1);
  2533. if i=DefCount-1 then X2:=X2+1;
  2534. if X2>0 then
  2535. MoveChar(B[X],'Ä',C1,X2);
  2536. X:=X+X2+1;
  2537. end;
  2538. MoveChar(B[HeaderLen+1],'¿',C1,1);
  2539. MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
  2540. SWriteBuf(0,0,Size.X,1,B);
  2541. { --- 2. sor --- }
  2542. MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
  2543. MoveChar(B[Size.X-1],'¿',C1,1);
  2544. MoveChar(B[ActiveKPos],'Ù',C1,1);
  2545. if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
  2546. else MoveChar(B[0],{'Ã'}'Ú',C1,1);
  2547. MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
  2548. MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
  2549. SWriteBuf(0,2,Size.X,1,B);
  2550. { --- marad‚k sor --- }
  2551. ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
  2552. SWriteBuf(0,3,Size.X,Size.Y-4,B);
  2553. { --- Size.X . sor --- }
  2554. MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
  2555. SWriteBuf(0,Size.Y-1,Size.X,1,B);
  2556. { - End of TGroup.Draw - }
  2557. if Buffer <> nil then
  2558. begin
  2559. Lock;
  2560. Redraw;
  2561. UnLock;
  2562. end;
  2563. if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
  2564. begin
  2565. GetClipRect(ClipR);
  2566. Redraw;
  2567. GetExtent(ClipR);
  2568. end;
  2569. { - End of TGroup.Draw - }
  2570. InDraw:=false;
  2571. end;
  2572. function TTab.Valid(Command: Word): Boolean;
  2573. var PT : PTabDef;
  2574. PI : PTabItem;
  2575. OK : boolean;
  2576. begin
  2577. OK:=true;
  2578. PT:=TabDefs;
  2579. while (PT<>nil) and (OK=true) do
  2580. begin
  2581. PI:=PT^.Items;
  2582. while (PI<>nil) and (OK=true) do
  2583. begin
  2584. if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
  2585. PI:=PI^.Next;
  2586. end;
  2587. PT:=PT^.Next;
  2588. end;
  2589. Valid:=OK;
  2590. end;
  2591. procedure TTab.SetState(AState: Word; Enable: Boolean);
  2592. begin
  2593. inherited SetState(AState,Enable);
  2594. if (AState and sfFocused)<>0 then DrawView;
  2595. end;
  2596. destructor TTab.Done;
  2597. var P,X: PTabDef;
  2598. procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
  2599. begin
  2600. if P<>nil then Delete(P);
  2601. end;
  2602. begin
  2603. ForEach(@DeleteViews);
  2604. inherited Done;
  2605. P:=TabDefs;
  2606. while P<>nil do
  2607. begin
  2608. X:=P^.Next;
  2609. DisposeTabDef(P);
  2610. P:=X;
  2611. end;
  2612. end;
  2613. constructor TScreenView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  2614. AScreen: PScreen);
  2615. begin
  2616. inherited Init(Bounds,AHScrollBar,AVScrollBar);
  2617. Screen:=AScreen;
  2618. if Screen=nil then
  2619. Fail;
  2620. SetState(sfCursorVis,true);
  2621. Update;
  2622. end;
  2623. procedure TScreenView.Update;
  2624. begin
  2625. SetLimit(UserScreen^.GetWidth,UserScreen^.GetHeight);
  2626. DrawView;
  2627. end;
  2628. procedure TScreenView.HandleEvent(var Event: TEvent);
  2629. begin
  2630. case Event.What of
  2631. evBroadcast :
  2632. case Event.Command of
  2633. cmUpdate : Update;
  2634. end;
  2635. end;
  2636. inherited HandleEvent(Event);
  2637. end;
  2638. procedure TScreenView.Draw;
  2639. var B: TDrawBuffer;
  2640. X,Y: integer;
  2641. Text,Attr: string;
  2642. P: TPoint;
  2643. begin
  2644. Screen^.GetCursorPos(P);
  2645. for Y:=Delta.Y to Delta.Y+Size.Y-1 do
  2646. begin
  2647. if Y<Screen^.GetHeight then
  2648. Screen^.GetLine(Y,Text,Attr)
  2649. else
  2650. begin Text:=''; Attr:=''; end;
  2651. Text:=copy(Text,Delta.X+1,255); Attr:=copy(Attr,Delta.X+1,255);
  2652. MoveChar(B,' ',0,Size.X);
  2653. for X:=1 to length(Text) do
  2654. MoveChar(B[X-1],Text[X],ord(Attr[X]),1);
  2655. WriteLine(0,Y-Delta.Y,Size.X,1,B);
  2656. end;
  2657. SetCursor(P.X-Delta.X,P.Y-Delta.Y);
  2658. end;
  2659. constructor TScreenWindow.Init(AScreen: PScreen; ANumber: integer);
  2660. var R: TRect;
  2661. VSB,HSB: PScrollBar;
  2662. begin
  2663. Desktop^.GetExtent(R);
  2664. inherited Init(R, 'User screen', ANumber);
  2665. Options:=Options or ofTileAble;
  2666. GetExtent(R); R.Grow(-1,-1); R.Move(1,0); R.A.X:=R.B.X-1;
  2667. New(VSB, Init(R)); VSB^.Options:=VSB^.Options or ofPostProcess;
  2668. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2669. GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.A.Y:=R.B.Y-1;
  2670. New(HSB, Init(R)); HSB^.Options:=HSB^.Options or ofPostProcess;
  2671. HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  2672. GetExtent(R); R.Grow(-1,-1);
  2673. New(ScreenView, Init(R, HSB, VSB, AScreen));
  2674. ScreenView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2675. Insert(ScreenView);
  2676. UserScreenWindow:=@Self;
  2677. end;
  2678. destructor TScreenWindow.Done;
  2679. begin
  2680. inherited Done;
  2681. UserScreenWindow:=nil;
  2682. end;
  2683. const InTranslate : boolean = false;
  2684. procedure TranslateMouseClick(View: PView; var Event: TEvent);
  2685. procedure TranslateAction(Action: integer);
  2686. var E: TEvent;
  2687. begin
  2688. if Action<>acNone then
  2689. begin
  2690. E:=Event;
  2691. E.What:=evMouseDown; E.Buttons:=mbLeftButton;
  2692. View^.HandleEvent(E);
  2693. Event.What:=evCommand;
  2694. Event.Command:=ActionCommands[Action];
  2695. end;
  2696. end;
  2697. begin
  2698. if InTranslate then Exit;
  2699. InTranslate:=true;
  2700. case Event.What of
  2701. evMouseDown :
  2702. if (GetShiftState and kbAlt)<>0 then
  2703. TranslateAction(AltMouseAction) else
  2704. if (GetShiftState and kbCtrl)<>0 then
  2705. TranslateAction(CtrlMouseAction);
  2706. end;
  2707. InTranslate:=false;
  2708. end;
  2709. function GetNextEditorBounds(var Bounds: TRect): boolean;
  2710. var P: PView;
  2711. begin
  2712. P:=Desktop^.First;
  2713. while P<>nil do
  2714. begin
  2715. if P^.HelpCtx=hcSourceWindow then Break;
  2716. P:=P^.NextView;
  2717. end;
  2718. if P=nil then Desktop^.GetExtent(Bounds) else
  2719. begin
  2720. P^.GetBounds(Bounds);
  2721. Inc(Bounds.A.X); Inc(Bounds.A.Y);
  2722. end;
  2723. GetNextEditorBounds:=P<>nil;
  2724. end;
  2725. function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: integer): PSourceWindow;
  2726. var R: TRect;
  2727. W: PSourceWindow;
  2728. begin
  2729. if Assigned(Bounds) then R.Copy(Bounds^) else
  2730. GetNextEditorBounds(R);
  2731. PushStatus('Opening source file... ('+SmartPath(FileName)+')');
  2732. New(W, Init(R, FileName));
  2733. if W<>nil then
  2734. begin
  2735. if (CurX<>0) or (CurY<>0) then
  2736. with W^.Editor^ do
  2737. begin
  2738. SetCurPtr(CurX,CurY);
  2739. TrackCursor(true);
  2740. end;
  2741. W^.HelpCtx:=hcSourceWindow;
  2742. Desktop^.Insert(W);
  2743. If assigned(BreakpointCollection) then
  2744. BreakPointCollection^.ShowBreakpoints(W);
  2745. Message(Application,evBroadcast,cmUpdate,nil);
  2746. end;
  2747. PopStatus;
  2748. OpenEditorWindow:=W;
  2749. end;
  2750. function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: integer): PSourceWindow;
  2751. var D : DirStr;
  2752. N : NameStr;
  2753. E : ExtStr;
  2754. DrStr : String;
  2755. function CheckDir(NewDir: DirStr; NewName: NameStr; NewExt: ExtStr): boolean;
  2756. var OK: boolean;
  2757. begin
  2758. NewDir:=CompleteDir(NewDir);
  2759. OK:=ExistsFile(NewDir+NewName+NewExt);
  2760. if OK then begin D:=NewDir; N:=NewName; E:=NewExt; end;
  2761. CheckDir:=OK;
  2762. end;
  2763. function CheckExt(NewExt: ExtStr): boolean;
  2764. var OK: boolean;
  2765. begin
  2766. OK:=false;
  2767. if D<>'' then OK:=CheckDir(D,N,NewExt) else
  2768. if CheckDir('.'+DirSep,N,NewExt) then OK:=true;
  2769. CheckExt:=OK;
  2770. end;
  2771. function TryToOpen(const DD : dirstr): PSourceWindow;
  2772. var Found: boolean;
  2773. W : PSourceWindow;
  2774. begin
  2775. D:=CompleteDir(DD);
  2776. Found:=true;
  2777. if E<>'' then Found:=CheckExt(E) else
  2778. if CheckExt('.pp') then Found:=true else
  2779. if CheckExt('.pas') then Found:=true else
  2780. if CheckExt('.inc')=false then
  2781. Found:=false;
  2782. if Found=false then W:=nil else
  2783. begin
  2784. FileName:=FExpand(D+N+E);
  2785. W:=OpenEditorWindow(Bounds,FileName,CurX,CurY);
  2786. end;
  2787. TryToOpen:=W;
  2788. end;
  2789. function SearchOnDesktop: PSourceWindow;
  2790. var W: PWindow;
  2791. I: integer;
  2792. Found: boolean;
  2793. SName : string;
  2794. begin
  2795. for I:=1 to 100 do
  2796. begin
  2797. W:=SearchWindowWithNo(I);
  2798. if (W<>nil) and (W^.HelpCtx=hcSourceWindow) then
  2799. begin
  2800. if (D='') then
  2801. SName:=NameAndExtOf(PSourceWindow(W)^.Editor^.FileName)
  2802. else
  2803. SName:=PSourceWindow(W)^.Editor^.FileName;
  2804. SName:=UpcaseStr(SName);
  2805. if E<>'' then
  2806. begin
  2807. if D<>'' then
  2808. Found:=SName=UpcaseStr(D+N+E)
  2809. else
  2810. Found:=SName=UpcaseStr(N+E);
  2811. end
  2812. else
  2813. begin
  2814. Found:=SName=UpcaseStr(N+'.pp');
  2815. if Found=false then
  2816. Found:=SName=UpcaseStr(N+'.pas');
  2817. end;
  2818. if Found then Break;
  2819. end;
  2820. end;
  2821. if Found=false then W:=nil;
  2822. SearchOnDesktop:=PSourceWindow(W);
  2823. end;
  2824. var W: PSourceWindow;
  2825. begin
  2826. FSplit(FileName,D,N,E);
  2827. W:=SearchOnDesktop;
  2828. if W<>nil then
  2829. begin
  2830. NewEditorOpened:=false;
  2831. if assigned(Bounds) then
  2832. W^.ChangeBounds(Bounds^);
  2833. W^.Editor^.SetCurPtr(CurX,CurY);
  2834. end
  2835. else
  2836. begin
  2837. DrStr:=GetSourceDirectories;
  2838. While pos(';',DrStr)>0 do
  2839. Begin
  2840. W:=TryToOpen(Copy(DrStr,1,pos(';',DrStr)-1));
  2841. if assigned(W) then
  2842. break;
  2843. DrStr:=Copy(DrStr,pos(';',DrStr)+1,255);
  2844. End;
  2845. if not assigned(W) then
  2846. W:=TryToOpen(DrStr);
  2847. NewEditorOpened:=W<>nil;
  2848. if assigned(W) then
  2849. W^.Editor^.SetCurPtr(CurX,CurY);
  2850. end;
  2851. TryToOpenFile:=W;
  2852. end;
  2853. END.
  2854. {
  2855. $Log$
  2856. Revision 1.10 1999-02-10 09:42:52 pierre
  2857. + DoneReservedWords to avoid memory leaks
  2858. * TMessageItem Module field was not disposed
  2859. Revision 1.9 1999/02/05 12:12:02 pierre
  2860. + SourceDir that stores directories for sources that the
  2861. compiler should not know about
  2862. Automatically asked for addition when a new file that
  2863. needed filedialog to be found is in an unknown directory
  2864. Stored and retrieved from INIFile
  2865. + Breakpoints conditions added to INIFile
  2866. * Breakpoints insterted and removed at debin and end of debug session
  2867. Revision 1.8 1999/02/04 17:45:23 pierre
  2868. + BrowserAtCursor started
  2869. * bug in TryToOpenFile removed
  2870. Revision 1.7 1999/02/04 13:32:11 pierre
  2871. * Several things added (I cannot commit them independently !)
  2872. + added TBreakpoint and TBreakpointCollection
  2873. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  2874. + Breakpoint list in INIFile
  2875. * Select items now also depend of SwitchMode
  2876. * Reading of option '-g' was not possible !
  2877. + added search for -Fu args pathes in TryToOpen
  2878. + added code for automatic opening of FileDialog
  2879. if source not found
  2880. Revision 1.6 1999/01/21 11:54:27 peter
  2881. + tools menu
  2882. + speedsearch in symbolbrowser
  2883. * working run command
  2884. Revision 1.5 1999/01/14 21:42:25 peter
  2885. * source tracking from Gabor
  2886. Revision 1.4 1999/01/12 14:29:42 peter
  2887. + Implemented still missing 'switch' entries in Options menu
  2888. + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
  2889. ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
  2890. ASCII chars and inserted directly in the text.
  2891. + Added symbol browser
  2892. * splitted fp.pas to fpide.pas
  2893. Revision 1.3 1999/01/04 11:49:53 peter
  2894. * 'Use tab characters' now works correctly
  2895. + Syntax highlight now acts on File|Save As...
  2896. + Added a new class to syntax highlight: 'hex numbers'.
  2897. * There was something very wrong with the palette managment. Now fixed.
  2898. + Added output directory (-FE<xxx>) support to 'Directories' dialog...
  2899. * Fixed some possible bugs in Running/Compiling, and the compilation/run
  2900. process revised
  2901. Revision 1.2 1998/12/28 15:47:54 peter
  2902. + Added user screen support, display & window
  2903. + Implemented Editor,Mouse Options dialog
  2904. + Added location of .INI and .CFG file
  2905. + Option (INI) file managment implemented (see bottom of Options Menu)
  2906. + Switches updated
  2907. + Run program
  2908. Revision 1.4 1998/12/22 10:39:53 peter
  2909. + options are now written/read
  2910. + find and replace routines
  2911. }