123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156 |
- {
- $Id$
- This file is part of the Free Pascal Integrated Development Environment
- Copyright (c) 1998 by Berczi Gabor
- Views and view-related functions for the IDE
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit FPViews;
- interface
- uses
- Dos,Objects,Drivers,Commands,HelpCtx,Views,Menus,Dialogs,App,
- {$ifdef EDITORS}
- Editors,
- {$else}
- WEditor,
- {$endif}
- WHlpView,
- Comphook,
- FPConst,FPUsrScr;
- type
- {$IFNDEF EDITORS}
- TEditor = TCodeEditor; PEditor = PCodeEditor;
- {$ENDIF}
- PCenterDialog = ^TCenterDialog;
- TCenterDialog = object(TDialog)
- constructor Init(var Bounds: TRect; ATitle: TTitleStr);
- end;
- PIntegerLine = ^TIntegerLine;
- TIntegerLine = object(TInputLine)
- constructor Init(var Bounds: TRect; AMin, AMax: longint);
- end;
- TFPWindow = object(TWindow)
- procedure HandleEvent(var Event: TEvent); virtual;
- end;
- PIDEHelpWindow = ^TIDEHelpWindow;
- TIDEHelpWindow = object(THelpWindow)
- function GetPalette: PPalette; virtual;
- end;
- PSourceEditor = ^TSourceEditor;
- TSourceEditor = object(TFileEditor)
- {$ifndef EDITORS}
- function IsReservedWord(const S: string): boolean; virtual;
- function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
- function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
- {$endif}
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure LocalMenu(P: TPoint); virtual;
- function GetLocalMenu: PMenu; virtual;
- function GetCommandTarget: PView; virtual;
- private
- LastLocalCmd : word;
- end;
- PSourceWindow = ^TSourceWindow;
- TSourceWindow = object(TFPWindow)
- Editor : PSourceEditor;
- Indicator : PIndicator;
- constructor Init(var Bounds: TRect; AFileName: string);
- procedure SetTitle(ATitle: string); virtual;
- procedure UpdateTitle; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure SetState(AState: Word; Enable: Boolean); virtual;
- procedure Update; virtual;
- procedure UpdateCommands; virtual;
- function GetPalette: PPalette; virtual;
- destructor Done; virtual;
- end;
- PClipboardWindow = ^TClipboardWindow;
- TClipboardWindow = object(TSourceWindow)
- constructor Init;
- procedure Close; virtual;
- destructor Done; virtual;
- end;
- PAdvancedMenuBox = ^TAdvancedMenuBox;
- TAdvancedMenuBox = object(TMenuBox)
- function NewSubView(var Bounds: TRect; AMenu: PMenu;
- AParentMenu: PMenuView): PMenuView; virtual;
- function Execute: Word; virtual;
- end;
- PAdvancedMenuPopUp = ^TAdvancedMenuPopup;
- TAdvancedMenuPopUp = object(TMenuPopup)
- function NewSubView(var Bounds: TRect; AMenu: PMenu;
- AParentMenu: PMenuView): PMenuView; virtual;
- function Execute: Word; virtual;
- end;
- PAdvancedMenuBar = ^TAdvancedMenuBar;
- TAdvancedMenuBar = object(TMenuBar)
- constructor Init(var Bounds: TRect; AMenu: PMenu);
- function NewSubView(var Bounds: TRect; AMenu: PMenu;
- AParentMenu: PMenuView): PMenuView; virtual;
- procedure Update; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- function Execute: Word; virtual;
- end;
- PAdvancedStaticText = ^TAdvancedStaticText;
- TAdvancedStaticText = object(TStaticText)
- procedure SetText(S: string); virtual;
- end;
- PAdvancedListBox = ^TAdvancedListBox;
- TAdvancedListBox = object(TListBox)
- Default: boolean;
- procedure HandleEvent(var Event: TEvent); virtual;
- end;
- TLocalMenuListBox = object(TAdvancedListBox)
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure LocalMenu(P: TPoint); virtual;
- function GetLocalMenu: PMenu; virtual;
- function GetCommandTarget: PView; virtual;
- private
- LastLocalCmd: word;
- end;
- PColorStaticText = ^TColorStaticText;
- TColorStaticText = object(TAdvancedStaticText)
- Color: word;
- DontWrap: boolean;
- Delta: TPoint;
- constructor Init(var Bounds: TRect; AText: String; AColor: word);
- procedure Draw; virtual;
- end;
- PUnsortedStringCollection = ^TUnsortedStringCollection;
- TUnsortedStringCollection = object(TCollection)
- function At(Index: Integer): PString;
- procedure FreeItem(Item: Pointer); virtual;
- end;
- PHSListBox = ^THSListBox;
- THSListBox = object(TLocalMenuListBox)
- constructor Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
- end;
- PDlgWindow = ^TDlgWindow;
- TDlgWindow = object(TDialog)
- constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
- end;
- PAdvancedStatusLine = ^TAdvancedStatusLine;
- TAdvancedStatusLine = object(TStatusLine)
- StatusText: PString;
- function GetStatusText: string; virtual;
- procedure SetStatusText(S: string); virtual;
- procedure ClearStatusText; virtual;
- procedure Draw; virtual;
- end;
- PMessageItem = ^TMessageItem;
- TMessageItem = object(TObject)
- TClass : longint;
- Text : PString;
- Module : PString;
- ID : longint;
- constructor Init(AClass: longint; AText, AModule: string; AID: longint);
- function GetText(MaxLen: integer): string; virtual;
- procedure Selected; virtual;
- function GetModuleName: string; virtual;
- destructor Done; virtual;
- end;
- PMessageListBox = ^TMessageListBox;
- TMessageListBox = object(THSListBox)
- Transparent: boolean;
- NoSelection: boolean;
- MaxWidth: integer;
- constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- procedure AddItem(P: PMessageItem); virtual;
- function GetText(Item: Integer; MaxLen: Integer): String; virtual;
- procedure Clear; virtual;
- procedure TrackSource; virtual;
- procedure GotoSource; virtual;
- procedure Draw; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- function GetLocalMenu: PMenu; virtual;
- destructor Done; virtual;
- end;
- PCompilerMessage = ^TCompilerMessage;
- TCompilerMessage = object(TMessageItem)
- function GetText(MaxLen: Integer): String; virtual;
- end;
- PProgramInfoWindow = ^TProgramInfoWindow;
- TProgramInfoWindow = object(TDlgWindow)
- InfoST: PColorStaticText;
- LogLB : PMessageListBox;
- constructor Init;
- procedure AddMessage(AClass: longint; Msg, Module: string; Line: longint);
- procedure SizeLimits(var Min, Max: TPoint); virtual;
- procedure Close; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure Update; virtual;
- destructor Done; virtual;
- end;
- PTabItem = ^TTabItem;
- TTabItem = record
- Next : PTabItem;
- View : PView;
- Dis : boolean;
- end;
- PTabDef = ^TTabDef;
- TTabDef = record
- Next : PTabDef;
- Name : PString;
- Items : PTabItem;
- DefItem : PView;
- ShortCut : char;
- end;
- PTab = ^TTab;
- TTab = object(TGroup)
- TabDefs : PTabDef;
- ActiveDef : integer;
- DefCount : word;
- constructor Init(var Bounds: TRect; ATabDef: PTabDef);
- function AtTab(Index: integer): PTabDef; virtual;
- procedure SelectTab(Index: integer); virtual;
- function TabCount: integer;
- function Valid(Command: Word): Boolean; virtual;
- procedure ChangeBounds(var Bounds: TRect); virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- function GetPalette: PPalette; virtual;
- procedure Draw; virtual;
- procedure SetState(AState: Word; Enable: Boolean); virtual;
- destructor Done; virtual;
- private
- InDraw: boolean;
- end;
- PScreenView = ^TScreenView;
- TScreenView = object(TScroller)
- Screen: PScreen;
- constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
- AScreen: PScreen);
- procedure Draw; virtual;
- procedure Update; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- end;
- PScreenWindow = ^TScreenWindow;
- TScreenWindow = object(TFPWindow)
- ScreenView : PScreenView;
- constructor Init(AScreen: PScreen; ANumber: integer);
- destructor Done; virtual;
- end;
- function SearchFreeWindowNo: integer;
- procedure InsertOK(ADialog: PDialog);
- procedure InsertButtons(ADialog: PDialog);
- procedure ErrorBox(S: string; Params: pointer);
- procedure WarningBox(S: string; Params: pointer);
- procedure InformationBox(S: string; Params: pointer);
- function ConfirmBox(S: string; Params: pointer; CanCancel: boolean): word;
- function IsThereAnyEditor: boolean;
- function IsThereAnyWindow: boolean;
- function FirstEditorWindow: PSourceWindow;
- function EditorWindowFile(const Name : String): PSourceWindow;
- function SearchMenuItem(Menu: PMenu; Cmd: word): PMenuItem;
- procedure SetMenuItemParam(Menu: PMenuItem; Param: string);
- function IsSubMenu(P: PMenuItem): boolean;
- function IsSeparator(P: PMenuItem): boolean;
- function UpdateMenu(M: PMenu): boolean;
- function SearchSubMenu(M: PMenu; Index: integer): PMenuItem;
- procedure AppendMenuItem(M: PMenu; I: PMenuItem);
- procedure RemoveMenuItem(Menu: PMenu; I: PMenuItem);
- function GetMenuItemBefore(Menu:PMenu; BeforeOf: PMenuItem): PMenuItem;
- function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
- procedure DisposeTabItem(P: PTabItem);
- function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
- procedure DisposeTabDef(P: PTabDef);
- function GetEditorCurWord(Editor: PEditor): string;
- procedure InitReservedWords;
- procedure DoneReservedWords;
- procedure TranslateMouseClick(View: PView; var Event: TEvent);
- function GetNextEditorBounds(var Bounds: TRect): boolean;
- function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: integer): PSourceWindow;
- function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: integer): PSourceWindow;
- const
- SourceCmds : TCommandSet =
- ([cmSave,cmSaveAs,cmCompile]);
- EditorCmds : TCommandSet =
- ([cmFind,cmReplace,cmSearchAgain,cmJumpLine,cmHelpTopicSearch]);
- CompileCmds : TCommandSet =
- ([cmMake,cmBuild,cmRun]);
- CalcClipboard : extended = 0;
- OpenFileName : string = '';
- OpenFileLastExt : string = '*.pas';
- NewEditorOpened: boolean = false;
- var MsgParms : array[1..10] of
- record
- case byte of
- 0 : (Ptr : pointer);
- 1 : (Long: longint);
- end;
- implementation
- uses
- Keyboard,Memory,MsgBox,Validate,
- Tokens,FPSwitch,FPSymbol,FPDebug,
- FPVars,FPUtils,FPHelp,FPCompile;
- const
- NoNameCount : integer = 0;
- ReservedWords : PUnsortedStringCollection = nil;
- function IsThereAnyEditor: boolean;
- function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
- begin
- EditorWindow:=(P^.HelpCtx=hcSourceWindow);
- end;
- begin
- IsThereAnyEditor:=Desktop^.FirstThat(@EditorWindow)<>nil;
- end;
- function IsThereAnyHelpWindow: boolean;
- begin
- IsThereAnyHelpWindow:=(HelpWindow<>nil) and (HelpWindow^.GetState(sfVisible));
- end;
- function IsThereAnyWindow: boolean;
- var _Is: boolean;
- begin
- _Is:=Message(Desktop,evBroadcast,cmSearchWindow,nil)<>nil;
- _Is:=_Is or ( (ClipboardWindow<>nil) and ClipboardWindow^.GetState(sfVisible));
- IsThereAnyWindow:=_Is;
- end;
- function FirstEditorWindow: PSourceWindow;
- function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
- begin
- EditorWindow:=(P^.HelpCtx=hcSourceWindow);
- end;
- begin
- FirstEditorWindow:=pointer(Desktop^.FirstThat(@EditorWindow));
- end;
- function EditorWindowFile(const Name : String): PSourceWindow;
- function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
- begin
- EditorWindow:=(TypeOf(P^)=TypeOf(TSourceWindow)) and
- (PSourceWindow(P)^.Editor^.FileName=Name);
- end;
- begin
- EditorWindowFile:=pointer(Desktop^.FirstThat(@EditorWindow));
- end;
- procedure InsertButtons(ADialog: PDialog);
- var R : TRect;
- W,H : integer;
- X : integer;
- X1,X2: Sw_integer;
- begin
- with ADialog^ do
- begin
- GetExtent(R);
- W:=R.B.X-R.A.X; H:=(R.B.Y-R.A.Y);
- R.Assign(0,0,W,H+3); ChangeBounds(R);
- X:=W div 2; X1:=X div 2+1; X2:=X+X1-1;
- R.Assign(X1-3,H,X1+7,H+2);
- Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
- R.Assign(X2-7,H,X2+3,H+2);
- Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
- SelectNext(true);
- end;
- end;
- procedure InsertOK(ADialog: PDialog);
- var BW: Sw_integer;
- R: TRect;
- begin
- with ADialog^ do
- begin
- GetBounds(R); R.Grow(0,1); Inc(R.B.Y);
- ChangeBounds(R);
- BW:=10;
- R.A.Y:=R.B.Y-2; R.B.Y:=R.A.Y+2;
- R.A.X:=R.A.X+(R.B.X-R.A.X-BW) div 2; R.B.X:=R.A.X+BW;
- Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
- SelectNext(true);
- end;
- end;
- function GetEditorCurWord(Editor: PEditor): string;
- var S: string;
- PS,PE: byte;
- function Trim(S: string): string;
- const TrimChars : set of char = [#0,#9,' ',#255];
- begin
- while (length(S)>0) and (S[1] in TrimChars) do Delete(S,1,1);
- while (length(S)>0) and (S[length(S)] in TrimChars) do Delete(S,length(S),1);
- Trim:=S;
- end;
- const AlphaNum : set of char = ['A'..'Z','0'..'9','_'];
- begin
- with Editor^ do
- begin
- {$ifdef EDITORS}
- S:='';
- {$else}
- S:=GetLineText(CurPos.Y);
- PS:=CurPos.X; while (PS>0) and (Upcase(S[PS]) in AlphaNum) do Dec(PS);
- PE:=CurPos.X; while (PE<length(S)) and (Upcase(S[PE+1]) in AlphaNum) do Inc(PE);
- S:=Trim(copy(S,PS+1,PE-PS));
- {$endif}
- end;
- GetEditorCurWord:=S;
- end;
- {*****************************************************************************
- Tab
- *****************************************************************************}
- function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
- var P: PTabItem;
- begin
- New(P); FillChar(P^,SizeOf(P^),0);
- P^.Next:=ANext; P^.View:=AView;
- NewTabItem:=P;
- end;
- procedure DisposeTabItem(P: PTabItem);
- begin
- if P<>nil then
- begin
- if P^.View<>nil then Dispose(P^.View, Done);
- Dispose(P);
- end;
- end;
- function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
- var P: PTabDef;
- x: byte;
- begin
- New(P);
- P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
- x:=pos('~',AName);
- if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
- else P^.ShortCut:=#0;
- P^.DefItem:=ADefItem;
- NewTabDef:=P;
- end;
- procedure DisposeTabDef(P: PTabDef);
- var PI,X: PTabItem;
- begin
- DisposeStr(P^.Name);
- PI:=P^.Items;
- while PI<>nil do
- begin
- X:=PI^.Next;
- DisposeTabItem(PI);
- PI:=X;
- end;
- Dispose(P);
- end;
- {*****************************************************************************
- Reserved Words
- *****************************************************************************}
- function GetReservedWordCount: integer;
- var
- Count,I: integer;
- begin
- Count:=0;
- for I:=ord(Low(TokenInfo)) to ord(High(TokenInfo)) do
- with TokenInfo[TToken(I)] do
- if (str<>'') and (str[1] in['A'..'Z']) then
- Inc(Count);
- GetReservedWordCount:=Count;
- end;
- function GetReservedWord(Index: integer): string;
- var
- Count,Idx,I: integer;
- S: string;
- begin
- Idx:=-1;
- Count:=-1;
- I:=ord(Low(TokenInfo));
- while (I<=ord(High(TokenInfo))) and (Idx=-1) do
- with TokenInfo[TToken(I)] do
- begin
- if (str<>'') and (str[1] in['A'..'Z']) then
- begin
- Inc(Count);
- if Count=Index then
- Idx:=I;
- end;
- Inc(I);
- end;
- if Idx=-1 then
- S:=''
- else
- S:=TokenInfo[TToken(Idx)].str;
- GetReservedWord:=S;
- end;
- procedure InitReservedWords;
- var S,WordS: string;
- Idx,I: integer;
- begin
- New(ReservedWords, Init(50,10));
- for I:=1 to GetReservedWordCount do
- begin
- WordS:=GetReservedWord(I-1); Idx:=length(WordS);
- while ReservedWords^.Count<Idx do
- ReservedWords^.Insert(NewStr(#0));
- S:=ReservedWords^.At(Idx-1)^;
- ReservedWords^.AtFree(Idx-1);
- ReservedWords^.AtInsert(Idx-1,NewStr(S+WordS+#0));
- end;
- end;
- procedure DoneReservedWords;
- begin
- if assigned(ReservedWords) then
- dispose(ReservedWords,done);
- end;
- function IsFPReservedWord(S: string): boolean;
- var _Is: boolean;
- Idx: integer;
- P: PString;
- begin
- Idx:=length(S); _Is:=false;
- if (Idx>0) and (ReservedWords<>nil) and (ReservedWords^.Count>=Idx) then
- begin
- S:=UpcaseStr(S);
- P:=ReservedWords^.At(Idx-1);
- _Is:=Pos(#0+S+#0,P^)>0;
- end;
- IsFPReservedWord:=_Is;
- end;
- {*****************************************************************************
- SearchWindow
- *****************************************************************************}
- function SearchWindowWithNo(No: integer): PWindow;
- var P: PSourceWindow;
- begin
- P:=Message(Desktop,evBroadcast,cmSearchWindow+No,nil);
- if pointer(P)=pointer(Desktop) then P:=nil;
- SearchWindowWithNo:=P;
- end;
- function SearchFreeWindowNo: integer;
- var No: integer;
- begin
- No:=1;
- while (No<10) and (SearchWindowWithNo(No)<>nil) do
- Inc(No);
- if No=10 then No:=0;
- SearchFreeWindowNo:=No;
- end;
- {*****************************************************************************
- TCenterDialog
- *****************************************************************************}
- constructor TCenterDialog.Init(var Bounds: TRect; ATitle: TTitleStr);
- begin
- inherited Init(Bounds,ATitle);
- Options:=Options or ofCentered;
- end;
- {*****************************************************************************
- TIntegerLine
- *****************************************************************************}
- constructor TIntegerLine.Init(var Bounds: TRect; AMin, AMax: longint);
- begin
- inherited Init(Bounds, Bounds.B.X-Bounds.A.X-1);
- Validator:=New(PRangeValidator, Init(AMin, AMax));
- end;
- {*****************************************************************************
- SourceEditor
- *****************************************************************************}
- {$ifndef EDITORS}
- function TSourceEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
- var Count: integer;
- begin
- case SpecClass of
- ssCommentPrefix : Count:=3;
- ssCommentSuffix : Count:=2;
- ssStringPrefix : Count:=1;
- ssStringSuffix : Count:=1;
- ssAsmPrefix : Count:=1;
- ssAsmSuffix : Count:=1;
- ssDirectivePrefix : Count:=1;
- ssDirectiveSuffix : Count:=1;
- end;
- GetSpecSymbolCount:=Count;
- end;
- function TSourceEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
- var S: string[20];
- begin
- case SpecClass of
- ssCommentPrefix :
- case Index of
- 0 : S:='{';
- 1 : S:='(*';
- 2 : S:='//';
- end;
- ssCommentSuffix :
- case Index of
- 0 : S:='}';
- 1 : S:='*)';
- end;
- ssStringPrefix :
- S:='''';
- ssStringSuffix :
- S:='''';
- ssAsmPrefix :
- S:='asm';
- ssAsmSuffix :
- S:='end';
- ssDirectivePrefix :
- S:='{$';
- ssDirectiveSuffix :
- S:='}';
- end;
- GetSpecSymbol:=S;
- end;
- function TSourceEditor.IsReservedWord(const S: string): boolean;
- begin
- IsReservedWord:=IsFPReservedWord(S);
- end;
- {$endif EDITORS}
- procedure TSourceEditor.LocalMenu(P: TPoint);
- var M: PMenu;
- MV: PAdvancedMenuPopUp;
- R: TRect;
- Re: word;
- begin
- M:=GetLocalMenu;
- if M=nil then Exit;
- if LastLocalCmd<>0 then
- M^.Default:=SearchMenuItem(M,LastLocalCmd);
- Desktop^.GetExtent(R);
- MakeGlobal(P,R.A); {Desktop^.MakeLocal(R.A,R.A);}
- New(MV, Init(R, M));
- Re:=Application^.ExecView(MV);
- if M^.Default=nil then LastLocalCmd:=0
- else LastLocalCmd:=M^.Default^.Command;
- Dispose(MV, Done);
- if Re<>0 then
- Message(GetCommandTarget,evCommand,Re,@Self);
- end;
- function TSourceEditor.GetLocalMenu: PMenu;
- var M: PMenu;
- begin
- M:=NewMenu(
- NewItem('Cu~t~','Shift+Del',kbShiftDel,cmCut,hcCut,
- NewItem('~C~opy','Ctrl+Ins',kbCtrlIns,cmCopy,hcCopy,
- NewItem('~P~aste','Shift+Ins',kbShiftIns,cmPaste,hcPaste,
- NewItem('C~l~ear','Ctrl+Del',kbCtrlDel,cmClear,hcClear,
- NewLine(
- NewItem('Open ~f~ile at cursor','',kbNoKey,cmOpenAtCursor,hcOpenAtCursor,
- NewItem('~B~rowse symbol at cursor','',kbNoKey,cmBrowseAtCursor,hcBrowseAtCursor,
- NewItem('Topic ~s~earch','Ctrl+F1',kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
- NewLine(
- NewItem('~O~ptions...','',kbNoKey,cmEditorOptions,hcEditorOptions,
- nil)))))))))));
- GetLocalMenu:=M;
- end;
- function TSourceEditor.GetCommandTarget: PView;
- begin
- GetCommandTarget:=@Self;
- end;
- procedure TSourceEditor.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- P: TPoint;
- S: string;
- begin
- TranslateMouseClick(@Self,Event);
- case Event.What of
- evMouseDown :
- if MouseInView(Event.Where) and (Event.Buttons=mbRightButton) then
- begin
- MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
- LocalMenu(P);
- ClearEvent(Event);
- end;
- evKeyDown :
- begin
- DontClear:=false;
- case Event.KeyCode of
- kbAltF10 : Message(@Self,evCommand,cmLocalMenu,@Self);
- else DontClear:=true;
- end;
- if DontClear=false then ClearEvent(Event);
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmLocalMenu :
- begin
- P:=CurPos; Inc(P.X); Inc(P.Y);
- LocalMenu(P);
- end;
- cmBrowseAtCursor:
- begin
- S:=LowerCaseStr(GetEditorCurWord(@Self));
- OpenOneSymbolBrowser(S);
- end;
- cmOpenAtCursor :
- begin
- S:=LowerCaseStr(GetEditorCurWord(@Self));
- OpenFileName:=S+'.pp'+ListSeparator+
- S+'.pas'+ListSeparator+
- S+'.inc';
- Message(Application,evCommand,cmOpen,nil);
- end;
- cmEditorOptions :
- Message(Application,evCommand,cmEditorOptions,@Self);
- cmHelp :
- Message(@Self,evCommand,cmHelpTopicSearch,@Self);
- cmHelpTopicSearch :
- HelpTopicSearch(@Self);
- else DontClear:=true;
- end;
- if not DontClear then ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TFPWindow.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evBroadcast :
- case Event.Command of
- cmUpdate :
- ReDraw;
- cmSearchWindow+1..cmSearchWindow+99 :
- if (Event.Command-cmSearchWindow=Number) then
- ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- function TIDEHelpWindow.GetPalette: PPalette;
- const P: string[length(CIDEHelpDialog)] = CIDEHelpDialog;
- begin
- GetPalette:=@P;
- end;
- constructor TSourceWindow.Init(var Bounds: TRect; AFileName: string);
- var HSB,VSB: PScrollBar;
- R: TRect;
- LoadFile: boolean;
- begin
- inherited Init(Bounds,AFileName,SearchFreeWindowNo);
- Options:=Options or ofTileAble;
- GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
- New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
- GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
- New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
- New(Indicator, Init(R));
- Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
- Insert(Indicator);
- GetExtent(R); R.Grow(-1,-1);
- LoadFile:=AFileName<>'';
- if not LoadFile then
- begin SetTitle('noname'+IntToStrZ(NonameCount,2)+'.pas'); Inc(NonameCount); end;
- New(Editor, Init(R, HSB, VSB, Indicator,AFileName));
- Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
- if LoadFile then
- if Editor^.LoadFile=false then
- ErrorBox(#3'Error reading file.',nil);
- Insert(Editor);
- UpdateTitle;
- end;
- procedure TSourceWindow.UpdateTitle;
- var Name: string;
- begin
- if Editor^.FileName<>'' then
- begin Name:=SmartPath(Editor^.FileName); SetTitle(Name); end;
- end;
- procedure TSourceWindow.SetTitle(ATitle: string);
- begin
- if Title<>nil then DisposeStr(Title);
- Title:=NewStr(ATitle);
- Frame^.DrawView;
- end;
- procedure TSourceWindow.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- begin
- case Event.What of
- evBroadcast :
- case Event.Command of
- cmUpdate :
- Update;
- cmUpdateTitle :
- UpdateTitle;
- cmSearchWindow :
- if @Self<>ClipboardWindow then
- ClearEvent(Event);
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmSave :
- if Editor^.IsClipboard=false then
- Editor^.Save;
- cmSaveAs :
- if Editor^.IsClipboard=false then
- Editor^.SaveAs;
- else DontClear:=true;
- end;
- if DontClear=false then ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TSourceWindow.SetState(AState: Word; Enable: Boolean);
- var OldState: word;
- begin
- OldState:=State;
- inherited SetState(AState,Enable);
- if ((AState xor State) and sfActive)<>0 then
- UpdateCommands;
- end;
- procedure TSourceWindow.UpdateCommands;
- var Active: boolean;
- begin
- Active:=GetState(sfActive);
- if Editor^.IsClipboard=false then
- begin
- SetCmdState(SourceCmds+CompileCmds,Active);
- SetCmdState(EditorCmds,Active);
- end;
- if Active=false then
- SetCmdState(ToClipCmds+FromClipCmds+UndoCmds,false);
- end;
- procedure TSourceWindow.Update;
- begin
- ReDraw;
- end;
- function TSourceWindow.GetPalette: PPalette;
- const P: string[length(CSourceWindow)] = CSourceWindow;
- begin
- GetPalette:=@P;
- end;
- destructor TSourceWindow.Done;
- begin
- Message(Application,evBroadcast,cmSourceWndClosing,@Self);
- inherited Done;
- Message(Application,evBroadcast,cmUpdate,@Self);
- end;
- constructor TClipboardWindow.Init;
- var R: TRect;
- HSB,VSB: PScrollBar;
- begin
- Desktop^.GetExtent(R);
- inherited Init(R, '');
- SetTitle('Clipboard');
- HelpCtx:=hcClipboardWindow;
- Number:=wnNoNumber;
- GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
- New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
- GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
- New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
- New(Indicator, Init(R));
- Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
- Insert(Indicator);
- GetExtent(R); R.Grow(-1,-1);
- New(Editor, Init(R, HSB, VSB, Indicator, ''));
- Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
- Insert(Editor);
- Hide;
- Clipboard:=Editor;
- end;
- procedure TClipboardWindow.Close;
- begin
- Hide;
- end;
- destructor TClipboardWindow.Done;
- begin
- inherited Done;
- Clipboard:=nil;
- ClipboardWindow:=nil;
- end;
- function TAdvancedMenuBox.NewSubView(var Bounds: TRect; AMenu: PMenu;
- AParentMenu: PMenuView): PMenuView;
- begin
- NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
- end;
- function TAdvancedMenuBox.Execute: word;
- type
- MenuAction = (DoNothing, DoSelect, DoReturn);
- var
- AutoSelect: Boolean;
- Action: MenuAction;
- Ch: Char;
- Result: Word;
- ItemShown, P: PMenuItem;
- Target: PMenuView;
- R: TRect;
- E: TEvent;
- MouseActive: Boolean;
- function IsDisabled(Item: PMenuItem): boolean;
- var Found: boolean;
- begin
- Found:=Item^.Disabled or IsSeparator(Item);
- if (Found=false) and (IsSubMenu(Item)=false) then
- Found:=CommandEnabled(Item^.Command)=false;
- IsDisabled:=Found;
- end;
- procedure TrackMouse;
- var
- Mouse: TPoint;
- R: TRect;
- OldC: PMenuItem;
- begin
- MakeLocal(E.Where, Mouse);
- OldC:=Current;
- Current := Menu^.Items;
- while Current <> nil do
- begin
- GetItemRect(Current, R);
- if R.Contains(Mouse) then
- begin
- MouseActive := True;
- Break;
- end;
- Current := Current^.Next;
- end;
- if (Current<>nil) and IsDisabled(Current) then
- begin
- Current:={OldC}nil;
- MouseActive:=false;
- end;
- end;
- procedure TrackKey(FindNext: Boolean);
- procedure NextItem;
- begin
- Current := Current^.Next;
- if Current = nil then Current := Menu^.Items;
- end;
- procedure PrevItem;
- var
- P: PMenuItem;
- begin
- P := Current;
- if P = Menu^.Items then P := nil;
- repeat NextItem until Current^.Next = P;
- end;
- begin
- if Current <> nil then
- repeat
- if FindNext then NextItem else PrevItem;
- until (Current^.Name <> nil) and (IsDisabled(Current)=false);
- end;
- function MouseInOwner: Boolean;
- var
- Mouse: TPoint;
- R: TRect;
- begin
- MouseInOwner := False;
- if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
- begin
- ParentMenu^.MakeLocal(E.Where, Mouse);
- ParentMenu^.GetItemRect(ParentMenu^.Current, R);
- MouseInOwner := R.Contains(Mouse);
- end;
- end;
- function MouseInMenus: Boolean;
- var
- P: PMenuView;
- begin
- P := ParentMenu;
- while (P <> nil) and (P^.MouseInView(E.Where)=false) do
- P := P^.ParentMenu;
- MouseInMenus := P <> nil;
- end;
- function TopMenu: PMenuView;
- var
- P: PMenuView;
- begin
- P := @Self;
- while P^.ParentMenu <> nil do P := P^.ParentMenu;
- TopMenu := P;
- end;
- begin
- AutoSelect := False; E.What:=evNothing;
- Result := 0;
- ItemShown := nil;
- Current := Menu^.Default;
- MouseActive := False;
- if UpdateMenu(Menu) then
- begin
- if Current<>nil then
- if Current^.Disabled then
- TrackKey(true);
- repeat
- Action := DoNothing;
- GetEvent(E);
- case E.What of
- evMouseDown:
- if MouseInView(E.Where) or MouseInOwner then
- begin
- TrackMouse;
- if Size.Y = 1 then AutoSelect := True;
- end else Action := DoReturn;
- evMouseUp:
- begin
- TrackMouse;
- if MouseInOwner then
- Current := Menu^.Default
- else
- if (Current <> nil) and (Current^.Name <> nil) then
- Action := DoSelect
- else
- if MouseActive or MouseInView(E.Where) then Action := DoReturn
- else
- begin
- Current := Menu^.Default;
- if Current = nil then Current := Menu^.Items;
- Action := DoNothing;
- end;
- end;
- evMouseMove:
- if E.Buttons <> 0 then
- begin
- TrackMouse;
- if not (MouseInView(E.Where) or MouseInOwner) and
- MouseInMenus then Action := DoReturn;
- end;
- evKeyDown:
- case CtrlToArrow(E.KeyCode) of
- kbUp, kbDown:
- if Size.Y <> 1 then
- TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
- if E.KeyCode = kbDown then AutoSelect := True;
- kbLeft, kbRight:
- if ParentMenu = nil then
- TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
- Action := DoReturn;
- kbHome, kbEnd:
- if Size.Y <> 1 then
- begin
- Current := Menu^.Items;
- if E.KeyCode = kbEnd then TrackKey(False);
- end;
- kbEnter:
- begin
- if Size.Y = 1 then AutoSelect := True;
- Action := DoSelect;
- end;
- kbEsc:
- begin
- Action := DoReturn;
- if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
- ClearEvent(E);
- end;
- else
- Target := @Self;
- Ch := GetAltChar(E.KeyCode);
- if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
- P := Target^.FindItem(Ch);
- if P = nil then
- begin
- P := TopMenu^.HotKey(E.KeyCode);
- if (P <> nil) and CommandEnabled(P^.Command) then
- begin
- Result := P^.Command;
- Action := DoReturn;
- end
- end else
- if Target = @Self then
- begin
- if Size.Y = 1 then AutoSelect := True;
- Action := DoSelect;
- Current := P;
- end else
- if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
- Action := DoReturn;
- end;
- evCommand:
- if E.Command = cmMenu then
- begin
- AutoSelect := False;
- if ParentMenu <> nil then Action := DoReturn;
- end else Action := DoReturn;
- end;
- if ItemShown <> Current then
- begin
- ItemShown := Current;
- DrawView;
- end;
- if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
- if Current <> nil then with Current^ do if Name <> nil then
- if Command = 0 then
- begin
- if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
- GetItemRect(Current, R);
- R.A.X := R.A.X + Origin.X;
- R.A.Y := R.B.Y + Origin.Y;
- R.B := Owner^.Size;
- if Size.Y = 1 then Dec(R.A.X);
- Target := TopMenu^.NewSubView(R, SubMenu, @Self);
- Result := Owner^.ExecView(Target);
- Dispose(Target, Done);
- end else if Action = DoSelect then Result := Command;
- if (Result <> 0) and CommandEnabled(Result) then
- begin
- Action := DoReturn;
- ClearEvent(E);
- end
- else
- Result := 0;
- until Action = DoReturn;
- end;
- if E.What <> evNothing then
- if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
- if Current <> nil then
- begin
- Menu^.Default := Current;
- Current := nil;
- DrawView;
- end;
- Execute := Result;
- end;
- function TAdvancedMenuPopup.NewSubView(var Bounds: TRect; AMenu: PMenu;
- AParentMenu: PMenuView): PMenuView;
- begin
- NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
- end;
- function TAdvancedMenuPopup.Execute: word;
- type
- MenuAction = (DoNothing, DoSelect, DoReturn);
- var
- AutoSelect: Boolean;
- Action: MenuAction;
- Ch: Char;
- Result: Word;
- ItemShown, P: PMenuItem;
- Target: PMenuView;
- R: TRect;
- E: TEvent;
- MouseActive: Boolean;
- function IsDisabled(Item: PMenuItem): boolean;
- var Found: boolean;
- begin
- Found:=Item^.Disabled or IsSeparator(Item);
- if (Found=false) and (IsSubMenu(Item)=false) then
- Found:=CommandEnabled(Item^.Command)=false;
- IsDisabled:=Found;
- end;
- procedure TrackMouse;
- var
- Mouse: TPoint;
- R: TRect;
- OldC: PMenuItem;
- begin
- MakeLocal(E.Where, Mouse);
- OldC:=Current;
- Current := Menu^.Items;
- while Current <> nil do
- begin
- GetItemRect(Current, R);
- if R.Contains(Mouse) then
- begin
- MouseActive := True;
- Break;
- end;
- Current := Current^.Next;
- end;
- if (Current<>nil) and IsDisabled(Current) then
- begin
- Current:={OldC}nil;
- MouseActive:=false;
- end;
- end;
- procedure TrackKey(FindNext: Boolean);
- procedure NextItem;
- begin
- Current := Current^.Next;
- if Current = nil then Current := Menu^.Items;
- end;
- procedure PrevItem;
- var
- P: PMenuItem;
- begin
- P := Current;
- if P = Menu^.Items then P := nil;
- repeat NextItem until Current^.Next = P;
- end;
- begin
- if Current <> nil then
- repeat
- if FindNext then NextItem else PrevItem;
- until (Current^.Name <> nil) and (IsDisabled(Current)=false);
- end;
- function MouseInOwner: Boolean;
- var
- Mouse: TPoint;
- R: TRect;
- begin
- MouseInOwner := False;
- if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
- begin
- ParentMenu^.MakeLocal(E.Where, Mouse);
- ParentMenu^.GetItemRect(ParentMenu^.Current, R);
- MouseInOwner := R.Contains(Mouse);
- end;
- end;
- function MouseInMenus: Boolean;
- var
- P: PMenuView;
- begin
- P := ParentMenu;
- while (P <> nil) and (P^.MouseInView(E.Where)=false) do
- P := P^.ParentMenu;
- MouseInMenus := P <> nil;
- end;
- function TopMenu: PMenuView;
- var
- P: PMenuView;
- begin
- P := @Self;
- while P^.ParentMenu <> nil do P := P^.ParentMenu;
- TopMenu := P;
- end;
- begin
- AutoSelect := False; E.What:=evNothing;
- Result := 0;
- ItemShown := nil;
- Current := Menu^.Default;
- MouseActive := False;
- if UpdateMenu(Menu) then
- begin
- if Current<>nil then
- if Current^.Disabled then
- TrackKey(true);
- repeat
- Action := DoNothing;
- GetEvent(E);
- case E.What of
- evMouseDown:
- if MouseInView(E.Where) or MouseInOwner then
- begin
- TrackMouse;
- if Size.Y = 1 then AutoSelect := True;
- end else Action := DoReturn;
- evMouseUp:
- begin
- TrackMouse;
- if MouseInOwner then
- Current := Menu^.Default
- else
- if (Current <> nil) and (Current^.Name <> nil) then
- Action := DoSelect
- else
- if MouseActive or MouseInView(E.Where) then Action := DoReturn
- else
- begin
- Current := Menu^.Default;
- if Current = nil then Current := Menu^.Items;
- Action := DoNothing;
- end;
- end;
- evMouseMove:
- if E.Buttons <> 0 then
- begin
- TrackMouse;
- if not (MouseInView(E.Where) or MouseInOwner) and
- MouseInMenus then Action := DoReturn;
- end;
- evKeyDown:
- case CtrlToArrow(E.KeyCode) of
- kbUp, kbDown:
- if Size.Y <> 1 then
- TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
- if E.KeyCode = kbDown then AutoSelect := True;
- kbLeft, kbRight:
- if ParentMenu = nil then
- TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
- Action := DoReturn;
- kbHome, kbEnd:
- if Size.Y <> 1 then
- begin
- Current := Menu^.Items;
- if E.KeyCode = kbEnd then TrackKey(False);
- end;
- kbEnter:
- begin
- if Size.Y = 1 then AutoSelect := True;
- Action := DoSelect;
- end;
- kbEsc:
- begin
- Action := DoReturn;
- if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
- ClearEvent(E);
- end;
- else
- Target := @Self;
- Ch := GetAltChar(E.KeyCode);
- if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
- P := Target^.FindItem(Ch);
- if P = nil then
- begin
- P := TopMenu^.HotKey(E.KeyCode);
- if (P <> nil) and CommandEnabled(P^.Command) then
- begin
- Result := P^.Command;
- Action := DoReturn;
- end
- end else
- if Target = @Self then
- begin
- if Size.Y = 1 then AutoSelect := True;
- Action := DoSelect;
- Current := P;
- end else
- if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
- Action := DoReturn;
- end;
- evCommand:
- if E.Command = cmMenu then
- begin
- AutoSelect := False;
- if ParentMenu <> nil then Action := DoReturn;
- end else Action := DoReturn;
- end;
- if ItemShown <> Current then
- begin
- ItemShown := Current;
- DrawView;
- end;
- if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
- if Current <> nil then with Current^ do if Name <> nil then
- if Command = 0 then
- begin
- if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
- GetItemRect(Current, R);
- R.A.X := R.A.X + Origin.X;
- R.A.Y := R.B.Y + Origin.Y;
- R.B := Owner^.Size;
- if Size.Y = 1 then Dec(R.A.X);
- Target := TopMenu^.NewSubView(R, SubMenu, @Self);
- Result := Owner^.ExecView(Target);
- Dispose(Target, Done);
- end else if Action = DoSelect then Result := Command;
- if (Result <> 0) and CommandEnabled(Result) then
- begin
- Action := DoReturn;
- ClearEvent(E);
- end
- else
- Result := 0;
- until Action = DoReturn;
- end;
- if E.What <> evNothing then
- if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
- if Current <> nil then
- begin
- Menu^.Default := Current;
- Current := nil;
- DrawView;
- end;
- Execute := Result;
- end;
- constructor TAdvancedMenuBar.Init(var Bounds: TRect; AMenu: PMenu);
- begin
- inherited Init(Bounds, AMenu);
- EventMask:=EventMask or evBroadcast;
- end;
- function TAdvancedMenuBar.NewSubView(var Bounds: TRect; AMenu: PMenu;
- AParentMenu: PMenuView): PMenuView;
- begin
- NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
- end;
- procedure TAdvancedMenuBar.Update;
- begin
- UpdateMenu(Menu);
- DrawView;
- end;
- procedure TAdvancedMenuBar.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evBroadcast :
- case Event.Command of
- cmUpdate : Update;
- end;
- end;
- inherited HandleEvent(Event);
- end;
- function TAdvancedMenuBar.Execute: word;
- type
- MenuAction = (DoNothing, DoSelect, DoReturn);
- var
- AutoSelect: Boolean;
- Action: MenuAction;
- Ch: Char;
- Result: Word;
- ItemShown, P: PMenuItem;
- Target: PMenuView;
- R: TRect;
- E: TEvent;
- MouseActive: Boolean;
- function IsDisabled(Item: PMenuItem): boolean;
- var Dis : boolean;
- begin
- Dis:=Item^.Disabled or IsSeparator(Item);
- if (Dis=false) and (IsSubMenu(Item)=false) then
- Dis:=CommandEnabled(Item^.Command)=false;
- IsDisabled:=Dis;
- end;
- procedure TrackMouse;
- var
- Mouse: TPoint;
- R: TRect;
- OldC: PMenuItem;
- begin
- MakeLocal(E.Where, Mouse);
- OldC:=Current;
- Current := Menu^.Items;
- while Current <> nil do
- begin
- GetItemRect(Current, R);
- if R.Contains(Mouse) then
- begin
- MouseActive := True;
- Break;
- end;
- Current := Current^.Next;
- end;
- if (Current<>nil) and IsDisabled(Current) then
- Current:=nil;
- end;
- procedure TrackKey(FindNext: Boolean);
- procedure NextItem;
- begin
- Current := Current^.Next;
- if Current = nil then Current := Menu^.Items;
- end;
- procedure PrevItem;
- var
- P: PMenuItem;
- begin
- P := Current;
- if P = Menu^.Items then P := nil;
- repeat NextItem until Current^.Next = P;
- end;
- begin
- if Current <> nil then
- repeat
- if FindNext then NextItem else PrevItem;
- until (Current^.Name <> nil) and (IsDisabled(Current)=false);
- end;
- function MouseInOwner: Boolean;
- var
- Mouse: TPoint;
- R: TRect;
- begin
- MouseInOwner := False;
- if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
- begin
- ParentMenu^.MakeLocal(E.Where, Mouse);
- ParentMenu^.GetItemRect(ParentMenu^.Current, R);
- MouseInOwner := R.Contains(Mouse);
- end;
- end;
- function MouseInMenus: Boolean;
- var
- P: PMenuView;
- begin
- P := ParentMenu;
- while (P <> nil) and not P^.MouseInView(E.Where) do P := P^.ParentMenu;
- MouseInMenus := P <> nil;
- end;
- function TopMenu: PMenuView;
- var
- P: PMenuView;
- begin
- P := @Self;
- while P^.ParentMenu <> nil do P := P^.ParentMenu;
- TopMenu := P;
- end;
- begin
- AutoSelect := False; E.What:=evNothing;
- Result := 0;
- ItemShown := nil;
- Current := Menu^.Default;
- MouseActive := False;
- if UpdateMenu(Menu) then
- begin
- if Current<>nil then
- if Current^.Disabled then
- TrackKey(true);
- repeat
- Action := DoNothing;
- GetEvent(E);
- case E.What of
- evMouseDown:
- if MouseInView(E.Where) or MouseInOwner then
- begin
- TrackMouse;
- if Size.Y = 1 then AutoSelect := True;
- end else Action := DoReturn;
- evMouseUp:
- begin
- TrackMouse;
- if MouseInOwner then
- Current := Menu^.Default
- else
- if (Current <> nil) and (Current^.Name <> nil) then
- Action := DoSelect
- else
- if MouseActive or MouseInView(E.Where) then Action := DoReturn
- else
- begin
- Current := Menu^.Default;
- if Current = nil then Current := Menu^.Items;
- Action := DoNothing;
- end;
- end;
- evMouseMove:
- if E.Buttons <> 0 then
- begin
- TrackMouse;
- if not (MouseInView(E.Where) or MouseInOwner) and
- MouseInMenus then Action := DoReturn;
- end;
- evKeyDown:
- case CtrlToArrow(E.KeyCode) of
- kbUp, kbDown:
- if Size.Y <> 1 then
- TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
- if E.KeyCode = kbDown then AutoSelect := True;
- kbLeft, kbRight:
- if ParentMenu = nil then
- TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
- Action := DoReturn;
- kbHome, kbEnd:
- if Size.Y <> 1 then
- begin
- Current := Menu^.Items;
- if E.KeyCode = kbEnd then TrackKey(False);
- end;
- kbEnter:
- begin
- if Size.Y = 1 then AutoSelect := True;
- Action := DoSelect;
- end;
- kbEsc:
- begin
- Action := DoReturn;
- if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
- ClearEvent(E);
- end;
- else
- Target := @Self;
- Ch := GetAltChar(E.KeyCode);
- if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
- P := Target^.FindItem(Ch);
- if P = nil then
- begin
- P := TopMenu^.HotKey(E.KeyCode);
- if (P <> nil) and CommandEnabled(P^.Command) then
- begin
- Result := P^.Command;
- Action := DoReturn;
- end
- end else
- if Target = @Self then
- begin
- if Size.Y = 1 then AutoSelect := True;
- Action := DoSelect;
- Current := P;
- end else
- if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
- Action := DoReturn;
- end;
- evCommand:
- if E.Command = cmMenu then
- begin
- AutoSelect := False;
- if ParentMenu <> nil then Action := DoReturn;
- end else Action := DoReturn;
- end;
- if ItemShown <> Current then
- begin
- ItemShown := Current;
- DrawView;
- end;
- if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
- if Current <> nil then with Current^ do if Name <> nil then
- if Command = 0 then
- begin
- if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
- GetItemRect(Current, R);
- R.A.X := R.A.X + Origin.X;
- R.A.Y := R.B.Y + Origin.Y;
- R.B := Owner^.Size;
- if Size.Y = 1 then Dec(R.A.X);
- Target := TopMenu^.NewSubView(R, SubMenu, @Self);
- Result := Owner^.ExecView(Target);
- Dispose(Target, Done);
- end else if Action = DoSelect then Result := Command;
- if (Result <> 0) and CommandEnabled(Result) then
- begin
- Action := DoReturn;
- ClearEvent(E);
- end
- else
- Result := 0;
- until Action = DoReturn;
- end;
- if E.What <> evNothing then
- if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
- if Current <> nil then
- begin
- Menu^.Default := Current;
- Current := nil;
- DrawView;
- end;
- Execute := Result;
- end;
- procedure ErrorBox(S: string; Params: pointer);
- begin
- MessageBox(S,Params,mfError+mfInsertInApp+mfOKButton);
- end;
- procedure WarningBox(S: string; Params: pointer);
- begin
- MessageBox(S,Params,mfWarning+mfInsertInApp+mfOKButton);
- end;
- procedure InformationBox(S: string; Params: pointer);
- begin
- MessageBox(S,Params,mfInformation+mfInsertInApp+mfOKButton);
- end;
- function ConfirmBox(S: string; Params: pointer; CanCancel: boolean): word;
- begin
- ConfirmBox:=MessageBox(S,Params,mfConfirmation+mfInsertInApp+mfYesButton+mfNoButton+integer(CanCancel)*mfCancelButton);
- end;
- function IsSeparator(P: PMenuItem): boolean;
- begin
- IsSeparator:=(P<>nil) and (P^.Name=nil) and (P^.HelpCtx=hcNoContext);
- end;
- function IsSubMenu(P: PMenuItem): boolean;
- begin
- IsSubMenu:=(P<>nil) and (P^.Name<>nil) and (P^.Command=0) and (P^.SubMenu<>nil);
- end;
- function SearchMenuItem(Menu: PMenu; Cmd: word): PMenuItem;
- var P,I: PMenuItem;
- begin
- I:=nil;
- if Menu=nil then P:=nil else P:=Menu^.Items;
- while (P<>nil) and (I=nil) do
- begin
- if IsSubMenu(P) then
- I:=SearchMenuItem(P^.SubMenu,Cmd);
- if I=nil then
- if P^.Command=Cmd then I:=P else
- P:=P^.Next;
- end;
- SearchMenuItem:=I;
- end;
- procedure SetMenuItemParam(Menu: PMenuItem; Param: string);
- begin
- if Menu=nil then Exit;
- if Menu^.Param<>nil then DisposeStr(Menu^.Param);
- Menu^.Param:=NewStr(Param);
- end;
- function UpdateMenu(M: PMenu): boolean;
- var P: PMenuItem;
- IsEnabled: boolean;
- begin
- if M=nil then begin UpdateMenu:=false; Exit; end;
- P:=M^.Items; IsEnabled:=false;
- while (P<>nil) do
- begin
- if IsSubMenu(P) then
- P^.Disabled:=not UpdateMenu(P^.SubMenu);
- if (IsSeparator(P)=false) and (P^.Disabled=false) and (Application^.CommandEnabled(P^.Command)=true) then
- IsEnabled:=true;
- P:=P^.Next;
- end;
- UpdateMenu:=IsEnabled;
- end;
- function SearchSubMenu(M: PMenu; Index: integer): PMenuItem;
- var P,C: PMenuItem;
- Count: integer;
- begin
- P:=nil; Count:=-1;
- if M<>nil then C:=M^.Items else C:=nil;
- while (C<>nil) and (P=nil) do
- begin
- if IsSubMenu(C) then
- begin
- Inc(Count);
- if Count=Index then P:=C;
- end;
- C:=C^.Next;
- end;
- SearchSubMenu:=P;
- end;
- procedure AppendMenuItem(M: PMenu; I: PMenuItem);
- var P: PMenuItem;
- begin
- if (M=nil) or (I=nil) then Exit;
- I^.Next:=nil;
- if M^.Items=nil then M^.Items:=I else
- begin
- P:=M^.Items;
- while (P^.Next<>nil) do P:=P^.Next;
- P^.Next:=I;
- end;
- end;
- procedure DisposeMenuItem(P: PMenuItem);
- begin
- if P<>nil then
- begin
- if IsSubMenu(P) then DisposeMenu(P^.SubMenu) else
- if IsSeparator(P)=false then
- if P^.Param<>nil then DisposeStr(P^.Param);
- if P^.Name<>nil then DisposeStr(P^.Name);
- Dispose(P);
- end;
- end;
- procedure RemoveMenuItem(Menu: PMenu; I: PMenuItem);
- var P,PrevP: PMenuItem;
- begin
- if (Menu=nil) or (I=nil) then Exit;
- P:=Menu^.Items; PrevP:=nil;
- while (P<>nil) do
- begin
- if P=I then
- begin
- if Menu^.Items<>I then PrevP^.Next:=P^.Next
- else Menu^.Items:=P^.Next;
- DisposeMenuItem(P);
- Break;
- end;
- PrevP:=P; P:=P^.Next;
- end;
- end;
- function GetMenuItemBefore(Menu: PMenu; BeforeOf: PMenuItem): PMenuItem;
- var P,C: PMenuItem;
- begin
- P:=nil;
- if Menu<>nil then C:=Menu^.Items else C:=nil;
- while (C<>nil) do
- begin
- if C^.Next=BeforeOf then begin P:=C; Break; end;
- C:=C^.Next;
- end;
- GetMenuItemBefore:=P;
- end;
- procedure TAdvancedStaticText.SetText(S: string);
- begin
- if Text<>nil then DisposeStr(Text);
- Text:=NewStr(S);
- DrawView;
- end;
- procedure TAdvancedListBox.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evMouseDown :
- if MouseInView(Event.Where) and (Event.Double) then
- begin
- inherited HandleEvent(Event);
- if Range>Focused then SelectItem(Focused);
- end;
- evBroadcast :
- case Event.Command of
- cmListItemSelected :
- Message(Owner,evBroadcast,cmDefault,nil);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- constructor TColorStaticText.Init(var Bounds: TRect; AText: String; AColor: word);
- begin
- inherited Init(Bounds,AText);
- Color:=AColor;
- end;
- procedure TColorStaticText.Draw;
- var
- C: word;
- Center: Boolean;
- I, J, L, P, Y: Integer;
- B: TDrawBuffer;
- S: String;
- T: string;
- CurS: string;
- TildeCount,Po: integer;
- TempS: string;
- begin
- if Size.X=0 then Exit;
- if DontWrap=false then
- begin
- C:=Color;
- GetText(S);
- L := Length(S);
- P := 1;
- Y := 0;
- Center := False;
- while Y < Size.Y do
- begin
- MoveChar(B, ' ', Lo(C), Size.X);
- if P <= L then
- begin
- if S[P] = #3 then
- begin
- Center := True;
- Inc(P);
- end;
- I := P;
- repeat
- J := P;
- while (P <= L) and (S[P] = ' ') do Inc(P);
- while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do Inc(P);
- until (P > L) or (P >= I + Size.X) or (S[P] = #13);
- TildeCount:=0; TempS:=copy(S,I,P-I);
- repeat
- Po:=Pos('~',TempS);
- if Po>0 then begin Inc(TildeCount); Delete(TempS,1,Po); end;
- until Po=0;
- if P > I + Size.X + TildeCount then
- if J > I then P := J else P := I + Size.X;
- T:=copy(S,I,P-I);
- if Center then J := (Size.X - {P + I}CStrLen(T)) div 2 else J := 0;
- MoveCStr(B[J],T,C);
- while (P <= L) and (S[P] = ' ') do Inc(P);
- if (P <= L) and (S[P] = #13) then
- begin
- Center := False;
- Inc(P);
- if (P <= L) and (S[P] = #10) then Inc(P);
- end;
- end;
- WriteLine(0, Y, Size.X, 1, B);
- Inc(Y);
- end;
- end { Wrap=false } else
- begin
- C := Color;
- GetText(S);
- I:=1;
- for Y:=0 to Size.Y-1 do
- begin
- MoveChar(B, ' ', Lo(C), Size.X);
- CurS:='';
- if S<>'' then
- begin
- P:=Pos(#13,S);
- if P=0 then P:=length(S)+1;
- CurS:=copy(S,1,P-1);
- CurS:=copy(CurS,Delta.X+1,255);
- CurS:=copy(CurS,1,MaxViewWidth);
- Delete(S,1,P);
- end;
- if CurS<>'' then MoveCStr(B,CurS,C);
- WriteLine(0,Y,Size.X,1,B);
- end;
- end;
- end;
- function TUnsortedStringCollection.At(Index: Integer): PString;
- begin
- At:=inherited At(Index);
- end;
- procedure TUnsortedStringCollection.FreeItem(Item: Pointer);
- begin
- if Item<>nil then DisposeStr(Item);
- end;
- constructor THSListBox.Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
- begin
- inherited Init(Bounds,ANumCols,AVScrollBar);
- HScrollBar:=AHScrollBar;
- end;
- constructor TDlgWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
- begin
- inherited Init(Bounds,ATitle);
- Number:=ANumber;
- Flags:=Flags or (wfMove + wfGrow + wfClose + wfZoom);
- end;
- procedure TLocalMenuListBox.LocalMenu(P: TPoint);
- var M: PMenu;
- MV: PAdvancedMenuPopUp;
- R: TRect;
- Re: word;
- begin
- M:=GetLocalMenu;
- if M=nil then Exit;
- if LastLocalCmd<>0 then
- M^.Default:=SearchMenuItem(M,LastLocalCmd);
- Desktop^.GetExtent(R);
- MakeGlobal(P,R.A); {Desktop^.MakeLocal(R.A,R.A);}
- New(MV, Init(R, M));
- Re:=Application^.ExecView(MV);
- if M^.Default=nil then LastLocalCmd:=0
- else LastLocalCmd:=M^.Default^.Command;
- Dispose(MV, Done);
- if Re<>0 then
- Message(GetCommandTarget,evCommand,Re,@Self);
- end;
- function TLocalMenuListBox.GetLocalMenu: PMenu;
- begin
- GetLocalMenu:=nil;
- Abstract;
- end;
- function TLocalMenuListBox.GetCommandTarget: PView;
- begin
- GetCommandTarget:=@Self;
- end;
- procedure TLocalMenuListBox.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- P: TPoint;
- begin
- case Event.What of
- evMouseDown :
- if MouseInView(Event.Where) and (Event.Buttons=mbRightButton) then
- begin
- MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
- LocalMenu(P);
- ClearEvent(Event);
- end;
- evKeyDown :
- begin
- DontClear:=false;
- case Event.KeyCode of
- kbAltF10 : Message(@Self,evCommand,cmLocalMenu,@Self);
- else DontClear:=true;
- end;
- if DontClear=false then ClearEvent(Event);
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmLocalMenu :
- begin
- P:=Cursor; Inc(P.X); Inc(P.Y);
- LocalMenu(P);
- end;
- else DontClear:=true;
- end;
- if not DontClear then ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- constructor TMessageListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- begin
- inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
- NoSelection:=true;
- end;
- function TMessageListBox.GetLocalMenu: PMenu;
- var M: PMenu;
- begin
- if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
- M:=NewMenu(
- NewItem('~C~lear','',kbNoKey,cmMsgClear,hcMsgClear,
- NewLine(
- NewItem('~G~oto source','',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
- NewItem('~T~rack source','',kbNoKey,cmMsgTrackSource,hcMsgTrackSource,
- nil)))));
- GetLocalMenu:=M;
- end;
- procedure TMessageListBox.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- begin
- case Event.What of
- evKeyDown :
- begin
- DontClear:=false;
- case Event.KeyCode of
- kbEnter :
- if Owner<>pointer(SD) then
- Message(@Self,evCommand,cmMsgGotoSource,nil);
- else DontClear:=true;
- end;
- if DontClear=false then ClearEvent(Event);
- end;
- evBroadcast :
- case Event.Command of
- cmListItemSelected :
- if Event.InfoPtr=@Self then
- Message(@Self,evCommand,cmMsgTrackSource,nil);
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmMsgGotoSource :
- if Range>0 then
- GotoSource;
- cmMsgTrackSource :
- if Range>0 then
- TrackSource;
- cmMsgClear :
- Clear;
- else DontClear:=true;
- end;
- if DontClear=false then ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TMessageListBox.AddItem(P: PMessageItem);
- var W: integer;
- begin
- if List=nil then New(List, Init(500,500));
- W:=length(P^.GetText(255));
- if W>MaxWidth then
- begin
- MaxWidth:=W;
- if HScrollBar<>nil then
- HScrollBar^.SetRange(0,MaxWidth);
- end;
- List^.Insert(P);
- SetRange(List^.Count);
- if Focused=List^.Count-1-1 then
- FocusItem(List^.Count-1);
- DrawView;
- end;
- function TMessageListBox.GetText(Item: Integer; MaxLen: Integer): String;
- var P: PMessageItem;
- S: string;
- begin
- P:=List^.At(Item);
- S:=P^.GetText(MaxLen);
- GetText:=copy(S,1,MaxLen);
- end;
- procedure TMessageListBox.Clear;
- begin
- if List<>nil then Dispose(List, Done); List:=nil; MaxWidth:=0;
- SetRange(0); DrawView;
- end;
- procedure TMessageListBox.TrackSource;
- var W: PSourceWindow;
- P: PMessageItem;
- R: TRect;
- begin
- if Range=0 then Exit;
- P:=List^.At(Focused);
- if P^.ID=0 then Exit;
- Desktop^.Lock;
- GetNextEditorBounds(R);
- if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
- R.B.Y:=Owner^.Origin.Y;
- W:=TryToOpenFile(@R,P^.GetModuleName,0,P^.ID-1);
- if W<>nil then
- begin
- W^.Select;
- W^.Editor^.SetHighlightRow(P^.ID-1);
- end;
- if Assigned(Owner) then
- Owner^.Select;
- Desktop^.UnLock;
- end;
- procedure TMessageListBox.GotoSource;
- var W: PSourceWindow;
- P: PMessageItem;
- begin
- if Range=0 then Exit;
- P:=List^.At(Focused);
- if P^.ID=0 then Exit;
- Desktop^.Lock;
- W:=TryToOpenFile(nil,P^.GetModuleName,0,P^.ID-1);
- Message(Owner,evCommand,cmClose,nil);
- Desktop^.UnLock;
- end;
- procedure TMessageListBox.Draw;
- var
- I, J, Item: Integer;
- NormalColor, SelectedColor, FocusedColor, Color: Word;
- ColWidth, CurCol, Indent: Integer;
- B: TDrawBuffer;
- Text: String;
- SCOff: Byte;
- TC: byte;
- procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
- begin
- if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
- if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
- begin
- NormalColor := GetColor(1);
- FocusedColor := GetColor(3);
- SelectedColor := GetColor(4);
- end else
- begin
- NormalColor := GetColor(2);
- SelectedColor := GetColor(4);
- end;
- if Transparent then
- begin MT(NormalColor); MT(SelectedColor); end;
- if NoSelection then
- SelectedColor:=NormalColor;
- if HScrollBar <> nil then Indent := HScrollBar^.Value
- else Indent := 0;
- ColWidth := Size.X div NumCols + 1;
- for I := 0 to Size.Y - 1 do
- begin
- for J := 0 to NumCols-1 do
- begin
- Item := J*Size.Y + I + TopItem;
- CurCol := J*ColWidth;
- if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
- (Focused = Item) and (Range > 0) then
- begin
- Color := FocusedColor;
- SetCursor(CurCol+1,I);
- SCOff := 0;
- end
- else if (Item < Range) and IsSelected(Item) then
- begin
- Color := SelectedColor;
- SCOff := 2;
- end
- else
- begin
- Color := NormalColor;
- SCOff := 4;
- end;
- MoveChar(B[CurCol], ' ', Color, ColWidth);
- if Item < Range then
- begin
- Text := GetText(Item, ColWidth + Indent);
- Text := Copy(Text,Indent,ColWidth);
- MoveStr(B[CurCol+1], Text, Color);
- if ShowMarkers then
- begin
- WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
- WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
- end;
- end;
- MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
- end;
- WriteLine(0, I, Size.X, 1, B);
- end;
- end;
- destructor TMessageListBox.Done;
- begin
- inherited Done;
- if List<>nil then Dispose(List, Done);
- end;
- constructor TMessageItem.Init(AClass: longint; AText, AModule: string; AID: longint);
- begin
- inherited Init;
- TClass:=AClass;
- Text:=NewStr(AText);
- Module:=NewStr(AModule);
- ID:=AID;
- end;
- function TMessageItem.GetText(MaxLen: integer): string;
- var S: string;
- begin
- if Text=nil then S:='' else S:=Text^;
- if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
- GetText:=S;
- end;
- procedure TMessageItem.Selected;
- begin
- end;
- function TMessageItem.GetModuleName: string;
- begin
- GetModuleName:=GetStr(Module);
- end;
- destructor TMessageItem.Done;
- begin
- inherited Done;
- if Text<>nil then DisposeStr(Text);
- if Module<>nil then DisposeStr(Module);
- end;
- function TCompilerMessage.GetText(MaxLen: Integer): String;
- var ClassS: string[20];
- S: string;
- begin
- if TClass=
- V_Fatal then ClassS:='Fatal' else if TClass =
- V_Error then ClassS:='Error' else if TClass =
- V_Normal then ClassS:='' else if TClass =
- V_Warning then ClassS:='Warning' else if TClass =
- V_Note then ClassS:='Note' else if TClass =
- V_Hint then ClassS:='Hint' else if TClass =
- V_Macro then ClassS:='Macro' else if TClass =
- V_Procedure then ClassS:='Procedure' else if TClass =
- V_Conditional then ClassS:='Conditional' else if TClass =
- V_Info then ClassS:='Info' else if TClass =
- V_Status then ClassS:='Status' else if TClass =
- V_Used then ClassS:='Used' else if TClass =
- V_Tried then ClassS:='Tried' else if TClass =
- V_Debug then ClassS:='Debug'
- else
- ClassS:='???';
- if ClassS<>'' then
- ClassS:=RExpand(ClassS,0)+': ';
- S:=ClassS;
- if (Module<>nil) {and (ID<>0)} then
- S:=S+Module^+' ('+IntToStr(ID)+'): ';
- if Text<>nil then S:=ClassS+Text^;
- if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
- GetText:=S;
- end;
- constructor TProgramInfoWindow.Init;
- var R,R2: TRect;
- HSB,VSB: PScrollBar;
- ST: PStaticText;
- C: word;
- const White = 15;
- begin
- Desktop^.GetExtent(R); R.A.Y:=R.B.Y-13;
- inherited Init(R, 'Program Information', wnNoNumber);
- HelpCtx:=hcInfoWindow;
- GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+3;
- C:=((Desktop^.GetColor(32+6) and $f0) or White)*256+Desktop^.GetColor(32+6);
- New(InfoST, Init(R,'', C)); InfoST^.GrowMode:=gfGrowHiX;
- InfoST^.DontWrap:=true;
- Insert(InfoST);
- GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,3); R.B.Y:=R.A.Y+1;
- New(ST, Init(R, CharStr('Ä', MaxViewWidth))); ST^.GrowMode:=gfGrowHiX; Insert(ST);
- GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,4);
- R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
- New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
- R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
- New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- New(LogLB, Init(R,HSB,VSB));
- LogLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
- LogLB^.Transparent:=true;
- Insert(LogLB);
- Update;
- end;
- procedure TProgramInfoWindow.AddMessage(AClass: longint; Msg, Module: string; Line: longint);
- begin
- if AClass>=V_Info then Line:=0;
- LogLB^.AddItem(New(PCompilerMessage, Init(AClass, Msg, Module, Line)));
- end;
- procedure TProgramInfoWindow.SizeLimits(var Min, Max: TPoint);
- begin
- inherited SizeLimits(Min,Max);
- Min.X:=30; Min.Y:=9;
- end;
- procedure TProgramInfoWindow.Close;
- begin
- Hide;
- end;
- procedure TProgramInfoWindow.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evBroadcast :
- case Event.Command of
- cmUpdate :
- Update;
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TProgramInfoWindow.Update;
- begin
- InfoST^.SetText(
- {#13+ }
- ' Current module : '+MainFile+#13+
- ' Last exit code : '+IntToStr(LastExitCode)+#13+
- ' Available memory : '+IntToStrL(MemAvail div 1024,5)+'K'+#13+
- ''
- );
- end;
- destructor TProgramInfoWindow.Done;
- begin
- inherited Done;
- ProgramInfoWindow:=nil;
- end;
- function TAdvancedStatusLine.GetStatusText: string;
- var S: string;
- begin
- if StatusText=nil then S:='' else S:=StatusText^;
- GetStatusText:=S;
- end;
- procedure TAdvancedStatusLine.SetStatusText(S: string);
- begin
- if StatusText<>nil then DisposeStr(StatusText);
- StatusText:=NewStr(S);
- DrawView;
- end;
- procedure TAdvancedStatusLine.ClearStatusText;
- begin
- SetStatusText('');
- end;
- procedure TAdvancedStatusLine.Draw;
- var B: TDrawBuffer;
- C: word;
- S: string;
- begin
- S:=GetStatusText;
- if S='' then inherited Draw else
- begin
- C:=GetColor(1);
- MoveChar(B,' ',C,Size.X);
- MoveStr(B[1],S,C);
- WriteLine(0,0,Size.X,Size.Y,B);
- end;
- end;
- constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
- begin
- inherited Init(Bounds);
- Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
- GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
- TabDefs:=ATabDef;
- ActiveDef:=-1;
- SelectTab(0);
- ReDraw;
- end;
- function TTab.TabCount: integer;
- var i: integer;
- P: PTabDef;
- begin
- I:=0; P:=TabDefs;
- while (P<>nil) do
- begin
- Inc(I);
- P:=P^.Next;
- end;
- TabCount:=I;
- end;
- function TTab.AtTab(Index: integer): PTabDef;
- var i: integer;
- P: PTabDef;
- begin
- i:=0; P:=TabDefs;
- while (I<Index) do
- begin
- if P=nil then RunError($AA);
- P:=P^.Next;
- Inc(i);
- end;
- AtTab:=P;
- end;
- procedure TTab.SelectTab(Index: integer);
- var P: PTabItem;
- V: PView;
- begin
- if ActiveDef<>Index then
- begin
- if Owner<>nil then Owner^.Lock;
- Lock;
- { --- Update --- }
- if TabDefs<>nil then
- begin
- DefCount:=1;
- while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
- end
- else DefCount:=0;
- if ActiveDef<>-1 then
- begin
- P:=AtTab(ActiveDef)^.Items;
- while P<>nil do
- begin
- if P^.View<>nil then Delete(P^.View);
- P:=P^.Next;
- end;
- end;
- ActiveDef:=Index;
- P:=AtTab(ActiveDef)^.Items;
- while P<>nil do
- begin
- if P^.View<>nil then Insert(P^.View);
- P:=P^.Next;
- end;
- V:=AtTab(ActiveDef)^.DefItem;
- if V<>nil then V^.Select;
- ReDraw;
- { --- Update --- }
- UnLock;
- if Owner<>nil then Owner^.UnLock;
- DrawView;
- end;
- end;
- procedure TTab.ChangeBounds(var Bounds: TRect);
- var D: TPoint;
- procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
- var
- R: TRect;
- begin
- if P^.Owner=nil then Exit; { it think this is a bug in TV }
- P^.CalcBounds(R, D);
- P^.ChangeBounds(R);
- end;
- var
- P: PTabItem;
- I: integer;
- begin
- D.X := Bounds.B.X - Bounds.A.X - Size.X;
- D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
- inherited ChangeBounds(Bounds);
- for I:=0 to TabCount-1 do
- if I<>ActiveDef then
- begin
- P:=AtTab(I)^.Items;
- while P<>nil do
- begin
- if P^.View<>nil then DoCalcChange(P^.View);
- P:=P^.Next;
- end;
- end;
- end;
- procedure TTab.HandleEvent(var Event: TEvent);
- var Index : integer;
- I : integer;
- X : integer;
- Len : byte;
- P : TPoint;
- V : PView;
- CallOrig: boolean;
- LastV : PView;
- FirstV: PView;
- function FirstSelectable: PView;
- var
- FV : PView;
- begin
- FV := First;
- while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
- FV:=FV^.Next;
- if FV<>nil then
- if (FV^.Options and ofSelectable)=0 then FV:=nil;
- FirstSelectable:=FV;
- end;
- function LastSelectable: PView;
- var
- LV : PView;
- begin
- LV := Last;
- while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
- LV:=LV^.Prev;
- if LV<>nil then
- if (LV^.Options and ofSelectable)=0 then LV:=nil;
- LastSelectable:=LV;
- end;
- begin
- if (Event.What and evMouseDown)<>0 then
- begin
- MakeLocal(Event.Where,P);
- if P.Y<3 then
- begin
- Index:=-1; X:=1;
- for i:=0 to DefCount-1 do
- begin
- Len:=CStrLen(AtTab(i)^.Name^);
- if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
- X:=X+Len+3;
- end;
- if Index<>-1 then
- SelectTab(Index);
- end;
- end;
- if Event.What=evKeyDown then
- begin
- Index:=-1;
- case Event.KeyCode of
- kbTab,kbShiftTab :
- if GetState(sfSelected) then
- begin
- if Current<>nil then
- begin
- LastV:=LastSelectable; FirstV:=FirstSelectable;
- if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
- begin
- if Owner<>nil then Owner^.SelectNext(true);
- end else
- if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
- begin
- Lock;
- if Owner<>nil then Owner^.SelectNext(false);
- UnLock;
- end else
- SelectNext(Event.KeyCode=kbShiftTab);
- ClearEvent(Event);
- end;
- end;
- else
- for I:=0 to DefCount-1 do
- begin
- if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
- then begin
- Index:=I;
- ClearEvent(Event);
- Break;
- end;
- end;
- end;
- if Index<>-1 then
- begin
- Select;
- SelectTab(Index);
- V:=AtTab(ActiveDef)^.DefItem;
- if V<>nil then V^.Focus;
- end;
- end;
- CallOrig:=true;
- if Event.What=evKeyDown then
- begin
- if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
- then
- else CallOrig:=false;
- end;
- if CallOrig then inherited HandleEvent(Event);
- end;
- function TTab.GetPalette: PPalette;
- begin
- GetPalette:=nil;
- end;
- procedure TTab.Draw;
- var B : TDrawBuffer;
- i : integer;
- C1,C2,C3,C : word;
- HeaderLen : integer;
- X,X2 : integer;
- Name : PString;
- ActiveKPos : integer;
- ActiveVPos : integer;
- FC : char;
- ClipR : TRect;
- procedure SWriteBuf(X,Y,W,H: integer; var Buf);
- var i: integer;
- begin
- if Y+H>Size.Y then H:=Size.Y-Y;
- if X+W>Size.X then W:=Size.X-X;
- if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
- else for i:=1 to H do
- Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
- end;
- procedure ClearBuf;
- begin
- MoveChar(B,' ',C1,Size.X);
- end;
- begin
- if InDraw then Exit;
- InDraw:=true;
- { - Start of TGroup.Draw - }
- if Buffer = nil then
- begin
- GetBuffer;
- end;
- { - Start of TGroup.Draw - }
- C1:=GetColor(1); C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256; C3:=GetColor(8)+GetColor({9}8)*256;
- HeaderLen:=0; for i:=0 to DefCount-1 do HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3; Dec(HeaderLen);
- if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
- { --- 1. sor --- }
- ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
- X:=1;
- for i:=0 to DefCount-1 do
- begin
- Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
- if i=ActiveDef
- then begin
- ActiveKPos:=X-1;
- ActiveVPos:=X+X2+2;
- if GetState(sfFocused) then C:=C3 else C:=C2;
- end
- else C:=C2;
- MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
- MoveChar(B[X-1],'³',C1,1);
- end;
- SWriteBuf(0,1,Size.X,1,B);
- { --- 0. sor --- }
- ClearBuf; MoveChar(B[0],'Ú',C1,1);
- X:=1;
- for i:=0 to DefCount-1 do
- begin
- if I<ActiveDef then FC:='Ú'
- else FC:='¿';
- X2:=CStrLen(AtTab(i)^.Name^)+2;
- MoveChar(B[X+X2],{'Â'}FC,C1,1);
- if i=DefCount-1 then X2:=X2+1;
- if X2>0 then
- MoveChar(B[X],'Ä',C1,X2);
- X:=X+X2+1;
- end;
- MoveChar(B[HeaderLen+1],'¿',C1,1);
- MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
- SWriteBuf(0,0,Size.X,1,B);
- { --- 2. sor --- }
- MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
- MoveChar(B[Size.X-1],'¿',C1,1);
- MoveChar(B[ActiveKPos],'Ù',C1,1);
- if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
- else MoveChar(B[0],{'Ã'}'Ú',C1,1);
- MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
- MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
- SWriteBuf(0,2,Size.X,1,B);
- { --- marad‚k sor --- }
- ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
- SWriteBuf(0,3,Size.X,Size.Y-4,B);
- { --- Size.X . sor --- }
- MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
- SWriteBuf(0,Size.Y-1,Size.X,1,B);
- { - End of TGroup.Draw - }
- if Buffer <> nil then
- begin
- Lock;
- Redraw;
- UnLock;
- end;
- if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
- begin
- GetClipRect(ClipR);
- Redraw;
- GetExtent(ClipR);
- end;
- { - End of TGroup.Draw - }
- InDraw:=false;
- end;
- function TTab.Valid(Command: Word): Boolean;
- var PT : PTabDef;
- PI : PTabItem;
- OK : boolean;
- begin
- OK:=true;
- PT:=TabDefs;
- while (PT<>nil) and (OK=true) do
- begin
- PI:=PT^.Items;
- while (PI<>nil) and (OK=true) do
- begin
- if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
- PI:=PI^.Next;
- end;
- PT:=PT^.Next;
- end;
- Valid:=OK;
- end;
- procedure TTab.SetState(AState: Word; Enable: Boolean);
- begin
- inherited SetState(AState,Enable);
- if (AState and sfFocused)<>0 then DrawView;
- end;
- destructor TTab.Done;
- var P,X: PTabDef;
- procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
- begin
- if P<>nil then Delete(P);
- end;
- begin
- ForEach(@DeleteViews);
- inherited Done;
- P:=TabDefs;
- while P<>nil do
- begin
- X:=P^.Next;
- DisposeTabDef(P);
- P:=X;
- end;
- end;
- constructor TScreenView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
- AScreen: PScreen);
- begin
- inherited Init(Bounds,AHScrollBar,AVScrollBar);
- Screen:=AScreen;
- if Screen=nil then
- Fail;
- SetState(sfCursorVis,true);
- Update;
- end;
- procedure TScreenView.Update;
- begin
- SetLimit(UserScreen^.GetWidth,UserScreen^.GetHeight);
- DrawView;
- end;
- procedure TScreenView.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evBroadcast :
- case Event.Command of
- cmUpdate : Update;
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TScreenView.Draw;
- var B: TDrawBuffer;
- X,Y: integer;
- Text,Attr: string;
- P: TPoint;
- begin
- Screen^.GetCursorPos(P);
- for Y:=Delta.Y to Delta.Y+Size.Y-1 do
- begin
- if Y<Screen^.GetHeight then
- Screen^.GetLine(Y,Text,Attr)
- else
- begin Text:=''; Attr:=''; end;
- Text:=copy(Text,Delta.X+1,255); Attr:=copy(Attr,Delta.X+1,255);
- MoveChar(B,' ',0,Size.X);
- for X:=1 to length(Text) do
- MoveChar(B[X-1],Text[X],ord(Attr[X]),1);
- WriteLine(0,Y-Delta.Y,Size.X,1,B);
- end;
- SetCursor(P.X-Delta.X,P.Y-Delta.Y);
- end;
- constructor TScreenWindow.Init(AScreen: PScreen; ANumber: integer);
- var R: TRect;
- VSB,HSB: PScrollBar;
- begin
- Desktop^.GetExtent(R);
- inherited Init(R, 'User screen', ANumber);
- Options:=Options or ofTileAble;
- GetExtent(R); R.Grow(-1,-1); R.Move(1,0); R.A.X:=R.B.X-1;
- New(VSB, Init(R)); VSB^.Options:=VSB^.Options or ofPostProcess;
- VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.A.Y:=R.B.Y-1;
- New(HSB, Init(R)); HSB^.Options:=HSB^.Options or ofPostProcess;
- HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
- GetExtent(R); R.Grow(-1,-1);
- New(ScreenView, Init(R, HSB, VSB, AScreen));
- ScreenView^.GrowMode:=gfGrowHiX+gfGrowHiY;
- Insert(ScreenView);
- UserScreenWindow:=@Self;
- end;
- destructor TScreenWindow.Done;
- begin
- inherited Done;
- UserScreenWindow:=nil;
- end;
- const InTranslate : boolean = false;
- procedure TranslateMouseClick(View: PView; var Event: TEvent);
- procedure TranslateAction(Action: integer);
- var E: TEvent;
- begin
- if Action<>acNone then
- begin
- E:=Event;
- E.What:=evMouseDown; E.Buttons:=mbLeftButton;
- View^.HandleEvent(E);
- Event.What:=evCommand;
- Event.Command:=ActionCommands[Action];
- end;
- end;
- begin
- if InTranslate then Exit;
- InTranslate:=true;
- case Event.What of
- evMouseDown :
- if (GetShiftState and kbAlt)<>0 then
- TranslateAction(AltMouseAction) else
- if (GetShiftState and kbCtrl)<>0 then
- TranslateAction(CtrlMouseAction);
- end;
- InTranslate:=false;
- end;
- function GetNextEditorBounds(var Bounds: TRect): boolean;
- var P: PView;
- begin
- P:=Desktop^.First;
- while P<>nil do
- begin
- if P^.HelpCtx=hcSourceWindow then Break;
- P:=P^.NextView;
- end;
- if P=nil then Desktop^.GetExtent(Bounds) else
- begin
- P^.GetBounds(Bounds);
- Inc(Bounds.A.X); Inc(Bounds.A.Y);
- end;
- GetNextEditorBounds:=P<>nil;
- end;
- function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: integer): PSourceWindow;
- var R: TRect;
- W: PSourceWindow;
- begin
- if Assigned(Bounds) then R.Copy(Bounds^) else
- GetNextEditorBounds(R);
- PushStatus('Opening source file... ('+SmartPath(FileName)+')');
- New(W, Init(R, FileName));
- if W<>nil then
- begin
- if (CurX<>0) or (CurY<>0) then
- with W^.Editor^ do
- begin
- SetCurPtr(CurX,CurY);
- TrackCursor(true);
- end;
- W^.HelpCtx:=hcSourceWindow;
- Desktop^.Insert(W);
- If assigned(BreakpointCollection) then
- BreakPointCollection^.ShowBreakpoints(W);
- Message(Application,evBroadcast,cmUpdate,nil);
- end;
- PopStatus;
- OpenEditorWindow:=W;
- end;
- function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: integer): PSourceWindow;
- var D : DirStr;
- N : NameStr;
- E : ExtStr;
- DrStr : String;
-
- function CheckDir(NewDir: DirStr; NewName: NameStr; NewExt: ExtStr): boolean;
- var OK: boolean;
- begin
- NewDir:=CompleteDir(NewDir);
- OK:=ExistsFile(NewDir+NewName+NewExt);
- if OK then begin D:=NewDir; N:=NewName; E:=NewExt; end;
- CheckDir:=OK;
- end;
- function CheckExt(NewExt: ExtStr): boolean;
- var OK: boolean;
- begin
- OK:=false;
- if D<>'' then OK:=CheckDir(D,N,NewExt) else
- if CheckDir('.'+DirSep,N,NewExt) then OK:=true;
- CheckExt:=OK;
- end;
- function TryToOpen(const DD : dirstr): PSourceWindow;
- var Found: boolean;
- W : PSourceWindow;
- begin
- D:=CompleteDir(DD);
- Found:=true;
- if E<>'' then Found:=CheckExt(E) else
- if CheckExt('.pp') then Found:=true else
- if CheckExt('.pas') then Found:=true else
- if CheckExt('.inc')=false then
- Found:=false;
- if Found=false then W:=nil else
- begin
- FileName:=FExpand(D+N+E);
- W:=OpenEditorWindow(Bounds,FileName,CurX,CurY);
- end;
- TryToOpen:=W;
- end;
- function SearchOnDesktop: PSourceWindow;
- var W: PWindow;
- I: integer;
- Found: boolean;
- SName : string;
- begin
- for I:=1 to 100 do
- begin
- W:=SearchWindowWithNo(I);
- if (W<>nil) and (W^.HelpCtx=hcSourceWindow) then
- begin
- if (D='') then
- SName:=NameAndExtOf(PSourceWindow(W)^.Editor^.FileName)
- else
- SName:=PSourceWindow(W)^.Editor^.FileName;
- SName:=UpcaseStr(SName);
- if E<>'' then
- begin
- if D<>'' then
- Found:=SName=UpcaseStr(D+N+E)
- else
- Found:=SName=UpcaseStr(N+E);
- end
- else
- begin
- Found:=SName=UpcaseStr(N+'.pp');
- if Found=false then
- Found:=SName=UpcaseStr(N+'.pas');
- end;
- if Found then Break;
- end;
- end;
- if Found=false then W:=nil;
- SearchOnDesktop:=PSourceWindow(W);
- end;
- var W: PSourceWindow;
- begin
- FSplit(FileName,D,N,E);
- W:=SearchOnDesktop;
- if W<>nil then
- begin
- NewEditorOpened:=false;
- if assigned(Bounds) then
- W^.ChangeBounds(Bounds^);
- W^.Editor^.SetCurPtr(CurX,CurY);
- end
- else
- begin
- DrStr:=GetSourceDirectories;
- While pos(';',DrStr)>0 do
- Begin
- W:=TryToOpen(Copy(DrStr,1,pos(';',DrStr)-1));
- if assigned(W) then
- break;
- DrStr:=Copy(DrStr,pos(';',DrStr)+1,255);
- End;
- if not assigned(W) then
- W:=TryToOpen(DrStr);
- NewEditorOpened:=W<>nil;
- if assigned(W) then
- W^.Editor^.SetCurPtr(CurX,CurY);
- end;
- TryToOpenFile:=W;
- end;
- END.
- {
- $Log$
- Revision 1.10 1999-02-10 09:42:52 pierre
- + DoneReservedWords to avoid memory leaks
- * TMessageItem Module field was not disposed
- Revision 1.9 1999/02/05 12:12:02 pierre
- + SourceDir that stores directories for sources that the
- compiler should not know about
- Automatically asked for addition when a new file that
- needed filedialog to be found is in an unknown directory
- Stored and retrieved from INIFile
- + Breakpoints conditions added to INIFile
- * Breakpoints insterted and removed at debin and end of debug session
- Revision 1.8 1999/02/04 17:45:23 pierre
- + BrowserAtCursor started
- * bug in TryToOpenFile removed
- Revision 1.7 1999/02/04 13:32:11 pierre
- * Several things added (I cannot commit them independently !)
- + added TBreakpoint and TBreakpointCollection
- + added cmResetDebugger,cmGrep,CmToggleBreakpoint
- + Breakpoint list in INIFile
- * Select items now also depend of SwitchMode
- * Reading of option '-g' was not possible !
- + added search for -Fu args pathes in TryToOpen
- + added code for automatic opening of FileDialog
- if source not found
- Revision 1.6 1999/01/21 11:54:27 peter
- + tools menu
- + speedsearch in symbolbrowser
- * working run command
- Revision 1.5 1999/01/14 21:42:25 peter
- * source tracking from Gabor
- Revision 1.4 1999/01/12 14:29:42 peter
- + Implemented still missing 'switch' entries in Options menu
- + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
- ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
- ASCII chars and inserted directly in the text.
- + Added symbol browser
- * splitted fp.pas to fpide.pas
- Revision 1.3 1999/01/04 11:49:53 peter
- * 'Use tab characters' now works correctly
- + Syntax highlight now acts on File|Save As...
- + Added a new class to syntax highlight: 'hex numbers'.
- * There was something very wrong with the palette managment. Now fixed.
- + Added output directory (-FE<xxx>) support to 'Directories' dialog...
- * Fixed some possible bugs in Running/Compiling, and the compilation/run
- process revised
- Revision 1.2 1998/12/28 15:47:54 peter
- + Added user screen support, display & window
- + Implemented Editor,Mouse Options dialog
- + Added location of .INI and .CFG file
- + Option (INI) file managment implemented (see bottom of Options Menu)
- + Switches updated
- + Run program
- Revision 1.4 1998/12/22 10:39:53 peter
- + options are now written/read
- + find and replace routines
- }
|