wviews.pas 68 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$I globdir.inc}
  12. unit WViews;
  13. interface
  14. uses Objects,Drivers,Views,Menus,Dialogs;
  15. const
  16. evIdle = $8000;
  17. cmLocalMenu = 54100;
  18. cmUpdate = 54101;
  19. cmListFocusChanged = 54102;
  20. mfUserBtn1 = $00010000;
  21. mfUserBtn2 = $00020000;
  22. mfUserBtn3 = $00040000;
  23. mfUserBtn4 = $00080000;
  24. mfCantCancel = $00100000;
  25. cmUserBtn1 = $fee0;
  26. cmUserBtn2 = $fee1;
  27. cmUserBtn3 = $fee2;
  28. cmUserBtn4 = $fee3;
  29. CPlainCluster = #7#8#9#9;
  30. type
  31. longstring = {$ifdef TP}string{$else}ansistring{$endif};
  32. PCenterDialog = ^TCenterDialog;
  33. TCenterDialog = object(TDialog)
  34. constructor Init(var Bounds: TRect; ATitle: TTitleStr);
  35. end;
  36. PAdvancedMenuBox = ^TAdvancedMenuBox;
  37. TAdvancedMenuBox = object(TMenuBox)
  38. function NewSubView(var Bounds: TRect; AMenu: PMenu;
  39. AParentMenu: PMenuView): PMenuView; virtual;
  40. function Execute: Word; virtual;
  41. end;
  42. PAdvancedMenuPopUp = ^TAdvancedMenuPopup;
  43. TAdvancedMenuPopUp = object(TMenuPopup)
  44. function NewSubView(var Bounds: TRect; AMenu: PMenu;
  45. AParentMenu: PMenuView): PMenuView; virtual;
  46. function Execute: Word; virtual;
  47. end;
  48. PAdvancedMenuBar = ^TAdvancedMenuBar;
  49. TAdvancedMenuBar = object(TMenuBar)
  50. constructor Init(var Bounds: TRect; AMenu: PMenu);
  51. function NewSubView(var Bounds: TRect; AMenu: PMenu;
  52. AParentMenu: PMenuView): PMenuView; virtual;
  53. procedure Update; virtual;
  54. function GetMenuItem(cm : word) : PMenuItem;
  55. procedure HandleEvent(var Event: TEvent); virtual;
  56. function Execute: Word; virtual;
  57. end;
  58. PAdvancedStaticText = ^TAdvancedStaticText;
  59. TAdvancedStaticText = object(TStaticText)
  60. procedure SetText(S: string); virtual;
  61. end;
  62. PAdvancedListBox = ^TAdvancedListBox;
  63. TAdvancedListBox = object(TListBox)
  64. Default: boolean;
  65. procedure FocusItem(Item: sw_integer); virtual;
  66. procedure HandleEvent(var Event: TEvent); virtual;
  67. constructor Load(var S: TStream);
  68. procedure Store(var S: TStream);
  69. end;
  70. PNoUpdateButton = ^TNoUpdateButton;
  71. TNoUpdateButton = object(TButton)
  72. procedure HandleEvent(var Event: TEvent); virtual;
  73. end;
  74. TLocalMenuListBox = object(TAdvancedListBox)
  75. procedure HandleEvent(var Event: TEvent); virtual;
  76. procedure LocalMenu(P: TPoint); virtual;
  77. function GetLocalMenu: PMenu; virtual;
  78. function GetCommandTarget: PView; virtual;
  79. private
  80. LastLocalCmd: word;
  81. end;
  82. PColorStaticText = ^TColorStaticText;
  83. TColorStaticText = object(TAdvancedStaticText)
  84. Color: word;
  85. DontWrap: boolean;
  86. Delta: TPoint;
  87. constructor Init(var Bounds: TRect; AText: String; AColor: word; AWrap: boolean);
  88. function GetPalette: PPalette; virtual;
  89. procedure Draw; virtual;
  90. constructor Load(var S: TStream);
  91. procedure Store(var S: TStream);
  92. end;
  93. PHSListBox = ^THSListBox;
  94. THSListBox = object(TLocalMenuListBox)
  95. constructor Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
  96. function SaveToFile(const AFileName: string): boolean; virtual;
  97. function SaveAs: Boolean; virtual;
  98. end;
  99. PDlgWindow = ^TDlgWindow;
  100. TDlgWindow = object(TDialog)
  101. constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer);
  102. end;
  103. PAdvancedStatusLine = ^TAdvancedStatusLine;
  104. TAdvancedStatusLine = object(TStatusLine)
  105. StatusText: PString;
  106. function GetStatusText: string; virtual;
  107. procedure SetStatusText(const S: string); virtual;
  108. procedure ClearStatusText; virtual;
  109. procedure Draw; virtual;
  110. end;
  111. PDropDownListBox = ^TDropDownListBox;
  112. PDDHelperLB = ^TDDHelperLB;
  113. TDDHelperLB = object(TLocalMenuListBox)
  114. constructor Init(ALink: PDropDownListBox; var Bounds: TRect; ANumCols: Word; AScrollBar: PScrollBar);
  115. procedure HandleEvent(var Event: TEvent); virtual;
  116. procedure SetState(AState: Word; Enable: Boolean); virtual;
  117. procedure SelectItem(Item: Sw_Integer); virtual;
  118. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  119. function GetLocalMenu: PMenu; virtual;
  120. function GetCommandTarget: PView; virtual;
  121. private
  122. Link : PDropDownListBox;
  123. LastTT: longint;
  124. InClose: boolean;
  125. end;
  126. TDropDownListBox = object(TView)
  127. Text: string;
  128. Focused: sw_integer;
  129. List: PCollection;
  130. constructor Init(var Bounds: TRect; ADropLineCount: Sw_integer; AList: PCollection);
  131. procedure HandleEvent(var Event: TEvent); virtual;
  132. function GetText(Item: pointer; MaxLen: sw_integer): string; virtual;
  133. procedure NewList(AList: PCollection); virtual;
  134. procedure CreateListBox(var R: TRect);
  135. procedure DropList(Drop: boolean); virtual;
  136. function GetItemCount: sw_integer; virtual;
  137. procedure FocusItem(Item: sw_integer); virtual;
  138. function LBGetLocalMenu: PMenu; virtual;
  139. function LBGetCommandTarget: PView; virtual;
  140. procedure SetState(AState: Word; Enable: Boolean); virtual;
  141. procedure Draw; virtual;
  142. function GetPalette: PPalette; virtual;
  143. destructor Done; virtual;
  144. private
  145. DropLineCount: Sw_integer;
  146. ListDropped : boolean;
  147. ListBox : PDDHelperLB;
  148. SB : PScrollBar;
  149. end;
  150. PGroupView = ^TGroupView;
  151. TGroupView = object(TLabel)
  152. constructor Init(var Bounds: TRect; AText: String; ALink: PView);
  153. procedure Draw; virtual;
  154. end;
  155. PPlainCheckBoxes = ^TPlainCheckBoxes;
  156. TPlainCheckBoxes = object(TCheckBoxes)
  157. function GetPalette: PPalette; virtual;
  158. end;
  159. PPlainRadioButtons = ^TPlainRadioButtons;
  160. TPlainRadioButtons = object(TRadioButtons)
  161. function GetPalette: PPalette; virtual;
  162. end;
  163. PPanel = ^TPanel;
  164. TPanel = object(TGroup)
  165. constructor Init(var Bounds: TRect);
  166. end;
  167. PAdvMessageBox = ^TAdvMessageBox;
  168. TAdvMessageBox = object(TDialog)
  169. CanCancel: boolean;
  170. procedure HandleEvent(var Event: TEvent); virtual;
  171. end;
  172. procedure InsertOK(ADialog: PDialog);
  173. procedure InsertButtons(ADialog: PDialog);
  174. procedure Bug(const S: string; Params: pointer);
  175. procedure ErrorBox(const S: string; Params: pointer);
  176. procedure WarningBox(const S: string; Params: pointer);
  177. procedure InformationBox(const S: string; Params: pointer);
  178. function ConfirmBox(const S: string; Params: pointer; CanCancel: boolean): word;
  179. function ChoiceBox(const S: string; Params: pointer; Buttons: array of longstring; CanCancel: boolean): word;
  180. procedure ShowMessage(Msg: string);
  181. procedure HideMessage;
  182. function SearchMenuItem(Menu: PMenu; Cmd: word): PMenuItem;
  183. procedure SetMenuItemParam(Menu: PMenuItem; Param: string);
  184. function IsSubMenu(P: PMenuItem): boolean;
  185. function IsSeparator(P: PMenuItem): boolean;
  186. function UpdateMenu(M: PMenu): boolean;
  187. function SearchSubMenu(M: PMenu; Index: Sw_integer): PMenuItem;
  188. procedure AppendMenuItem(M: PMenu; I: PMenuItem);
  189. procedure RemoveMenuItem(Menu: PMenu; I: PMenuItem);
  190. function GetMenuItemBefore(Menu:PMenu; BeforeOf: PMenuItem): PMenuItem;
  191. procedure NotImplemented;
  192. function ColorIndex(Color: byte): word;
  193. var FormatParams : array[1..20] of longint;
  194. FormatParamCount : integer;
  195. FormatParamStrs : array[1..10] of string;
  196. FormatParamStrCount: integer;
  197. procedure ClearFormatParams;
  198. procedure AddFormatParam(P: pointer);
  199. procedure AddFormatParamInt(L: longint);
  200. procedure AddFormatParamChar(C: char);
  201. procedure AddFormatParamStr(const S: string);
  202. function FormatStrF(const Format: string; var Params): string;
  203. function FormatStrStr(const Format, Param: string): string;
  204. function FormatStrStr2(const Format, Param1,Param2: string): string;
  205. function FormatStrStr3(const Format, Param1,Param2,Param3: string): string;
  206. function FormatStrInt(const Format: string; L: longint): string;
  207. const UserButtonName : array[1..4] of string[40] = ('User~1~','User~2~','User~3~','User~4~');
  208. procedure InitAdvMsgBox;
  209. function AdvMessageBox(const Msg: String; Params: Pointer; AOptions: longint): Word;
  210. function AdvMessageBoxRect(var R: TRect; const Msg: String; Params: Pointer; AOptions: longint): Word;
  211. procedure DoneAdvMsgBox;
  212. procedure RegisterWViews;
  213. implementation
  214. uses Mouse,
  215. Resource,
  216. {$ifdef FVISION}
  217. FVConsts,
  218. {$else}
  219. Commands,
  220. {$endif}
  221. App,MsgBox,StdDlg,
  222. WConsts,WUtils;
  223. {$ifndef NOOBJREG}
  224. const
  225. RAdvancedListBox: TStreamRec = (
  226. ObjType: 1120;
  227. VmtLink: Ofs(TypeOf(TAdvancedListBox)^);
  228. Load: @TAdvancedListBox.Load;
  229. Store: @TAdvancedListBox.Store
  230. );
  231. RColorStaticText: TStreamRec = (
  232. ObjType: 1121;
  233. VmtLink: Ofs(TypeOf(TColorStaticText)^);
  234. Load: @TColorStaticText.Load;
  235. Store: @TColorStaticText.Store
  236. );
  237. RHSListBox: TStreamRec = (
  238. ObjType: 1122;
  239. VmtLink: Ofs(TypeOf(THSListBox)^);
  240. Load: @THSListBox.Load;
  241. Store: @THSListBox.Store
  242. );
  243. RDlgWindow: TStreamRec = (
  244. ObjType: 1123;
  245. VmtLink: Ofs(TypeOf(TDlgWindow)^);
  246. Load: @TDlgWindow.Load;
  247. Store: @TDlgWindow.Store
  248. );
  249. {$endif}
  250. const
  251. MessageDialog : PCenterDialog = nil;
  252. UserButtonCmd : array[Low(UserButtonName)..High(UserButtonName)] of word = (cmUserBtn1,cmUserBtn2,cmUserBtn3,cmUserBtn4);
  253. function ColorIndex(Color: byte): word;
  254. begin
  255. ColorIndex:=(Color and $0f)+(Color and $0f) shl 4;
  256. end;
  257. {*****************************************************************************
  258. TCenterDialog
  259. *****************************************************************************}
  260. constructor TCenterDialog.Init(var Bounds: TRect; ATitle: TTitleStr);
  261. begin
  262. inherited Init(Bounds,ATitle);
  263. Options:=Options or ofCentered;
  264. end;
  265. function TAdvancedMenuBox.NewSubView(var Bounds: TRect; AMenu: PMenu;
  266. AParentMenu: PMenuView): PMenuView;
  267. begin
  268. NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
  269. end;
  270. function TAdvancedMenuBox.Execute: word;
  271. type
  272. MenuAction = (DoNothing, DoSelect, DoReturn);
  273. var
  274. AutoSelect: Boolean;
  275. Action: MenuAction;
  276. Ch: Char;
  277. Result: Word;
  278. ItemShown, P: PMenuItem;
  279. Target: PMenuView;
  280. R: TRect;
  281. E: TEvent;
  282. MouseActive: Boolean;
  283. function IsDisabled(Item: PMenuItem): boolean;
  284. var Found: boolean;
  285. begin
  286. Found:=Item^.Disabled or IsSeparator(Item);
  287. if (Found=false) and (IsSubMenu(Item)=false) then
  288. Found:=CommandEnabled(Item^.Command)=false;
  289. IsDisabled:=Found;
  290. end;
  291. procedure TrackMouse;
  292. var
  293. Mouse: TPoint;
  294. R: TRect;
  295. begin
  296. MakeLocal(E.Where, Mouse);
  297. Current := Menu^.Items;
  298. while Current <> nil do
  299. begin
  300. GetItemRect(Current, R);
  301. if R.Contains(Mouse) then
  302. begin
  303. MouseActive := True;
  304. Break;
  305. end;
  306. Current := Current^.Next;
  307. end;
  308. if (Current<>nil) and IsDisabled(Current) then
  309. begin
  310. Current:=nil;
  311. MouseActive:=false;
  312. end;
  313. end;
  314. procedure TrackKey(FindNext: Boolean);
  315. procedure NextItem;
  316. begin
  317. Current := Current^.Next;
  318. if Current = nil then Current := Menu^.Items;
  319. end;
  320. procedure PrevItem;
  321. var
  322. P: PMenuItem;
  323. begin
  324. P := Current;
  325. if P = Menu^.Items then P := nil;
  326. repeat NextItem until Current^.Next = P;
  327. end;
  328. begin
  329. if Current <> nil then
  330. repeat
  331. if FindNext then NextItem else PrevItem;
  332. until (Current^.Name <> nil) and (IsDisabled(Current)=false);
  333. end;
  334. function MouseInOwner: Boolean;
  335. var
  336. Mouse: TPoint;
  337. R: TRect;
  338. begin
  339. MouseInOwner := False;
  340. if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
  341. begin
  342. ParentMenu^.MakeLocal(E.Where, Mouse);
  343. ParentMenu^.GetItemRect(ParentMenu^.Current, R);
  344. MouseInOwner := R.Contains(Mouse);
  345. end;
  346. end;
  347. function MouseInMenus: Boolean;
  348. var
  349. P: PMenuView;
  350. begin
  351. P := ParentMenu;
  352. while (P <> nil) and (P^.MouseInView(E.Where)=false) do
  353. P := P^.ParentMenu;
  354. MouseInMenus := P <> nil;
  355. end;
  356. function TopMenu: PMenuView;
  357. var
  358. P: PMenuView;
  359. begin
  360. P := @Self;
  361. while P^.ParentMenu <> nil do P := P^.ParentMenu;
  362. TopMenu := P;
  363. end;
  364. begin
  365. AutoSelect := False; E.What:=evNothing;
  366. Result := 0;
  367. ItemShown := nil;
  368. Current := Menu^.Default;
  369. MouseActive := False;
  370. if UpdateMenu(Menu) then
  371. begin
  372. if Current<>nil then
  373. if Current^.Disabled then
  374. TrackKey(true);
  375. repeat
  376. Action := DoNothing;
  377. GetEvent(E);
  378. case E.What of
  379. evMouseDown:
  380. if MouseInView(E.Where) or MouseInOwner then
  381. begin
  382. TrackMouse;
  383. if Size.Y = 1 then AutoSelect := True;
  384. end else Action := DoReturn;
  385. evMouseUp:
  386. begin
  387. TrackMouse;
  388. if MouseInOwner then
  389. Current := Menu^.Default
  390. else
  391. if (Current <> nil) and (Current^.Name <> nil) then
  392. Action := DoSelect
  393. else
  394. if MouseActive or MouseInView(E.Where) then Action := DoReturn
  395. else
  396. begin
  397. Current := Menu^.Default;
  398. if Current = nil then Current := Menu^.Items;
  399. Action := DoNothing;
  400. end;
  401. end;
  402. evMouseMove:
  403. if E.Buttons <> 0 then
  404. begin
  405. TrackMouse;
  406. if not (MouseInView(E.Where) or MouseInOwner) and
  407. MouseInMenus then Action := DoReturn;
  408. end;
  409. evKeyDown:
  410. case CtrlToArrow(E.KeyCode) of
  411. kbUp, kbDown:
  412. if Size.Y <> 1 then
  413. TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
  414. if E.KeyCode = kbDown then AutoSelect := True;
  415. kbLeft, kbRight:
  416. if ParentMenu = nil then
  417. TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
  418. Action := DoReturn;
  419. kbHome, kbEnd:
  420. if Size.Y <> 1 then
  421. begin
  422. Current := Menu^.Items;
  423. if E.KeyCode = kbEnd then TrackKey(False);
  424. end;
  425. kbEnter:
  426. begin
  427. if Size.Y = 1 then AutoSelect := True;
  428. Action := DoSelect;
  429. end;
  430. kbEsc:
  431. begin
  432. Action := DoReturn;
  433. if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
  434. ClearEvent(E);
  435. end;
  436. else
  437. Target := @Self;
  438. Ch := GetAltChar(E.KeyCode);
  439. if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
  440. P := Target^.FindItem(Ch);
  441. if P = nil then
  442. begin
  443. P := TopMenu^.HotKey(E.KeyCode);
  444. if (P <> nil) and CommandEnabled(P^.Command) then
  445. begin
  446. Result := P^.Command;
  447. Action := DoReturn;
  448. end
  449. end else
  450. if Target = @Self then
  451. begin
  452. if Size.Y = 1 then AutoSelect := True;
  453. Action := DoSelect;
  454. Current := P;
  455. end else
  456. if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
  457. Action := DoReturn;
  458. end;
  459. evCommand:
  460. if E.Command = cmMenu then
  461. begin
  462. AutoSelect := False;
  463. if ParentMenu <> nil then Action := DoReturn;
  464. end else Action := DoReturn;
  465. end;
  466. if ItemShown <> Current then
  467. begin
  468. ItemShown := Current;
  469. DrawView;
  470. end;
  471. if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
  472. if Current <> nil then with Current^ do if Name <> nil then
  473. if Command = 0 then
  474. begin
  475. if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
  476. GetItemRect(Current, R);
  477. R.A.X := R.A.X + Origin.X;
  478. R.A.Y := R.B.Y + Origin.Y;
  479. R.B := Owner^.Size;
  480. if Size.Y = 1 then Dec(R.A.X);
  481. Target := TopMenu^.NewSubView(R, SubMenu, @Self);
  482. Result := Owner^.ExecView(Target);
  483. Dispose(Target, Done);
  484. end else if Action = DoSelect then Result := Command;
  485. if (Result <> 0) and CommandEnabled(Result) then
  486. begin
  487. Action := DoReturn;
  488. ClearEvent(E);
  489. end
  490. else
  491. Result := 0;
  492. until Action = DoReturn;
  493. end;
  494. if E.What <> evNothing then
  495. if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
  496. if Current <> nil then
  497. begin
  498. Menu^.Default := Current;
  499. Current := nil;
  500. DrawView;
  501. end;
  502. Execute := Result;
  503. end;
  504. function TAdvancedMenuPopup.NewSubView(var Bounds: TRect; AMenu: PMenu;
  505. AParentMenu: PMenuView): PMenuView;
  506. begin
  507. NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
  508. end;
  509. function TAdvancedMenuPopup.Execute: word;
  510. type
  511. MenuAction = (DoNothing, DoSelect, DoReturn);
  512. var
  513. AutoSelect: Boolean;
  514. Action: MenuAction;
  515. Ch: Char;
  516. Result: Word;
  517. ItemShown, P: PMenuItem;
  518. Target: PMenuView;
  519. R: TRect;
  520. E: TEvent;
  521. MouseActive: Boolean;
  522. function IsDisabled(Item: PMenuItem): boolean;
  523. var Found: boolean;
  524. begin
  525. Found:=Item^.Disabled or IsSeparator(Item);
  526. if (Found=false) and (IsSubMenu(Item)=false) then
  527. Found:=CommandEnabled(Item^.Command)=false;
  528. IsDisabled:=Found;
  529. end;
  530. procedure TrackMouse;
  531. var
  532. Mouse: TPoint;
  533. R: TRect;
  534. { OldC: PMenuItem;}
  535. begin
  536. MakeLocal(E.Where, Mouse);
  537. { OldC:=Current;}
  538. Current := Menu^.Items;
  539. while Current <> nil do
  540. begin
  541. GetItemRect(Current, R);
  542. if R.Contains(Mouse) then
  543. begin
  544. MouseActive := True;
  545. Break;
  546. end;
  547. Current := Current^.Next;
  548. end;
  549. if (Current<>nil) and IsDisabled(Current) then
  550. begin
  551. Current:={OldC}nil;
  552. MouseActive:=false;
  553. end;
  554. end;
  555. procedure TrackKey(FindNext: Boolean);
  556. procedure NextItem;
  557. begin
  558. Current := Current^.Next;
  559. if Current = nil then Current := Menu^.Items;
  560. end;
  561. procedure PrevItem;
  562. var
  563. P: PMenuItem;
  564. begin
  565. P := Current;
  566. if P = Menu^.Items then P := nil;
  567. repeat NextItem until Current^.Next = P;
  568. end;
  569. begin
  570. if Current <> nil then
  571. repeat
  572. if FindNext then NextItem else PrevItem;
  573. until (Current^.Name <> nil) and (IsDisabled(Current)=false);
  574. end;
  575. function MouseInOwner: Boolean;
  576. var
  577. Mouse: TPoint;
  578. R: TRect;
  579. begin
  580. MouseInOwner := False;
  581. if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
  582. begin
  583. ParentMenu^.MakeLocal(E.Where, Mouse);
  584. ParentMenu^.GetItemRect(ParentMenu^.Current, R);
  585. MouseInOwner := R.Contains(Mouse);
  586. end;
  587. end;
  588. function MouseInMenus: Boolean;
  589. var
  590. P: PMenuView;
  591. begin
  592. P := ParentMenu;
  593. while (P <> nil) and (P^.MouseInView(E.Where)=false) do
  594. P := P^.ParentMenu;
  595. MouseInMenus := P <> nil;
  596. end;
  597. function TopMenu: PMenuView;
  598. var
  599. P: PMenuView;
  600. begin
  601. P := @Self;
  602. while P^.ParentMenu <> nil do P := P^.ParentMenu;
  603. TopMenu := P;
  604. end;
  605. begin
  606. AutoSelect := False; E.What:=evNothing;
  607. Result := 0;
  608. ItemShown := nil;
  609. Current := Menu^.Default;
  610. MouseActive := False;
  611. if UpdateMenu(Menu) then
  612. begin
  613. if Current<>nil then
  614. if Current^.Disabled then
  615. TrackKey(true);
  616. repeat
  617. Action := DoNothing;
  618. GetEvent(E);
  619. case E.What of
  620. evMouseDown:
  621. if MouseInView(E.Where) or MouseInOwner then
  622. begin
  623. TrackMouse;
  624. if Size.Y = 1 then AutoSelect := True;
  625. end else Action := DoReturn;
  626. evMouseUp:
  627. begin
  628. TrackMouse;
  629. if MouseInOwner then
  630. Current := Menu^.Default
  631. else
  632. if (Current <> nil) and (Current^.Name <> nil) then
  633. Action := DoSelect
  634. else
  635. if MouseActive or MouseInView(E.Where) then Action := DoReturn
  636. else
  637. begin
  638. Current := Menu^.Default;
  639. if Current = nil then Current := Menu^.Items;
  640. Action := DoNothing;
  641. end;
  642. end;
  643. evMouseMove:
  644. if E.Buttons <> 0 then
  645. begin
  646. TrackMouse;
  647. if not (MouseInView(E.Where) or MouseInOwner) and
  648. MouseInMenus then Action := DoReturn;
  649. end;
  650. evKeyDown:
  651. case CtrlToArrow(E.KeyCode) of
  652. kbUp, kbDown:
  653. if Size.Y <> 1 then
  654. TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
  655. if E.KeyCode = kbDown then AutoSelect := True;
  656. kbLeft, kbRight:
  657. if ParentMenu = nil then
  658. TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
  659. Action := DoReturn;
  660. kbHome, kbEnd:
  661. if Size.Y <> 1 then
  662. begin
  663. Current := Menu^.Items;
  664. if E.KeyCode = kbEnd then TrackKey(False);
  665. end;
  666. kbEnter:
  667. begin
  668. if Size.Y = 1 then AutoSelect := True;
  669. Action := DoSelect;
  670. end;
  671. kbEsc:
  672. begin
  673. Action := DoReturn;
  674. if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
  675. ClearEvent(E);
  676. end;
  677. else
  678. Target := @Self;
  679. Ch := GetAltChar(E.KeyCode);
  680. if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
  681. P := Target^.FindItem(Ch);
  682. if P = nil then
  683. begin
  684. P := TopMenu^.HotKey(E.KeyCode);
  685. if (P <> nil) and CommandEnabled(P^.Command) then
  686. begin
  687. Result := P^.Command;
  688. Action := DoReturn;
  689. end
  690. end else
  691. if Target = @Self then
  692. begin
  693. if Size.Y = 1 then AutoSelect := True;
  694. Action := DoSelect;
  695. Current := P;
  696. end else
  697. if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
  698. Action := DoReturn;
  699. end;
  700. evCommand:
  701. if E.Command = cmMenu then
  702. begin
  703. AutoSelect := False;
  704. if ParentMenu <> nil then Action := DoReturn;
  705. end else Action := DoReturn;
  706. end;
  707. if ItemShown <> Current then
  708. begin
  709. ItemShown := Current;
  710. DrawView;
  711. end;
  712. if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
  713. if Current <> nil then with Current^ do if Name <> nil then
  714. if Command = 0 then
  715. begin
  716. if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
  717. GetItemRect(Current, R);
  718. R.A.X := R.A.X + Origin.X;
  719. R.A.Y := R.B.Y + Origin.Y;
  720. R.B := Owner^.Size;
  721. if Size.Y = 1 then Dec(R.A.X);
  722. Target := TopMenu^.NewSubView(R, SubMenu, @Self);
  723. Result := Owner^.ExecView(Target);
  724. Dispose(Target, Done);
  725. end else if Action = DoSelect then Result := Command;
  726. if (Result <> 0) and CommandEnabled(Result) then
  727. begin
  728. Action := DoReturn;
  729. ClearEvent(E);
  730. end
  731. else
  732. Result := 0;
  733. until Action = DoReturn;
  734. end;
  735. if E.What <> evNothing then
  736. if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
  737. if Current <> nil then
  738. begin
  739. Menu^.Default := Current;
  740. Current := nil;
  741. DrawView;
  742. end;
  743. Execute := Result;
  744. end;
  745. constructor TAdvancedMenuBar.Init(var Bounds: TRect; AMenu: PMenu);
  746. begin
  747. inherited Init(Bounds, AMenu);
  748. EventMask:=EventMask or evBroadcast;
  749. GrowMode:=gfGrowHiX;
  750. end;
  751. function TAdvancedMenuBar.NewSubView(var Bounds: TRect; AMenu: PMenu;
  752. AParentMenu: PMenuView): PMenuView;
  753. begin
  754. NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
  755. end;
  756. procedure TAdvancedMenuBar.Update;
  757. begin
  758. UpdateMenu(Menu);
  759. DrawView;
  760. end;
  761. function TAdvancedMenuBar.GetMenuItem(cm : word) : PMenuItem;
  762. type
  763. PItemChain = ^TItemChain;
  764. TItemChain = record
  765. Next : PMenuItem;
  766. Up : PItemChain;
  767. end;
  768. var Cur : PMenuItem;
  769. Up,NUp : PItemChain;
  770. begin
  771. Cur:=Menu^.Items;
  772. Up:=nil;
  773. if cm=0 then
  774. begin
  775. GetMenuItem:=nil;
  776. exit;
  777. end;
  778. while assigned(Cur) and (Cur^.Command<>cm) do
  779. begin
  780. if (Cur^.Command=0) and assigned(Cur^.SubMenu) and
  781. assigned(Cur^.Name) and
  782. assigned(Cur^.SubMenu^.Items) then
  783. {subMenu}
  784. begin
  785. If assigned(Cur^.Next) then
  786. begin
  787. New(Nup);
  788. Nup^.Up:=Up;
  789. Nup^.next:=Cur^.Next;
  790. Up:=Nup;
  791. end;
  792. Cur:=Cur^.SubMenu^.Items;
  793. end
  794. else
  795. { normal item }
  796. begin
  797. if assigned(Cur^.Next) then
  798. Cur:=Cur^.Next
  799. else if assigned(Up) then
  800. begin
  801. Cur:=Up^.next;
  802. NUp:=Up;
  803. Up:=Up^.Up;
  804. Dispose(NUp);
  805. end
  806. else
  807. Cur:=Nil;
  808. end;
  809. end;
  810. GetMenuItem:=Cur;
  811. While assigned(Up) do
  812. begin
  813. NUp:=Up;
  814. Up:=Up^.up;
  815. Dispose(NUp);
  816. end;
  817. end;
  818. procedure TAdvancedMenuBar.HandleEvent(var Event: TEvent);
  819. begin
  820. case Event.What of
  821. evBroadcast :
  822. case Event.Command of
  823. cmCommandSetChanged : Update;
  824. cmUpdate : Update;
  825. end;
  826. end;
  827. inherited HandleEvent(Event);
  828. end;
  829. function TAdvancedMenuBar.Execute: word;
  830. type
  831. MenuAction = (DoNothing, DoSelect, DoReturn);
  832. var
  833. AutoSelect: Boolean;
  834. Action: MenuAction;
  835. Ch: Char;
  836. Result: Word;
  837. ItemShown, P: PMenuItem;
  838. Target: PMenuView;
  839. R: TRect;
  840. E: TEvent;
  841. MouseActive: Boolean;
  842. function IsDisabled(Item: PMenuItem): boolean;
  843. var Dis : boolean;
  844. begin
  845. Dis:=Item^.Disabled or IsSeparator(Item);
  846. if (Dis=false) and (IsSubMenu(Item)=false) then
  847. Dis:=CommandEnabled(Item^.Command)=false;
  848. IsDisabled:=Dis;
  849. end;
  850. procedure TrackMouse;
  851. var
  852. Mouse: TPoint;
  853. R: TRect;
  854. OldC: PMenuItem;
  855. begin
  856. MakeLocal(E.Where, Mouse);
  857. OldC:=Current;
  858. Current := Menu^.Items;
  859. while Current <> nil do
  860. begin
  861. GetItemRect(Current, R);
  862. if R.Contains(Mouse) then
  863. begin
  864. MouseActive := True;
  865. Break;
  866. end;
  867. Current := Current^.Next;
  868. end;
  869. if (Current<>nil) and IsDisabled(Current) then
  870. Current:=nil;
  871. end;
  872. procedure TrackKey(FindNext: Boolean);
  873. procedure NextItem;
  874. begin
  875. Current := Current^.Next;
  876. if Current = nil then Current := Menu^.Items;
  877. end;
  878. procedure PrevItem;
  879. var
  880. P: PMenuItem;
  881. begin
  882. P := Current;
  883. if P = Menu^.Items then P := nil;
  884. repeat NextItem until Current^.Next = P;
  885. end;
  886. begin
  887. if Current <> nil then
  888. repeat
  889. if FindNext then NextItem else PrevItem;
  890. until (Current^.Name <> nil) and (IsDisabled(Current)=false);
  891. end;
  892. function MouseInOwner: Boolean;
  893. var
  894. Mouse: TPoint;
  895. R: TRect;
  896. begin
  897. MouseInOwner := False;
  898. if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
  899. begin
  900. ParentMenu^.MakeLocal(E.Where, Mouse);
  901. ParentMenu^.GetItemRect(ParentMenu^.Current, R);
  902. MouseInOwner := R.Contains(Mouse);
  903. end;
  904. end;
  905. function MouseInMenus: Boolean;
  906. var
  907. P: PMenuView;
  908. begin
  909. P := ParentMenu;
  910. while (P <> nil) and not P^.MouseInView(E.Where) do P := P^.ParentMenu;
  911. MouseInMenus := P <> nil;
  912. end;
  913. function TopMenu: PMenuView;
  914. var
  915. P: PMenuView;
  916. begin
  917. P := @Self;
  918. while P^.ParentMenu <> nil do P := P^.ParentMenu;
  919. TopMenu := P;
  920. end;
  921. begin
  922. AutoSelect := False; E.What:=evNothing;
  923. Result := 0;
  924. ItemShown := nil;
  925. Current := Menu^.Default;
  926. MouseActive := False;
  927. if UpdateMenu(Menu) then
  928. begin
  929. if Current<>nil then
  930. if Current^.Disabled then
  931. TrackKey(true);
  932. repeat
  933. Action := DoNothing;
  934. GetEvent(E);
  935. case E.What of
  936. evMouseDown:
  937. if MouseInView(E.Where) or MouseInOwner then
  938. begin
  939. TrackMouse;
  940. if Size.Y = 1 then AutoSelect := True;
  941. end else Action := DoReturn;
  942. evMouseUp:
  943. begin
  944. TrackMouse;
  945. if MouseInOwner then
  946. Current := Menu^.Default
  947. else
  948. if (Current <> nil) and (Current^.Name <> nil) then
  949. Action := DoSelect
  950. else
  951. if MouseActive or MouseInView(E.Where) then Action := DoReturn
  952. else
  953. begin
  954. Current := Menu^.Default;
  955. if Current = nil then Current := Menu^.Items;
  956. Action := DoNothing;
  957. end;
  958. end;
  959. evMouseMove:
  960. if E.Buttons <> 0 then
  961. begin
  962. TrackMouse;
  963. if not (MouseInView(E.Where) or MouseInOwner) and
  964. MouseInMenus then Action := DoReturn;
  965. end;
  966. evKeyDown:
  967. case CtrlToArrow(E.KeyCode) of
  968. kbUp, kbDown:
  969. if Size.Y <> 1 then
  970. TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
  971. if E.KeyCode = kbDown then AutoSelect := True;
  972. kbLeft, kbRight:
  973. if ParentMenu = nil then
  974. TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
  975. Action := DoReturn;
  976. kbHome, kbEnd:
  977. if Size.Y <> 1 then
  978. begin
  979. Current := Menu^.Items;
  980. if E.KeyCode = kbEnd then TrackKey(False);
  981. end;
  982. kbEnter:
  983. begin
  984. if Size.Y = 1 then AutoSelect := True;
  985. Action := DoSelect;
  986. end;
  987. kbEsc:
  988. begin
  989. Action := DoReturn;
  990. if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
  991. ClearEvent(E);
  992. end;
  993. else
  994. Target := @Self;
  995. Ch := GetAltChar(E.KeyCode);
  996. if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
  997. P := Target^.FindItem(Ch);
  998. if P = nil then
  999. begin
  1000. P := TopMenu^.HotKey(E.KeyCode);
  1001. if (P <> nil) and CommandEnabled(P^.Command) then
  1002. begin
  1003. Result := P^.Command;
  1004. Action := DoReturn;
  1005. end
  1006. end else
  1007. if Target = @Self then
  1008. begin
  1009. if Size.Y = 1 then AutoSelect := True;
  1010. Action := DoSelect;
  1011. Current := P;
  1012. end else
  1013. if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
  1014. Action := DoReturn;
  1015. end;
  1016. evCommand:
  1017. if E.Command = cmMenu then
  1018. begin
  1019. AutoSelect := False;
  1020. if ParentMenu <> nil then Action := DoReturn;
  1021. end else Action := DoReturn;
  1022. end;
  1023. if ItemShown <> Current then
  1024. begin
  1025. ItemShown := Current;
  1026. DrawView;
  1027. end;
  1028. if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
  1029. if Current <> nil then with Current^ do if Name <> nil then
  1030. if Command = 0 then
  1031. begin
  1032. if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
  1033. GetItemRect(Current, R);
  1034. R.A.X := R.A.X + Origin.X;
  1035. R.A.Y := R.B.Y + Origin.Y;
  1036. R.B := Owner^.Size;
  1037. if Size.Y = 1 then Dec(R.A.X);
  1038. Target := TopMenu^.NewSubView(R, SubMenu, @Self);
  1039. Result := Owner^.ExecView(Target);
  1040. Dispose(Target, Done);
  1041. end else if Action = DoSelect then Result := Command;
  1042. if (Result <> 0) and CommandEnabled(Result) then
  1043. begin
  1044. Action := DoReturn;
  1045. ClearEvent(E);
  1046. end
  1047. else
  1048. Result := 0;
  1049. until Action = DoReturn;
  1050. end;
  1051. if E.What <> evNothing then
  1052. if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
  1053. if Current <> nil then
  1054. begin
  1055. Menu^.Default := Current;
  1056. Current := nil;
  1057. DrawView;
  1058. end;
  1059. Execute := Result;
  1060. end;
  1061. procedure TAdvancedStaticText.SetText(S: string);
  1062. begin
  1063. if Text<>nil then DisposeStr(Text);
  1064. Text:=NewStr(S);
  1065. DrawView;
  1066. end;
  1067. procedure TAdvancedListBox.FocusItem(Item: sw_integer);
  1068. var OFocused: sw_integer;
  1069. begin
  1070. OFocused:=Focused;
  1071. inherited FocusItem(Item);
  1072. if Focused<>OFocused then
  1073. Message(Owner,evBroadcast,cmListFocusChanged,@Self);
  1074. end;
  1075. procedure TAdvancedListBox.HandleEvent(var Event: TEvent);
  1076. begin
  1077. case Event.What of
  1078. evMouseDown :
  1079. if MouseInView(Event.Where) {and (Event.Double)} then
  1080. begin
  1081. inherited HandleEvent(Event);
  1082. if Event.Double then
  1083. if Range>Focused then
  1084. SelectItem(Focused);
  1085. end;
  1086. evBroadcast :
  1087. case Event.Command of
  1088. cmListItemSelected :
  1089. Message(Owner,evBroadcast,cmDefault,nil);
  1090. end;
  1091. end;
  1092. if assigned(VScrollBar) then
  1093. VScrollBar^.HandleEvent(Event);
  1094. if assigned(HScrollBar) then
  1095. HScrollBar^.HandleEvent(Event);
  1096. inherited HandleEvent(Event);
  1097. end;
  1098. constructor TColorStaticText.Init(var Bounds: TRect; AText: String; AColor: word; AWrap: boolean);
  1099. begin
  1100. inherited Init(Bounds,AText);
  1101. DontWrap:=not AWrap;
  1102. Color:=AColor;
  1103. end;
  1104. function TColorStaticText.GetPalette: PPalette;
  1105. begin
  1106. GetPalette:=nil;
  1107. end;
  1108. procedure TColorStaticText.Draw;
  1109. procedure MoveColorTxt(var b;const curs:string;c:word);
  1110. var
  1111. p : ^word;
  1112. i : sw_integer;
  1113. col : byte;
  1114. tilde : boolean;
  1115. begin
  1116. tilde:=false;
  1117. col:=lo(c);
  1118. p:=@b;
  1119. i:=0;
  1120. while (i<length(Curs)) do
  1121. begin
  1122. Inc(i);
  1123. case CurS[i] of
  1124. #1 :
  1125. begin
  1126. Inc(i);
  1127. Col:=ord(curS[i]);
  1128. end;
  1129. #2 :
  1130. begin
  1131. if tilde then
  1132. col:=hi(Color)
  1133. else
  1134. col:=lo(Color)
  1135. end;
  1136. '~' :
  1137. begin
  1138. tilde:=not tilde;
  1139. if tilde then
  1140. col:=hi(Color)
  1141. else
  1142. col:=lo(Color)
  1143. end;
  1144. else
  1145. begin
  1146. p^:=(col shl 8) or ord(curs[i]);
  1147. inc(p);
  1148. end;
  1149. end;
  1150. end;
  1151. end;
  1152. var
  1153. C: word;
  1154. Center: Boolean;
  1155. I, J, L, P, Y: Sw_Integer;
  1156. B: TDrawBuffer;
  1157. S: String;
  1158. T: string;
  1159. CurS: string;
  1160. TildeCount,Po: Sw_integer;
  1161. TempS: string;
  1162. begin
  1163. if Size.X=0 then Exit;
  1164. C:=Color;
  1165. if (C and $0f)=((C and $f0) shr 4) then
  1166. C:=GetColor(C and $0f);
  1167. if DontWrap=false then
  1168. begin
  1169. GetText(S);
  1170. L := Length(S);
  1171. P := 1;
  1172. Y := 0;
  1173. Center := False;
  1174. while Y < Size.Y do
  1175. begin
  1176. MoveChar(B, ' ', Lo(C), Size.X);
  1177. if P <= L then
  1178. begin
  1179. if S[P] = #3 then
  1180. begin
  1181. Center := True;
  1182. Inc(P);
  1183. end;
  1184. I := P;
  1185. repeat
  1186. J := P;
  1187. while (P <= L) and (S[P] = ' ') do Inc(P);
  1188. while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do Inc(P);
  1189. until (P > L) or (P >= I + Size.X) or (S[P] = #13);
  1190. TildeCount:=0; TempS:=copy(S,I,P-I);
  1191. repeat
  1192. Po:=Pos('~',TempS);
  1193. if Po>0 then begin Inc(TildeCount); Delete(TempS,1,Po); end;
  1194. until Po=0;
  1195. if P > I + Size.X + TildeCount then
  1196. if J > I then P := J else P := I + Size.X;
  1197. T:=copy(S,I,P-I);
  1198. if Center then J := (Size.X - {P + I}CStrLen(T)) div 2 else J := 0;
  1199. MoveColorTxt(B[J],T,C);
  1200. while (P <= L) and (S[P] = ' ') do Inc(P);
  1201. if (P <= L) and (S[P] = #13) then
  1202. begin
  1203. Center := False;
  1204. Inc(P);
  1205. if (P <= L) and (S[P] = #10) then Inc(P);
  1206. end;
  1207. end;
  1208. WriteLine(0, Y, Size.X, 1, B);
  1209. Inc(Y);
  1210. end;
  1211. end { Wrap=false } else
  1212. begin
  1213. GetText(S);
  1214. I:=1;
  1215. for Y:=0 to Size.Y-1 do
  1216. begin
  1217. MoveChar(B, ' ', Lo(C), Size.X);
  1218. CurS:='';
  1219. if S<>'' then
  1220. begin
  1221. P:=Pos(#13,S);
  1222. if P=0 then P:=length(S)+1;
  1223. CurS:=copy(S,1,P-1);
  1224. CurS:=copy(CurS,Delta.X+1,High(CurS));
  1225. CurS:=copy(CurS,1,MaxViewWidth);
  1226. Delete(S,1,P);
  1227. end;
  1228. if CurS<>'' then
  1229. MoveColorTxt(B,CurS,C);
  1230. WriteLine(0,Y,Size.X,1,B);
  1231. end;
  1232. end;
  1233. end;
  1234. constructor TColorStaticText.Load(var S: TStream);
  1235. begin
  1236. inherited Load(S);
  1237. S.Read(Color,SizeOf(Color));
  1238. S.Read(DontWrap,SizeOf(DontWrap));
  1239. S.Read(Delta,SizeOf(Delta));
  1240. end;
  1241. procedure TColorStaticText.Store(var S: TStream);
  1242. begin
  1243. inherited Store(S);
  1244. S.Write(Color,SizeOf(Color));
  1245. S.Write(DontWrap,SizeOf(DontWrap));
  1246. S.Write(Delta,SizeOf(Delta));
  1247. end;
  1248. constructor THSListBox.Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
  1249. begin
  1250. inherited Init(Bounds,ANumCols,AVScrollBar);
  1251. HScrollBar:=AHScrollBar;
  1252. if assigned(VScrollBar) then
  1253. VScrollBar^.SetStep(Bounds.B.Y-Bounds.A.Y-2,1);
  1254. if assigned(HScrollBar) then
  1255. HScrollBar^.SetStep(Bounds.B.X-Bounds.A.X-2,1);
  1256. end;
  1257. function THSListBox.SaveToFile(const AFileName: string): boolean;
  1258. var OK: boolean;
  1259. S: PBufStream;
  1260. i, count : sw_integer;
  1261. st : string;
  1262. begin
  1263. New(S, Init(AFileName,stCreate,4096));
  1264. OK:=Assigned(S) and (S^.Status=stOK);
  1265. if OK then
  1266. begin
  1267. if assigned(List) then
  1268. Count:=List^.Count
  1269. else
  1270. Count:=0;
  1271. for i:=0 to Count-1 do
  1272. begin
  1273. st:=GetText(i,High(st));
  1274. S^.Write(St[1],length(St));
  1275. if i<Count then
  1276. S^.Write(EOL[1],length(EOL));
  1277. OK:=(S^.Status=stOK);
  1278. if not OK then
  1279. break;
  1280. end;
  1281. end;
  1282. if Assigned(S) then Dispose(S, Done);
  1283. SaveToFile:=OK;
  1284. end;
  1285. function THSListBox.SaveAs: Boolean;
  1286. var
  1287. DefExt,Title,Filename : string;
  1288. Re : word;
  1289. begin
  1290. SaveAs := False;
  1291. Filename:='listbox.txt';
  1292. DefExt:='*.txt';
  1293. Title:='Save list box content';
  1294. Re:=Application^.ExecuteDialog(New(PFileDialog, Init(DefExt,
  1295. Title, label_name, fdOkButton, FileId)), @FileName);
  1296. if Re <> cmCancel then
  1297. SaveAs := SaveToFile(FileName);
  1298. end;
  1299. constructor TDlgWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer);
  1300. begin
  1301. inherited Init(Bounds,ATitle);
  1302. Number:=ANumber;
  1303. Flags:=Flags or (wfMove + wfGrow + wfClose + wfZoom);
  1304. end;
  1305. procedure TLocalMenuListBox.LocalMenu(P: TPoint);
  1306. var M: PMenu;
  1307. MV: PAdvancedMenuPopUp;
  1308. R: TRect;
  1309. Re: word;
  1310. begin
  1311. M:=GetLocalMenu;
  1312. if M=nil then Exit;
  1313. if LastLocalCmd<>0 then
  1314. M^.Default:=SearchMenuItem(M,LastLocalCmd);
  1315. Desktop^.GetExtent(R);
  1316. MakeGlobal(P,R.A); {Desktop^.MakeLocal(R.A,R.A);}
  1317. New(MV, Init(R, M));
  1318. Re:=Application^.ExecView(MV);
  1319. if M^.Default=nil then LastLocalCmd:=0
  1320. else LastLocalCmd:=M^.Default^.Command;
  1321. Dispose(MV, Done);
  1322. if Re<>0 then
  1323. Message(GetCommandTarget,evCommand,Re,@Self);
  1324. end;
  1325. function TLocalMenuListBox.GetLocalMenu: PMenu;
  1326. begin
  1327. GetLocalMenu:=nil;
  1328. { Abstract;}
  1329. end;
  1330. function TLocalMenuListBox.GetCommandTarget: PView;
  1331. begin
  1332. GetCommandTarget:=@Self;
  1333. end;
  1334. procedure TLocalMenuListBox.HandleEvent(var Event: TEvent);
  1335. var DontClear: boolean;
  1336. P: TPoint;
  1337. begin
  1338. case Event.What of
  1339. evMouseDown :
  1340. if MouseInView(Event.Where) and (Event.Buttons=mbRightButton) then
  1341. begin
  1342. MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
  1343. LocalMenu(P);
  1344. ClearEvent(Event);
  1345. end;
  1346. evKeyDown :
  1347. begin
  1348. DontClear:=false;
  1349. case Event.KeyCode of
  1350. kbAltF10 : Message(@Self,evCommand,cmLocalMenu,@Self);
  1351. else DontClear:=true;
  1352. end;
  1353. if DontClear=false then ClearEvent(Event);
  1354. end;
  1355. evCommand :
  1356. begin
  1357. DontClear:=false;
  1358. case Event.Command of
  1359. cmLocalMenu :
  1360. begin
  1361. P:=Cursor; Inc(P.X); Inc(P.Y);
  1362. LocalMenu(P);
  1363. end;
  1364. else DontClear:=true;
  1365. end;
  1366. if not DontClear then ClearEvent(Event);
  1367. end;
  1368. end;
  1369. inherited HandleEvent(Event);
  1370. end;
  1371. function TAdvancedStatusLine.GetStatusText: string;
  1372. var S: string;
  1373. begin
  1374. if StatusText=nil then S:='' else S:=StatusText^;
  1375. GetStatusText:=S;
  1376. end;
  1377. procedure TAdvancedStatusLine.SetStatusText(const S: string);
  1378. begin
  1379. if StatusText<>nil then DisposeStr(StatusText);
  1380. StatusText:=NewStr(S);
  1381. DrawView;
  1382. end;
  1383. procedure TAdvancedStatusLine.ClearStatusText;
  1384. begin
  1385. SetStatusText('');
  1386. end;
  1387. procedure TAdvancedStatusLine.Draw;
  1388. var B: TDrawBuffer;
  1389. C: word;
  1390. S: string;
  1391. begin
  1392. S:=GetStatusText;
  1393. if S='' then inherited Draw else
  1394. begin
  1395. C:=GetColor(1);
  1396. MoveChar(B,' ',C,Size.X);
  1397. MoveStr(B[1],S,C);
  1398. WriteLine(0,0,Size.X,Size.Y,B);
  1399. end;
  1400. end;
  1401. procedure Bug(const S: string; Params: pointer);
  1402. begin
  1403. ErrorBox(FormatStrStr(msg_bugcheckfailed,S),Params);
  1404. end;
  1405. procedure ErrorBox(const S: string; Params: pointer);
  1406. begin
  1407. AdvMessageBox(S,Params,mfError+mfInsertInApp+mfOKButton);
  1408. end;
  1409. procedure WarningBox(const S: string; Params: pointer);
  1410. begin
  1411. AdvMessageBox(S,Params,mfWarning+mfInsertInApp+mfOKButton);
  1412. end;
  1413. procedure InformationBox(const S: string; Params: pointer);
  1414. begin
  1415. AdvMessageBox(S,Params,mfInformation+mfInsertInApp+mfOKButton);
  1416. end;
  1417. function b2i(B: boolean): longint;
  1418. begin
  1419. if b then b2i:=1 else b2i:=0;
  1420. end;
  1421. function ConfirmBox(const S: string; Params: pointer; CanCancel: boolean): word;
  1422. begin
  1423. ConfirmBox:=AdvMessageBox(S,Params,mfConfirmation+mfInsertInApp+mfYesButton+mfNoButton+
  1424. b2i(CanCancel)*mfCancelButton+b2i(not CanCancel)*mfCantCancel);
  1425. end;
  1426. function ChoiceBox(const S: string; Params: pointer; Buttons: array of longstring; CanCancel: boolean): word;
  1427. var BtnMask,M: longint;
  1428. I,BtnCount: integer;
  1429. begin
  1430. BtnCount:=Min(High(Buttons)-Low(Buttons)+1,High(UserButtonName)-Low(UserButtonName)+1);
  1431. BtnMask:=0; M:=mfUserBtn1;
  1432. for I:=Low(Buttons) to Low(Buttons)+BtnCount-1 do
  1433. begin
  1434. UserButtonName[Low(UserButtonName)+I-Low(Buttons)]:=Buttons[I];
  1435. BtnMask:=BtnMask or M; M:=M shl 1;
  1436. end;
  1437. ChoiceBox:=AdvMessageBox(S,Params,mfConfirmation+BtnMask+
  1438. b2i(CanCancel)*mfCancelButton+b2i(not CanCancel)*mfCantCancel);
  1439. end;
  1440. function IsSeparator(P: PMenuItem): boolean;
  1441. begin
  1442. IsSeparator:=(P<>nil) and (P^.Name=nil) and (P^.HelpCtx=hcNoContext);
  1443. end;
  1444. function IsSubMenu(P: PMenuItem): boolean;
  1445. begin
  1446. IsSubMenu:=(P<>nil) and (P^.Name<>nil) and (P^.Command=0) and (P^.SubMenu<>nil);
  1447. end;
  1448. function SearchMenuItem(Menu: PMenu; Cmd: word): PMenuItem;
  1449. var P,I: PMenuItem;
  1450. begin
  1451. I:=nil;
  1452. if Menu=nil then P:=nil else P:=Menu^.Items;
  1453. while (P<>nil) and (I=nil) do
  1454. begin
  1455. if IsSubMenu(P) then
  1456. I:=SearchMenuItem(P^.SubMenu,Cmd);
  1457. if I=nil then
  1458. if P^.Command=Cmd then I:=P else
  1459. P:=P^.Next;
  1460. end;
  1461. SearchMenuItem:=I;
  1462. end;
  1463. procedure SetMenuItemParam(Menu: PMenuItem; Param: string);
  1464. begin
  1465. if Menu=nil then Exit;
  1466. if Menu^.Param<>nil then DisposeStr(Menu^.Param);
  1467. Menu^.Param:=NewStr(Param);
  1468. end;
  1469. function UpdateMenu(M: PMenu): boolean;
  1470. var P: PMenuItem;
  1471. IsEnabled: boolean;
  1472. begin
  1473. if M=nil then begin UpdateMenu:=false; Exit; end;
  1474. P:=M^.Items; IsEnabled:=false;
  1475. while (P<>nil) do
  1476. begin
  1477. if IsSubMenu(P) then
  1478. begin
  1479. P^.Disabled:=not UpdateMenu(P^.SubMenu);
  1480. if not P^.Disabled then
  1481. IsEnabled:=true;
  1482. end
  1483. else if (IsSeparator(P)=false) {and (P^.Disabled=false)} and
  1484. (Application^.CommandEnabled(P^.Command)=true) then
  1485. begin
  1486. p^.disabled:=not Application^.CommandEnabled(P^.Command);
  1487. if not p^.disabled then
  1488. IsEnabled:=true;
  1489. end;
  1490. P:=P^.Next;
  1491. end;
  1492. UpdateMenu:=IsEnabled;
  1493. end;
  1494. function SearchSubMenu(M: PMenu; Index: Sw_integer): PMenuItem;
  1495. var P,C: PMenuItem;
  1496. Count: Sw_integer;
  1497. begin
  1498. P:=nil; Count:=-1;
  1499. if M<>nil then C:=M^.Items else C:=nil;
  1500. while (C<>nil) and (P=nil) do
  1501. begin
  1502. if IsSubMenu(C) then
  1503. begin
  1504. Inc(Count);
  1505. if Count=Index then P:=C;
  1506. end;
  1507. C:=C^.Next;
  1508. end;
  1509. SearchSubMenu:=P;
  1510. end;
  1511. procedure AppendMenuItem(M: PMenu; I: PMenuItem);
  1512. var P: PMenuItem;
  1513. begin
  1514. if (M=nil) or (I=nil) then Exit;
  1515. I^.Next:=nil;
  1516. if M^.Items=nil then M^.Items:=I else
  1517. begin
  1518. P:=M^.Items;
  1519. while (P^.Next<>nil) do P:=P^.Next;
  1520. P^.Next:=I;
  1521. end;
  1522. end;
  1523. procedure DisposeMenuItem(P: PMenuItem);
  1524. begin
  1525. if P<>nil then
  1526. begin
  1527. if IsSubMenu(P) then DisposeMenu(P^.SubMenu) else
  1528. if IsSeparator(P)=false then
  1529. if P^.Param<>nil then DisposeStr(P^.Param);
  1530. if P^.Name<>nil then DisposeStr(P^.Name);
  1531. Dispose(P);
  1532. end;
  1533. end;
  1534. procedure RemoveMenuItem(Menu: PMenu; I: PMenuItem);
  1535. var P,PrevP: PMenuItem;
  1536. begin
  1537. if (Menu=nil) or (I=nil) then Exit;
  1538. P:=Menu^.Items; PrevP:=nil;
  1539. while (P<>nil) do
  1540. begin
  1541. if P=I then
  1542. begin
  1543. if Menu^.Items<>I then PrevP^.Next:=P^.Next
  1544. else Menu^.Items:=P^.Next;
  1545. DisposeMenuItem(P);
  1546. Break;
  1547. end;
  1548. PrevP:=P; P:=P^.Next;
  1549. end;
  1550. end;
  1551. function GetMenuItemBefore(Menu: PMenu; BeforeOf: PMenuItem): PMenuItem;
  1552. var P,C: PMenuItem;
  1553. begin
  1554. P:=nil;
  1555. if Menu<>nil then C:=Menu^.Items else C:=nil;
  1556. while (C<>nil) do
  1557. begin
  1558. if C^.Next=BeforeOf then begin P:=C; Break; end;
  1559. C:=C^.Next;
  1560. end;
  1561. GetMenuItemBefore:=P;
  1562. end;
  1563. procedure NotImplemented;
  1564. begin
  1565. InformationBox(msg_functionnotimplemented,nil);
  1566. end;
  1567. procedure InsertButtons(ADialog: PDialog);
  1568. var R : TRect;
  1569. W,H : Sw_integer;
  1570. X : Sw_integer;
  1571. X1,X2: Sw_integer;
  1572. begin
  1573. with ADialog^ do
  1574. begin
  1575. GetExtent(R);
  1576. W:=R.B.X-R.A.X; H:=(R.B.Y-R.A.Y);
  1577. R.Assign(0,0,W,H+3); ChangeBounds(R);
  1578. X:=W div 2; X1:=X div 2+1; X2:=X+X1-1;
  1579. R.Assign(X1-3,H,X1+7,H+2);
  1580. Insert(New(PButton, Init(R, btn_OK, cmOK, bfDefault)));
  1581. R.Assign(X2-7,H,X2+3,H+2);
  1582. Insert(New(PButton, Init(R, btn_Cancel, cmCancel, bfNormal)));
  1583. SelectNext(true);
  1584. end;
  1585. end;
  1586. procedure InsertOK(ADialog: PDialog);
  1587. var BW: Sw_integer;
  1588. R: TRect;
  1589. begin
  1590. with ADialog^ do
  1591. begin
  1592. GetBounds(R); R.Grow(0,1); Inc(R.B.Y);
  1593. ChangeBounds(R);
  1594. BW:=10;
  1595. R.A.Y:=R.B.Y-2; R.B.Y:=R.A.Y+2;
  1596. R.A.X:=R.A.X+(R.B.X-R.A.X-BW) div 2; R.B.X:=R.A.X+BW;
  1597. Insert(New(PButton, Init(R, btn_OK, cmOK, bfDefault)));
  1598. SelectNext(true);
  1599. end;
  1600. end;
  1601. procedure ShowMessage(Msg: string);
  1602. var R: TRect;
  1603. Width: Sw_integer;
  1604. begin
  1605. Width:=length(Msg)+4*2;
  1606. if Width<(Desktop^.Size.X div 2) then Width:=(Desktop^.Size.X div 2);
  1607. R.Assign(0,0,Width,5);
  1608. New(MessageDialog, Init(R, ''));
  1609. with MessageDialog^ do
  1610. begin
  1611. Flags:=0;
  1612. GetExtent(R); R.Grow(-4,-2);
  1613. if copy(Msg,1,1)<>^C then Msg:=^C+Msg;
  1614. Insert(New(PStaticText, Init(R, Msg)));
  1615. end;
  1616. Application^.Insert(MessageDialog);
  1617. end;
  1618. procedure HideMessage;
  1619. begin
  1620. if MessageDialog<>nil then
  1621. begin
  1622. Application^.Delete(MessageDialog);
  1623. Dispose(MessageDialog, Done);
  1624. MessageDialog:=nil;
  1625. end;
  1626. end;
  1627. constructor TDDHelperLB.Init(ALink: PDropDownListBox; var Bounds: TRect; ANumCols: Word; AScrollBar: PScrollBar);
  1628. begin
  1629. inherited Init(Bounds,ANumCols,AScrollBar);
  1630. EventMask:=EventMask or (evMouseMove+evIdle);
  1631. { Options:=Options or ofPreProcess;}
  1632. Link:=ALink;
  1633. end;
  1634. procedure TDDHelperLB.SetState(AState: Word; Enable: Boolean);
  1635. {var OState: longint;}
  1636. begin
  1637. { OState:=State;}
  1638. inherited SetState(AState,Enable);
  1639. { if (((State xor OState) and sfFocused)<>0) and (GetState(sfFocused)=false) then
  1640. Link^.DropList(false);}
  1641. end;
  1642. function TDDHelperLB.GetText(Item,MaxLen: Sw_Integer): String;
  1643. var P: pointer;
  1644. S: string;
  1645. begin
  1646. P:=List^.At(Item);
  1647. if Link=nil then S:='' else
  1648. S:=Link^.GetText(P,MaxLen);
  1649. GetText:=S;
  1650. end;
  1651. function TDDHelperLB.GetLocalMenu: PMenu;
  1652. begin
  1653. GetLocalMenu:=Link^.LBGetLocalMenu;
  1654. end;
  1655. function TDDHelperLB.GetCommandTarget: PView;
  1656. begin
  1657. GetCommandTarget:=Link^.LBGetCommandTarget;
  1658. end;
  1659. procedure TDDHelperLB.HandleEvent(var Event: TEvent);
  1660. const
  1661. MouseAutosToSkip = 4;
  1662. var
  1663. Mouse : TPoint;
  1664. OldItem, NewItem : Sw_Integer;
  1665. ColWidth,Count : Sw_Word;
  1666. GoSelectItem: sw_integer;
  1667. MouseWhere: TPoint;
  1668. begin
  1669. GoSelectItem:=-1;
  1670. TView.HandleEvent(Event);
  1671. case Event.What of
  1672. evMouseDown :
  1673. if MouseInView(Event.Where)=false then
  1674. GoSelectItem:=-2
  1675. else
  1676. begin
  1677. ColWidth := Size.X div NumCols + 1;
  1678. OldItem := Focused;
  1679. MakeLocal(Event.Where, Mouse);
  1680. if MouseInView(Event.Where) then
  1681. NewItem := Mouse.Y + (Size.Y * (Mouse.X div ColWidth)) + TopItem
  1682. else
  1683. NewItem := OldItem;
  1684. Count := 0;
  1685. repeat
  1686. if NewItem <> OldItem then
  1687. begin
  1688. FocusItemNum(NewItem);
  1689. DrawView;
  1690. end;
  1691. OldItem := NewItem;
  1692. MakeLocal(Event.Where, Mouse);
  1693. if MouseInView(Event.Where) then
  1694. NewItem := Mouse.Y + (Size.Y * (Mouse.X div ColWidth)) + TopItem
  1695. else
  1696. begin
  1697. if NumCols = 1 then
  1698. begin
  1699. if Event.What = evMouseAuto then Inc(Count);
  1700. if Count = MouseAutosToSkip then
  1701. begin
  1702. Count := 0;
  1703. if Mouse.Y < 0 then NewItem := Focused-1
  1704. else if Mouse.Y >= Size.Y then NewItem := Focused+1;
  1705. end;
  1706. end
  1707. else
  1708. begin
  1709. if Event.What = evMouseAuto then Inc(Count);
  1710. if Count = MouseAutosToSkip then
  1711. begin
  1712. Count := 0;
  1713. if Mouse.X < 0 then NewItem := Focused-Size.Y
  1714. else if Mouse.X >= Size.X then NewItem := Focused+Size.Y
  1715. else if Mouse.Y < 0 then
  1716. NewItem := Focused - Focused mod Size.Y
  1717. else if Mouse.Y > Size.Y then
  1718. NewItem := Focused - Focused mod Size.Y + Size.Y - 1;
  1719. end
  1720. end;
  1721. end;
  1722. until not MouseEvent(Event, evMouseMove + evMouseAuto);
  1723. FocusItemNum(NewItem);
  1724. DrawView;
  1725. if Event.Double and (Range > Focused) then SelectItem(Focused);
  1726. ClearEvent(Event);
  1727. GoSelectItem:=Focused;
  1728. end;
  1729. evMouseMove,evMouseAuto:
  1730. if GetState(sfFocused) then
  1731. if MouseInView(Event.Where) then
  1732. begin
  1733. MakeLocal(Event.Where,Mouse);
  1734. FocusItemNum(TopItem+Mouse.Y);
  1735. ClearEvent(Event);
  1736. end;
  1737. evKeyDown :
  1738. begin
  1739. if (Event.KeyCode=kbEsc) then
  1740. begin
  1741. GoSelectItem:=-2;
  1742. ClearEvent(Event);
  1743. end else
  1744. if (Event.CharCode = ' ') and (Focused < Range) then
  1745. begin
  1746. GoSelectItem:=Focused;
  1747. NewItem := Focused;
  1748. end
  1749. else
  1750. case CtrlToArrow(Event.KeyCode) of
  1751. kbUp : NewItem := Focused - 1;
  1752. kbDown : NewItem := Focused + 1;
  1753. kbRight: if NumCols > 1 then NewItem := Focused + Size.Y else Exit;
  1754. kbLeft : if NumCols > 1 then NewItem := Focused - Size.Y else Exit;
  1755. kbPgDn : NewItem := Focused + Size.Y * NumCols;
  1756. kbPgUp : NewItem := Focused - Size.Y * NumCols;
  1757. kbHome : NewItem := TopItem;
  1758. kbEnd : NewItem := TopItem + (Size.Y * NumCols) - 1;
  1759. kbCtrlPgDn: NewItem := Range - 1;
  1760. kbCtrlPgUp: NewItem := 0;
  1761. else
  1762. Exit;
  1763. end;
  1764. FocusItemNum(NewItem);
  1765. DrawView;
  1766. ClearEvent(Event);
  1767. end;
  1768. evBroadcast :
  1769. case Event.Command of
  1770. cmReceivedFocus :
  1771. if (Event.InfoPtr<>@Self) and (InClose=false) then
  1772. begin
  1773. GoSelectItem:=-2;
  1774. end;
  1775. else
  1776. if Options and ofSelectable <> 0 then
  1777. if (Event.Command = cmScrollBarClicked) and
  1778. ((Event.InfoPtr = HScrollBar) or (Event.InfoPtr = VScrollBar)) then
  1779. Select
  1780. else
  1781. if (Event.Command = cmScrollBarChanged) then
  1782. begin
  1783. if (VScrollBar = Event.InfoPtr) then
  1784. begin
  1785. FocusItemNum(VScrollBar^.Value);
  1786. DrawView;
  1787. end
  1788. else
  1789. if (HScrollBar = Event.InfoPtr) then
  1790. DrawView;
  1791. end;
  1792. end;
  1793. evIdle :
  1794. begin
  1795. MouseWhere.X:=MouseWhereX shr 3; MouseWhere.Y:=MouseWhereY shr 3;
  1796. if MouseInView(MouseWhere)=false then
  1797. if abs(GetDosTicks-LastTT)>=1 then
  1798. begin
  1799. LastTT:=GetDosTicks;
  1800. MakeLocal(MouseWhere,Mouse);
  1801. if ((Mouse.Y<-1) or (Mouse.Y>=Size.Y)) and
  1802. ((0<=Mouse.X) and (Mouse.X<Size.X)) then
  1803. if Range>0 then
  1804. if Mouse.Y<0 then
  1805. FocusItemNum(Focused-(0-Mouse.Y))
  1806. else
  1807. FocusItemNum(Focused+(Mouse.Y-(Size.Y-1)));
  1808. end;
  1809. end;
  1810. end;
  1811. if (Range>0) and (GoSelectItem<>-1) then
  1812. begin
  1813. InClose:=true;
  1814. if GoSelectItem=-2 then
  1815. Link^.DropList(false)
  1816. else
  1817. SelectItem(GoSelectItem);
  1818. end;
  1819. end;
  1820. procedure TDDHelperLB.SelectItem(Item: Sw_Integer);
  1821. begin
  1822. inherited SelectItem(Item);
  1823. Link^.FocusItem(Focused);
  1824. Link^.DropList(false);
  1825. end;
  1826. constructor TDropDownListBox.Init(var Bounds: TRect; ADropLineCount: Sw_integer; AList: PCollection);
  1827. begin
  1828. inherited Init(Bounds);
  1829. Options:=Options or (ofSelectable);
  1830. EventMask:=EventMask or (evBroadcast);
  1831. DropLineCount:=ADropLineCount;
  1832. NewList(AList);
  1833. end;
  1834. procedure TDropDownListBox.HandleEvent(var Event: TEvent);
  1835. var DontClear: boolean;
  1836. Count: sw_integer;
  1837. begin
  1838. case Event.What of
  1839. evKeyDown :
  1840. if GetState(sfFocused) then
  1841. begin
  1842. DontClear:=false;
  1843. Count:=GetItemCount;
  1844. if Count>0 then
  1845. case Event.KeyCode of
  1846. kbUp :
  1847. if Focused>0 then
  1848. FocusItem(Focused-1);
  1849. kbDown :
  1850. if Focused<Count-1 then
  1851. FocusItem(Focused+1);
  1852. kbHome :
  1853. FocusItem(0);
  1854. kbEnd :
  1855. FocusItem(Count-1);
  1856. kbPgDn :
  1857. DropList(true);
  1858. else DontClear:=true;
  1859. end;
  1860. if DontClear=false then ClearEvent(Event);
  1861. end;
  1862. evBroadcast :
  1863. case Event.Command of
  1864. { cmReleasedFocus :
  1865. if (ListBox<>nil) and (Event.InfoPtr=ListBox) then
  1866. DropList(false);}
  1867. cmListItemSelected :
  1868. if (ListBox<>nil) and (Event.InfoPtr=ListBox) then
  1869. begin
  1870. FocusItem(ListBox^.Focused);
  1871. Text:=GetText(List^.At(Focused),High(Text));
  1872. DrawView;
  1873. DropList(false);
  1874. end;
  1875. end;
  1876. evMouseDown :
  1877. if MouseInView(Event.Where) then
  1878. begin
  1879. DropList(not ListDropped);
  1880. ClearEvent(Event);
  1881. end;
  1882. end;
  1883. inherited HandleEvent(Event);
  1884. end;
  1885. function TDropDownListBox.GetText(Item: pointer; MaxLen: Sw_integer): string;
  1886. var S: string;
  1887. begin
  1888. S:=GetStr(Item);
  1889. GetText:=copy(S,1,MaxLen);
  1890. end;
  1891. procedure TDropDownListBox.NewList(AList: PCollection);
  1892. begin
  1893. if List<>nil then Dispose(List, Done); List:=nil;
  1894. List:=AList; FocusItem(0);
  1895. end;
  1896. procedure TDropDownListBox.CreateListBox(var R: TRect);
  1897. var R2: TRect;
  1898. begin
  1899. R2.Copy(R); R2.A.X:=R2.B.X-1;
  1900. New(SB, Init(R2));
  1901. Dec(R.B.X);
  1902. New(ListBox, Init(@Self,R,1,SB));
  1903. end;
  1904. procedure TDropDownListBox.DropList(Drop: boolean);
  1905. var R: TRect;
  1906. LB: PListBox;
  1907. begin
  1908. if (ListDropped=Drop) then Exit;
  1909. if Drop then
  1910. begin
  1911. R.Assign(Origin.X+1,Origin.Y+Size.Y,Origin.X+Size.X,Origin.Y+Size.Y+DropLineCount);
  1912. if Owner<>nil then Owner^.Lock;
  1913. CreateListBox(R);
  1914. if SB<>nil then
  1915. Owner^.Insert(SB);
  1916. if ListBox<>nil then
  1917. begin
  1918. ListBox^.NewList(List);
  1919. ListBox^.FocusItem(Focused);
  1920. Owner^.Insert(ListBox);
  1921. end;
  1922. if Owner<>nil then Owner^.UnLock;
  1923. end
  1924. else
  1925. begin
  1926. if Owner<>nil then Owner^.Lock;
  1927. if ListBox<>nil then
  1928. begin
  1929. { ListBox^.List:=nil;}
  1930. LB:=ListBox; ListBox:=nil; { this prevents GPFs while deleting }
  1931. Dispose(LB, Done);
  1932. end;
  1933. if SB<>nil then
  1934. begin
  1935. Dispose(SB, Done);
  1936. SB:=nil;
  1937. end;
  1938. Select;
  1939. if Owner<>nil then Owner^.UnLock;
  1940. end;
  1941. ListDropped:=Drop;
  1942. DrawView;
  1943. end;
  1944. function TDropDownListBox.GetItemCount: sw_integer;
  1945. var Count: sw_integer;
  1946. begin
  1947. if assigned(List)=false then Count:=0 else
  1948. Count:=List^.Count;
  1949. GetItemCount:=Count;
  1950. end;
  1951. procedure TDropDownListBox.FocusItem(Item: sw_integer);
  1952. var P: pointer;
  1953. begin
  1954. Focused:=Item;
  1955. if assigned(ListBox) and (Item>=0) then
  1956. ListBox^.FocusItem(Item);
  1957. if (GetItemCount>0) and (Focused>=0) then
  1958. begin
  1959. P:=List^.At(Focused);
  1960. Text:=GetText(P,Size.X-4);
  1961. end;
  1962. DrawView;
  1963. end;
  1964. function TDropDownListBox.LBGetLocalMenu: PMenu;
  1965. begin
  1966. LBGetLocalMenu:=nil;
  1967. end;
  1968. function TDropDownListBox.LBGetCommandTarget: PView;
  1969. begin
  1970. LBGetCommandTarget:=@Self;
  1971. end;
  1972. procedure TDropDownListBox.SetState(AState: Word; Enable: Boolean);
  1973. begin
  1974. inherited SetState(AState,Enable);
  1975. if (AState and (sfSelected + sfActive + sfFocused)) <> 0 then DrawView;
  1976. end;
  1977. procedure TDropDownListBox.Draw;
  1978. var B: TDrawBuffer;
  1979. C,TextC: word;
  1980. LC: char;
  1981. begin
  1982. if GetState(sfFocused)=false then
  1983. begin
  1984. C:=GetColor(2);
  1985. TextC:=GetColor(2);
  1986. end
  1987. else
  1988. begin
  1989. C:=GetColor(3);
  1990. TextC:=GetColor(3);
  1991. end;
  1992. MoveChar(B,' ',C,Size.X);
  1993. MoveStr(B[1],copy(Text,1,Size.X-2),TextC);
  1994. if ListDropped then LC:=#30 else LC:=#31;
  1995. MoveChar(B[Size.X-2],LC,C,1);
  1996. WriteLine(0,0,Size.X,Size.Y,B);
  1997. end;
  1998. function TDropDownListBox.GetPalette: PPalette;
  1999. const P: string[length(CListViewer)] = CListViewer;
  2000. begin
  2001. GetPalette:=@P;
  2002. end;
  2003. destructor TDropDownListBox.Done;
  2004. begin
  2005. if ListDropped then DropList(false);
  2006. inherited Done;
  2007. end;
  2008. constructor TGroupView.Init(var Bounds: TRect; AText: String; ALink: PView);
  2009. begin
  2010. inherited Init(Bounds,AText,ALink);
  2011. end;
  2012. procedure TGroupView.Draw;
  2013. var B: TDrawBuffer;
  2014. FrameC,LabelC: word;
  2015. begin
  2016. FrameC:=GetColor(1);
  2017. if Light then
  2018. LabelC:=GetColor(2)+GetColor(4) shl 8
  2019. else
  2020. LabelC:=GetColor(1)+GetColor(3) shl 8;
  2021. { First Line }
  2022. MoveChar(B[0],'Ú',FrameC,1);
  2023. MoveChar(B[1],'Ä',FrameC,Size.X-2);
  2024. MoveChar(B[Size.X-1],'¿',FrameC,1);
  2025. if Text<>nil then
  2026. begin
  2027. MoveCStr(B[1],' '+Text^+' ',LabelC);
  2028. end;
  2029. WriteLine(0,0,Size.X,1,B);
  2030. { Mid Lines }
  2031. MoveChar(B[0],'³',FrameC,1);
  2032. MoveChar(B[1],' ',FrameC,Size.X-2);
  2033. MoveChar(B[Size.X-1],'³',FrameC,1);
  2034. WriteLine(0,1,Size.X,Size.Y-2,B);
  2035. { Last Line }
  2036. MoveChar(B[0],'À',FrameC,1);
  2037. MoveChar(B[1],'Ä',FrameC,Size.X-2);
  2038. MoveChar(B[Size.X-1],'Ù',FrameC,1);
  2039. WriteLine(0,Size.Y-1,Size.X,1,B);
  2040. end;
  2041. function TPlainCheckBoxes.GetPalette: PPalette;
  2042. const P: string[length(CPlainCluster)] = CPlainCluster;
  2043. begin
  2044. GetPalette:=@P;
  2045. end;
  2046. function TPlainRadioButtons.GetPalette: PPalette;
  2047. const P: string[length(CPlainCluster)] = CPlainCluster;
  2048. begin
  2049. GetPalette:=@P;
  2050. end;
  2051. constructor TAdvancedListBox.Load(var S: TStream);
  2052. begin
  2053. inherited Load(S);
  2054. S.Read(Default,SizeOf(Default));
  2055. end;
  2056. procedure TAdvancedListBox.Store(var S: TStream);
  2057. begin
  2058. inherited Store(S);
  2059. S.Write(Default,SizeOf(Default));
  2060. end;
  2061. procedure TNoUpdateButton.HandleEvent(var Event: TEvent);
  2062. begin
  2063. if (Event.What<>evBroadcast) or (Event.Command<>cmCommandSetChanged) then
  2064. inherited HandleEvent(Event);
  2065. end;
  2066. constructor TPanel.Init(var Bounds: TRect);
  2067. begin
  2068. inherited Init(Bounds);
  2069. Options:=Options or (ofSelectable+ofTopSelect);
  2070. GrowMode:=gfGrowHiX+gfGrowHiY;
  2071. end;
  2072. procedure TAdvMessageBox.HandleEvent(var Event: TEvent);
  2073. var I: integer;
  2074. begin
  2075. if (not CanCancel) and (Event.What=evCommand) and (Event.Command=cmCancel) then
  2076. ClearEvent(Event);
  2077. inherited HandleEvent(Event);
  2078. case Event.What of
  2079. evCommand:
  2080. begin
  2081. for I:=Low(UserButtonCmd) to High(UserButtonCmd) do
  2082. if Event.Command=UserButtonCmd[I] then
  2083. if State and sfModal <> 0 then
  2084. begin
  2085. EndModal(Event.Command);
  2086. ClearEvent(Event);
  2087. end;
  2088. end;
  2089. end;
  2090. end;
  2091. procedure ClearFormatParams;
  2092. begin
  2093. FormatParamCount:=0; FillChar(FormatParams,sizeof(FormatParams),0);
  2094. FormatParamStrCount:=0;
  2095. end;
  2096. procedure AddFormatParam(P: pointer);
  2097. begin
  2098. AddFormatParamInt(longint(P));
  2099. end;
  2100. procedure AddFormatParamInt(L: longint);
  2101. begin
  2102. Inc(FormatParamCount);
  2103. FormatParams[FormatParamCount]:=L;
  2104. end;
  2105. procedure AddFormatParamChar(C: char);
  2106. begin
  2107. AddFormatParamInt(ord(C));
  2108. end;
  2109. procedure AddFormatParamStr(const S: string);
  2110. begin
  2111. Inc(FormatParamStrCount); FormatParamStrs[FormatParamStrCount]:=S;
  2112. AddFormatParam(@FormatParamStrs[FormatParamStrCount]);
  2113. end;
  2114. function FormatStrF(const Format: string; var Params): string;
  2115. var S: string;
  2116. begin
  2117. S:='';
  2118. FormatStr(S,Format,Params);
  2119. FormatStrF:=S;
  2120. end;
  2121. function FormatStrStr(const Format, Param: string): string;
  2122. var S: string;
  2123. P: pointer;
  2124. begin
  2125. P:=@Param;
  2126. FormatStr(S,Format,P);
  2127. FormatStrStr:=S;
  2128. end;
  2129. function FormatStrStr2(const Format, Param1,Param2: string): string;
  2130. var S: string;
  2131. P: array[1..2] of pointer;
  2132. begin
  2133. P[1]:=@Param1; P[2]:=@Param2;
  2134. FormatStr(S,Format,P);
  2135. FormatStrStr2:=S;
  2136. end;
  2137. function FormatStrStr3(const Format, Param1,Param2,Param3: string): string;
  2138. var S: string;
  2139. P: array[1..3] of pointer;
  2140. begin
  2141. P[1]:=@Param1; P[2]:=@Param2; P[3]:=@Param3;
  2142. FormatStr(S,Format,P);
  2143. FormatStrStr3:=S;
  2144. end;
  2145. function FormatStrInt(const Format: string; L: longint): string;
  2146. var S: string;
  2147. begin
  2148. FormatStr(S,Format,L);
  2149. FormatStrInt:=S;
  2150. end;
  2151. const
  2152. Cmds: array[0..3] of word =
  2153. (cmYes, cmNo, cmOK, cmCancel);
  2154. var
  2155. ButtonName: array[0..3] of string;
  2156. Titles: array[0..3] of string;
  2157. function AdvMessageBox(const Msg: String; Params: Pointer; AOptions: longint): Word;
  2158. var
  2159. R: TRect;
  2160. begin
  2161. R.Assign(0, 0, 0, 0);
  2162. AdvMessageBox := AdvMessageBoxRect(R, Msg, Params, AOptions);
  2163. end;
  2164. procedure GetStaticTextDimensions(const S: string; ViewWidth: integer; var MaxCols, Rows: integer);
  2165. var
  2166. Color: Byte;
  2167. Center: Boolean;
  2168. I, J, L, P, Y: Sw_Integer;
  2169. CurLine: string;
  2170. begin
  2171. MaxCols:=0;
  2172. L := Length(S);
  2173. P := 1;
  2174. Y := 0;
  2175. Center := False;
  2176. while (Y < 32767) and (P<=length(S)) do
  2177. begin
  2178. CurLine:='';
  2179. if P <= L then
  2180. begin
  2181. if S[P] = #3 then
  2182. begin
  2183. Center := True;
  2184. Inc(P);
  2185. end;
  2186. I := P;
  2187. repeat
  2188. J := P;
  2189. while (P <= L) and (S[P] = ' ') do Inc(P);
  2190. while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do Inc(P);
  2191. until (P > L) or (P >= I + ViewWidth) or (S[P] = #13);
  2192. if P > I + ViewWidth then
  2193. if J > I then P := J else P := I + ViewWidth;
  2194. if Center then J := (ViewWidth - P + I) div 2 else J := 0;
  2195. CurLine:=CurLine+copy(S,I,P-I);
  2196. { MoveBuf(B[J], S[I], Color, P - I);}
  2197. while (P <= L) and (S[P] = ' ') do Inc(P);
  2198. if (P <= L) and (S[P] = #13) then
  2199. begin
  2200. Center := False;
  2201. Inc(P);
  2202. if (P <= L) and (S[P] = #10) then Inc(P);
  2203. end;
  2204. end;
  2205. if length(CurLine)>MaxCols then
  2206. MaxCols:=length(CurLine);
  2207. { WriteLine(0, Y, Size.X, 1, B);}
  2208. Inc(Y);
  2209. end;
  2210. Rows:=Y;
  2211. end;
  2212. function AdvMessageBoxRect(var R: TRect; const Msg: String; Params: Pointer; AOptions: longint): Word;
  2213. var
  2214. I, X, ButtonCount: Sw_Integer;
  2215. Dialog: PAdvMessageBox;
  2216. Control: PView;
  2217. ButtonList: array[0..4] of PView;
  2218. S,BtnName: String;
  2219. Cols,Rows: integer;
  2220. begin
  2221. FormatStr(S, Msg, Params^);
  2222. if R.Empty then
  2223. begin
  2224. GetStaticTextDimensions(S,40,Cols,Rows);
  2225. if Cols<30 then Cols:=30; if Rows=0 then Rows:=1;
  2226. R.Assign(0,0,3+Cols+3,Rows+6);
  2227. if (AOptions and mfInsertInApp)= 0 then
  2228. R.Move((Desktop^.Size.X-(R.B.X-R.A.X)) div 2,(Desktop^.Size.Y-(R.B.Y-R.A.Y)) div 2)
  2229. else
  2230. R.Move((Application^.Size.X-(R.B.X-R.A.X)) div 2,(Application^.Size.Y-(R.B.Y-R.A.Y)) div 2);
  2231. end;
  2232. New(Dialog,Init(R, Titles[AOptions and $3]));
  2233. with Dialog^ do
  2234. begin
  2235. CanCancel:=(Options and mfCantCancel)=0;
  2236. R.Assign(3,2, Size.X-2,Size.Y-3);
  2237. Control := New(PStaticText, Init(R, S));
  2238. Insert(Control);
  2239. X := -2;
  2240. ButtonCount := 0;
  2241. for I := 0 to 3 do
  2242. if AOptions and ($10000 shl I) <> 0 then
  2243. begin
  2244. BtnName:=UserButtonName[I+1];
  2245. R.Assign(0, 0, Max(10,length(BtnName)+2), 2);
  2246. Control := New(PButton, Init(R, BtnName, UserButtonCmd[I+1], bfNormal));
  2247. Inc(X, Control^.Size.X + 2);
  2248. ButtonList[ButtonCount] := Control;
  2249. Inc(ButtonCount);
  2250. end;
  2251. for I := 0 to 3 do
  2252. if AOptions and ($0100 shl I) <> 0 then
  2253. begin
  2254. R.Assign(0, 0, 10, 2);
  2255. Control := New(PButton, Init(R, ButtonName[I], Cmds[i], bfNormal));
  2256. Inc(X, Control^.Size.X + 2);
  2257. ButtonList[ButtonCount] := Control;
  2258. Inc(ButtonCount);
  2259. end;
  2260. X := (Size.X - X) div 2;
  2261. for I := 0 to ButtonCount - 1 do
  2262. begin
  2263. Control := ButtonList[I];
  2264. Insert(Control);
  2265. Control^.MoveTo(X, Size.Y - 3);
  2266. Inc(X, Control^.Size.X + 2);
  2267. end;
  2268. SelectNext(False);
  2269. end;
  2270. if AOptions and mfInsertInApp = 0 then
  2271. AdvMessageBoxRect := DeskTop^.ExecView(Dialog)
  2272. else
  2273. AdvMessageBoxRect := Application^.ExecView(Dialog);
  2274. Dispose(Dialog, Done);
  2275. end;
  2276. procedure InitAdvMsgBox;
  2277. begin
  2278. ButtonName[0] := Labels^.Get(slYes);
  2279. ButtonName[1] := Labels^.Get(slNo);
  2280. ButtonName[2] := Labels^.Get(slOk);
  2281. ButtonName[3] := Labels^.Get(slCancel);
  2282. Titles[0] := Labels^.Get(sWarning);
  2283. Titles[1] := Labels^.Get(sError);
  2284. Titles[2] := Labels^.Get(sInformation);
  2285. Titles[3] := Labels^.Get(sConfirm);
  2286. end;
  2287. procedure DoneAdvMsgBox;
  2288. begin
  2289. end;
  2290. procedure RegisterWViews;
  2291. begin
  2292. {$ifndef NOOBJREG}
  2293. RegisterType(RAdvancedListBox);
  2294. RegisterType(RColorStaticText);
  2295. RegisterType(RHSListBox);
  2296. RegisterType(RDlgWindow);
  2297. {$endif}
  2298. end;
  2299. END.
  2300. {
  2301. $Log$
  2302. Revision 1.2 2001-08-05 02:01:49 peter
  2303. * FVISION define to compile with fvision units
  2304. Revision 1.1 2001/08/04 11:30:26 peter
  2305. * ide works now with both compiler versions
  2306. Revision 1.1.2.8 2001/03/20 00:13:54 pierre
  2307. * correct mouse behavior in TAdvancedListBox
  2308. Revision 1.1.2.7 2001/03/08 16:35:23 pierre
  2309. * set step size for list scrollbars
  2310. Revision 1.1.2.6 2000/11/29 18:28:54 pierre
  2311. + add save to file capability for list boxes
  2312. Revision 1.1.2.5 2000/11/29 11:24:45 pierre
  2313. * cmSearchWindow removed from wviews
  2314. Revision 1.1.2.4 2000/11/29 00:54:45 pierre
  2315. + preserve window number and save special windows
  2316. Revision 1.1.2.3 2000/10/24 00:21:59 pierre
  2317. * fix the greyed save after window list box
  2318. Revision 1.1.2.2 2000/08/16 18:46:15 peter
  2319. [*] double clicking on a droplistbox caused GPF (due to invalid recurson)
  2320. [*] Make, Build now possible even in Compiler Messages Window
  2321. [+] when started in a new dir the IDE now ask whether to create a local
  2322. config, or to use the one located in the IDE dir
  2323. Revision 1.1.2.1 2000/08/04 14:05:20 michael
  2324. * Fixes from Gabor:
  2325. [*] the IDE now doesn't disable Compile|Make & Build when all windows
  2326. are closed, but there's still a primary file set
  2327. (set bug 1059 to fixed!)
  2328. [*] the IDE didn't read some compiler options correctly back from the
  2329. FP.CFG file, for ex. the linker options. Now it read everything
  2330. correctly, and also automatically handles smartlinking option synch-
  2331. ronization.
  2332. (set bug 1048 to fixed!)
  2333. Revision 1.1 2000/07/13 09:48:37 michael
  2334. + Initial import
  2335. Revision 1.15 2000/06/22 09:07:15 pierre
  2336. * Gabor changes: see fixes.txt
  2337. Revision 1.14 2000/06/16 08:50:45 pierre
  2338. + new bunch of Gabor's changes
  2339. Revision 1.13 2000/05/02 08:42:29 pierre
  2340. * new set of Gabor changes: see fixes.txt
  2341. Revision 1.12 2000/04/18 11:42:39 pierre
  2342. lot of Gabor changes : see fixes.txt
  2343. Revision 1.11 2000/01/10 15:53:37 pierre
  2344. * WViews objects were not registered
  2345. Revision 1.10 1999/08/03 20:22:46 peter
  2346. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  2347. + Desktop saving should work now
  2348. - History saved
  2349. - Clipboard content saved
  2350. - Desktop saved
  2351. - Symbol info saved
  2352. * syntax-highlight bug fixed, which compared special keywords case sensitive
  2353. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  2354. * with 'whole words only' set, the editor didn't found occourences of the
  2355. searched text, if the text appeared previously in the same line, but didn't
  2356. satisfied the 'whole-word' condition
  2357. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  2358. (ie. the beginning of the selection)
  2359. * when started typing in a new line, but not at the start (X=0) of it,
  2360. the editor inserted the text one character more to left as it should...
  2361. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  2362. * Shift shouldn't cause so much trouble in TCodeEditor now...
  2363. * Syntax highlight had problems recognizing a special symbol if it was
  2364. prefixed by another symbol character in the source text
  2365. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  2366. Revision 1.9 1999/06/28 19:32:37 peter
  2367. * fixes from gabor
  2368. Revision 1.8 1999/06/28 12:29:56 pierre
  2369. *GetMenuItem fixed
  2370. Revision 1.7 1999/06/25 00:30:34 pierre
  2371. + TAdvancedMenuBar.GetMenuItem(by command number)
  2372. Revision 1.6 1999/04/07 21:56:07 peter
  2373. + object support for browser
  2374. * html help fixes
  2375. * more desktop saving things
  2376. * NODEBUG directive to exclude debugger
  2377. Revision 1.5 1999/03/23 16:16:44 peter
  2378. * linux fixes
  2379. Revision 1.4 1999/03/23 15:11:42 peter
  2380. * desktop saving things
  2381. * vesa mode
  2382. * preferences dialog
  2383. Revision 1.3 1999/03/19 16:04:35 peter
  2384. * new compiler dialog
  2385. Revision 1.2 1999/03/08 14:58:23 peter
  2386. + prompt with dialogs for tools
  2387. Revision 1.1 1999/03/01 15:51:43 peter
  2388. + Log
  2389. }