mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 20:18:11 +02:00
Fixes from Mattias for EditorOPtions
Fixes to COmpiler that should allow people to compile if their path is set up. Changes to code completion. Shane git-svn-id: trunk@172 -
This commit is contained in:
lazarus
parent
67fe309404
commit
aa81046e12
@ -270,6 +270,7 @@ begin
|
||||
TStringList(FItemList).OnChange := {$IFDEF FPC}@{$ENDIF}StringListChange;
|
||||
bitmap := TBitmap.Create;
|
||||
NbLinesInWindow := 6;
|
||||
ShowHint := True;
|
||||
|
||||
end;
|
||||
|
||||
@ -395,6 +396,7 @@ Writeln('[TSynBaseCompletionForm.Paint]');
|
||||
Canvas.Rectangle(0, FFontHeight * i, width, FFontHeight * (i + 1));
|
||||
Canvas.Pen.Color := clBlack;
|
||||
Canvas.Font.Color := clWhite;
|
||||
Hint := ItemList[Scroll.Position + i];
|
||||
end
|
||||
else
|
||||
Begin
|
||||
@ -409,12 +411,6 @@ Writeln('[TSynBaseCompletionForm.Paint]');
|
||||
Begin
|
||||
Writeln('Drawing to canvas');
|
||||
// Canvas.Font.Color := clBlack;
|
||||
{ S1 := Copy(ItemList[Scroll.Position + i],pos('.',ItemList[Scroll.Position + i])+1,pos(':',ItemList[Scroll.Position + i])-1);
|
||||
Canvas.TextOut(2, FFontHeight * i, S1);
|
||||
|
||||
Canvas.Font.Color := clLtGray;
|
||||
Canvas.TextOut(2+(9*length(S1)), FFontHeight * i, Copy(ItemList[Scroll.Position + i],pos(':',ItemList[Scroll.Position + i]),255));
|
||||
}
|
||||
Canvas.TextOut(2, FFontHeight * i, ItemList[Scroll.Position + i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -11,21 +11,16 @@ unit objectinspector;
|
||||
|
||||
|
||||
ToDo:
|
||||
- connect to TFormEditor
|
||||
- TCustomComboBox has a bug: it can not store objects
|
||||
- MouseDown is always fired two times -> workaround
|
||||
- clipping (almost everywhere)
|
||||
- scrolling with TrackBar
|
||||
- ScrollBar instead of TrackBar
|
||||
- TCustomComboBox don't know custom draw yet
|
||||
- improve TextHeight function
|
||||
- combobox can't sort (exception)
|
||||
- TEdit has no Maxlength property
|
||||
- TEdit Readonly property is protected
|
||||
- backgroundcolor=clNone
|
||||
- DoubleClick on Property
|
||||
|
||||
- a lot more ...
|
||||
- a lot more ... see XXX
|
||||
}
|
||||
|
||||
{$MODE OBJFPC}
|
||||
@ -34,7 +29,7 @@ interface
|
||||
|
||||
uses
|
||||
Forms, SysUtils, Buttons, Classes, Graphics, StdCtrls, LCLLinux, Controls,
|
||||
ComCtrls, ExtCtrls, PropEdits, TypInfo;
|
||||
ComCtrls, ExtCtrls, PropEdits, TypInfo, Messages, LResources;
|
||||
|
||||
type
|
||||
TOIPropertyGrid = class;
|
||||
@ -98,6 +93,7 @@ type
|
||||
FDragging:boolean;
|
||||
FOldMouseDownY:integer; // XXX workaround
|
||||
FExpandedProperties:TStringList;
|
||||
FBorderStyle:TBorderStyle;
|
||||
|
||||
function GetRow(Index:integer):TOIPropertyGridRow;
|
||||
function GetRowCount:integer;
|
||||
@ -132,16 +128,22 @@ type
|
||||
procedure ValueComboBoxChange(Sender: TObject);
|
||||
procedure ValueComboBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure ValueButtonClick(Sender: TObject);
|
||||
procedure TrackBarChange(Sender:TObject);
|
||||
|
||||
procedure WMVScroll(var Msg: TWMScroll); message WM_VSCROLL;
|
||||
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
|
||||
procedure SetBorderStyle(Value: TBorderStyle);
|
||||
procedure UpdateScrollBar;
|
||||
protected
|
||||
procedure CreateParams(var Params: TCreateParams); override;
|
||||
|
||||
public
|
||||
ValueEdit:TEdit;
|
||||
ValueComboBox:TComboBox;
|
||||
ValueButton:TButton;
|
||||
TrackBar:TTrackBar;
|
||||
|
||||
property Selections:TComponentSelectionList read FComponentList write SetSelections;
|
||||
property PropertyEditorHook:TPropertyEditorHook read FPropertyEditorHook write SetPropertyEditorHook;
|
||||
property PropertyEditorHook:TPropertyEditorHook
|
||||
read FPropertyEditorHook write SetPropertyEditorHook;
|
||||
procedure BuildPropertyList;
|
||||
procedure RefreshPropertyValues;
|
||||
|
||||
@ -150,12 +152,16 @@ type
|
||||
|
||||
property TopY:integer read FTopY write SetTopY;
|
||||
function GridHeight:integer;
|
||||
function TopMax:integer;
|
||||
property DefaultItemHeight:integer read FDefaultItemHeight write FDefaultItemHeight;
|
||||
property SplitterX:integer read FSplitterX write SetSplitterX;
|
||||
property Indent:integer read FIndent write FIndent;
|
||||
property BackgroundColor:TColor read FBackgroundColor write FBackgroundColor;
|
||||
property BackgroundColor:TColor
|
||||
read FBackgroundColor write FBackgroundColor default clBtnFace;
|
||||
property NameFont:TFont read FNameFont write FNameFont;
|
||||
property ValueFont:TFont read FValueFont write FValueFont;
|
||||
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle
|
||||
default bsSingle;
|
||||
property ItemIndex:integer read FItemIndex write SetItemIndex;
|
||||
property ExpandedProperties:TStringList read FExpandedProperties write FExpandedProperties;
|
||||
function PropertyPath(Index:integer):string;
|
||||
@ -170,7 +176,7 @@ type
|
||||
procedure Paint; override;
|
||||
procedure Clear;
|
||||
constructor Create(AOwner:TComponent;
|
||||
APropertyEditorHook:TPropertyEditorHook; TypeFilter:TTypeKinds);
|
||||
APropertyEditorHook:TPropertyEditorHook; TypeFilter:TTypeKinds);
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
@ -181,6 +187,12 @@ type
|
||||
TOnSelectComponentInOI = procedure(AComponent:TComponent) of object;
|
||||
|
||||
TObjectInspector = class (TCustomForm)
|
||||
AvailCompsComboBox : TComboBox;
|
||||
NoteBook:TNoteBook;
|
||||
PropertyGrid:TOIPropertyGrid;
|
||||
EventGrid:TOIPropertyGrid;
|
||||
StatusBar:TStatusBar;
|
||||
procedure AvailComboBoxChange(Sender:TObject);
|
||||
private
|
||||
FComponentList: TComponentSelectionList;
|
||||
FPropertyEditorHook:TPropertyEditorHook;
|
||||
@ -190,14 +202,9 @@ type
|
||||
function ComponentToString(c:TComponent):string;
|
||||
procedure SetPropertyEditorHook(NewValue:TPropertyEditorHook);
|
||||
procedure SetSelections(const NewSelections:TComponentSelectionList);
|
||||
procedure AvailComboBoxChange(Sender:TObject);
|
||||
procedure AddComponentToAvailComboBox(AComponent:TComponent);
|
||||
procedure PropEditLookupRootChange;
|
||||
public
|
||||
AvailCompsComboBox : TComboBox;
|
||||
NoteBook:TNoteBook;
|
||||
PropertyGrid:TOIPropertyGrid;
|
||||
EventGrid:TOIPropertyGrid;
|
||||
procedure SetBounds(aLeft,aTop,aWidth,aHeight:integer); override;
|
||||
property Selections:TComponentSelectionList read FComponentList write SetSelections;
|
||||
procedure RefreshSelections;
|
||||
@ -223,10 +230,12 @@ constructor TOIPropertyGrid.Create(AOwner:TComponent;
|
||||
APropertyEditorHook:TPropertyEditorHook; TypeFilter:TTypeKinds);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
SetBounds(1,1,200,300);
|
||||
Visible:=false;
|
||||
ControlStyle:=ControlStyle+[csAcceptsControls];
|
||||
|
||||
if LazarusResources.Find(ClassName)=nil then begin
|
||||
SetBounds(1,1,200,300);
|
||||
ControlStyle:=ControlStyle+[csAcceptsControls,csOpaque];
|
||||
BorderWidth:=1;
|
||||
end;
|
||||
|
||||
FComponentList:=TComponentSelectionList.Create;
|
||||
FPropertyEditorHook:=APropertyEditorHook;
|
||||
FFilter:=TypeFilter;
|
||||
@ -246,22 +255,12 @@ begin
|
||||
FNameFont.Color:=clWindowText;
|
||||
FValueFont:=TFont.Create;
|
||||
FValueFont.Color:=clActiveCaption;
|
||||
BorderWidth:=1;
|
||||
fBorderStyle := bsSingle;
|
||||
|
||||
// create sub components
|
||||
FCurrentEdit:=nil;
|
||||
FCurrentButton:=nil;
|
||||
|
||||
TrackBar:=TTrackBar.Create(AOwner);
|
||||
with TrackBar do begin
|
||||
Parent:=Self;
|
||||
Orientation:=trVertical;
|
||||
Align:=alRight;
|
||||
OnChange:=@TrackBarChange;
|
||||
Visible:=true;
|
||||
Enabled:=true;
|
||||
end;
|
||||
|
||||
ValueEdit:=TEdit.Create(Self);
|
||||
with ValueEdit do begin
|
||||
Parent:=Self;
|
||||
@ -296,6 +295,76 @@ begin
|
||||
BuildPropertyList;
|
||||
end;
|
||||
|
||||
procedure TOIPropertyGrid.UpdateScrollBar;
|
||||
var
|
||||
ScrollInfo: TScrollInfo;
|
||||
begin
|
||||
if HandleAllocated then begin
|
||||
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
||||
ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
|
||||
ScrollInfo.nMin := 0;
|
||||
ScrollInfo.nTrackPos := 0;
|
||||
ScrollInfo.nMax := TopMax+ClientWidth;
|
||||
ScrollInfo.nPage := ClientWidth;
|
||||
ScrollInfo.nPos := TopY;
|
||||
SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
|
||||
ShowScrollBar(Handle,SB_VERT,True);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOIPropertyGrid.CreateParams(var Params: TCreateParams);
|
||||
const
|
||||
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
|
||||
ClassStylesOff = CS_VREDRAW or CS_HREDRAW;
|
||||
begin
|
||||
inherited CreateParams(Params);
|
||||
with Params do begin
|
||||
{$R-}
|
||||
WindowClass.Style := WindowClass.Style and not ClassStylesOff;
|
||||
Style := Style or WS_VSCROLL or BorderStyles[fBorderStyle]
|
||||
or WS_CLIPCHILDREN;
|
||||
{$R+}
|
||||
if NewStyleControls and Ctl3D and (fBorderStyle = bsSingle) then begin
|
||||
Style := Style and not WS_BORDER;
|
||||
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOIPropertyGrid.SetBorderStyle(Value: TBorderStyle);
|
||||
begin
|
||||
if fBorderStyle <> Value then begin
|
||||
fBorderStyle := Value;
|
||||
RecreateWnd;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOIPropertyGrid.WMVScroll(var Msg: TWMScroll);
|
||||
begin
|
||||
case Msg.ScrollCode of
|
||||
// Scrolls to start / end of the text
|
||||
SB_TOP: TopY := 0;
|
||||
SB_BOTTOM: TopY := TopMax;
|
||||
// Scrolls one line up / down
|
||||
SB_LINEDOWN: TopY := TopY + DefaultItemHeight div 2;
|
||||
SB_LINEUP: TopY := TopY - DefaultItemHeight div 2;
|
||||
// Scrolls one page of lines up / down
|
||||
SB_PAGEDOWN: TopY := TopY + ClientHeight - DefaultItemHeight;
|
||||
SB_PAGEUP: TopY := TopY - ClientHeight + DefaultItemHeight;
|
||||
// Scrolls to the current scroll bar position
|
||||
SB_THUMBPOSITION,
|
||||
SB_THUMBTRACK: TopY := Msg.Pos;
|
||||
// Ends scrolling
|
||||
SB_ENDSCROLL: ;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOIPropertyGrid.WMSize(var Msg: TWMSize);
|
||||
begin
|
||||
inherited;
|
||||
UpdateScrollBar;
|
||||
end;
|
||||
|
||||
destructor TOIPropertyGrid.Destroy;
|
||||
var a:integer;
|
||||
begin
|
||||
@ -466,14 +535,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOIPropertyGrid.TrackBarChange(Sender:TObject);
|
||||
begin
|
||||
if TrackBar.Position<>FTopY then begin
|
||||
FTopY:=TrackBar.Position;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOIPropertyGrid.SetItemIndex(NewIndex:integer);
|
||||
var NewRow:TOIPropertyGridRow;
|
||||
NewValue:string;
|
||||
@ -560,6 +621,7 @@ begin
|
||||
if CurRow<>nil then begin
|
||||
ItemIndex:=CurRow.Index;
|
||||
end;
|
||||
UpdateScrollBar;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
@ -616,6 +678,7 @@ begin
|
||||
if not AlreadyInExpandList then
|
||||
FExpandedProperties.Add(CurPath);
|
||||
FExpandingRow:=nil;
|
||||
UpdateScrollBar;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
@ -645,6 +708,7 @@ begin
|
||||
end;
|
||||
if CurRow.Parent<>nil then
|
||||
FExpandedProperties.Add(PropertyPath(CurRow.Parent.Index));
|
||||
UpdateScrollBar;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
@ -772,21 +836,16 @@ begin
|
||||
if FTopY<>NewValue then begin
|
||||
FTopY:=NewValue;
|
||||
if FTopY<0 then FTopY:=0;
|
||||
if FTopY>TrackBar.Max then FTopY:=TrackBar.Max;
|
||||
TrackBar.Position:=FTopY;
|
||||
UpdateScrollBar;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOIPropertyGrid.SetBounds(aLeft,aTop,aWidth,aHeight:integer);
|
||||
var scrollmax:integer;
|
||||
begin
|
||||
inherited SetBounds(aLeft,aTop,aWidth,aHeight);
|
||||
if Visible then begin
|
||||
AlignEditComponents;
|
||||
scrollmax:=GridHeight-Height;
|
||||
if scrollmax<10 then scrollmax:=10;
|
||||
TrackBar.Max:=scrollmax;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -795,6 +854,12 @@ begin
|
||||
Result:=Rows[Index].Lvl*Indent+2;
|
||||
end;
|
||||
|
||||
function TOIPropertyGrid.TopMax:integer;
|
||||
begin
|
||||
Result:=GridHeight-ClientHeight+2*BorderWidth;
|
||||
if Result<0 then Result:=0;
|
||||
end;
|
||||
|
||||
function TOIPropertyGrid.GridHeight:integer;
|
||||
begin
|
||||
if FRows.Count>0 then
|
||||
@ -953,7 +1018,7 @@ begin
|
||||
PaintRow(a);
|
||||
end;
|
||||
// draw unused space below rows
|
||||
SpaceRect:=Rect(BorderWidth,BorderWidth,TrackBar.Left-1,Height-BorderWidth);
|
||||
SpaceRect:=Rect(BorderWidth,BorderWidth,ClientWidth,Height-BorderWidth);
|
||||
if FRows.Count>0 then
|
||||
SpaceRect.Top:=Rows[FRows.Count-1].Bottom-FTopY+BorderWidth;
|
||||
// TWinControl(Parent).InvalidateRect(Self,SpaceRect,true);
|
||||
@ -998,7 +1063,7 @@ function TOIPropertyGrid.RowRect(ARow:integer):TRect;
|
||||
begin
|
||||
Result.Left:=BorderWidth;
|
||||
Result.Top:=Rows[ARow].Top-FTopY+BorderWidth;
|
||||
Result.Right:=TrackBar.Left-1;
|
||||
Result.Right:=ClientWidth-15;
|
||||
Result.Bottom:=Rows[ARow].Bottom-FTopY+BorderWidth;
|
||||
end;
|
||||
|
||||
@ -1018,7 +1083,6 @@ begin
|
||||
else
|
||||
scrollmax:=10;
|
||||
if scrollmax<10 then scrollmax:=10;
|
||||
TrackBar.Max:=scrollmax;
|
||||
end;
|
||||
|
||||
procedure TOIPropertyGrid.ClearRows;
|
||||
@ -1109,12 +1173,22 @@ begin
|
||||
FComponentList:=TComponentSelectionList.Create;
|
||||
FUpdatingAvailComboBox:=false;
|
||||
|
||||
// StatusBar
|
||||
StatusBar:=TStatusBar.Create(Self);
|
||||
with StatusBar do begin
|
||||
Name:='StatusBar';
|
||||
Parent:=Self;
|
||||
SimpleText:='All';
|
||||
Show;
|
||||
end;
|
||||
|
||||
// combobox at top (filled with available components)
|
||||
AvailCompsComboBox := TComboBox.Create (Self);
|
||||
with AvailCompsComboBox do begin
|
||||
Name:='AvailCompsComboBox';
|
||||
Parent:=self;
|
||||
Parent:=Self;
|
||||
Style:=csDropDown;
|
||||
Text:='';
|
||||
OnChange:=@AvailComboBoxChange;
|
||||
//Sorted:=true;
|
||||
Show;
|
||||
@ -1139,7 +1213,6 @@ begin
|
||||
with PropertyGrid do begin
|
||||
Name:='PropertyGrid';
|
||||
Parent:=NoteBook.Page[0];
|
||||
TrackBar.Parent:=Parent;
|
||||
ValueEdit.Parent:=Parent;
|
||||
ValueComboBox.Parent:=Parent;
|
||||
ValueButton.Parent:=Parent;
|
||||
@ -1153,7 +1226,6 @@ begin
|
||||
with EventGrid do begin
|
||||
Name:='EventGrid';
|
||||
Parent:=NoteBook.Page[1];
|
||||
TrackBar.Parent:=Parent;
|
||||
ValueEdit.Parent:=Parent;
|
||||
ValueComboBox.Parent:=Parent;
|
||||
ValueButton.Parent:=Parent;
|
||||
@ -1161,6 +1233,7 @@ begin
|
||||
Align:=alClient;
|
||||
Show;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
destructor TObjectInspector.Destroy;
|
||||
@ -1225,29 +1298,36 @@ end;
|
||||
procedure TObjectinspector.FillComponentComboBox;
|
||||
var a:integer;
|
||||
Root:TComponent;
|
||||
OldText:AnsiString;
|
||||
begin
|
||||
if FUpdatingAvailComboBox then exit;
|
||||
FUpdatingAvailComboBox:=true;
|
||||
AvailCompsComboBox.Items.BeginUpdate;
|
||||
OldText:=AvailCompsComboBox.Text;
|
||||
AvailCompsComboBox.Items.Clear;
|
||||
if (FPropertyEditorHook<>nil)
|
||||
and (FPropertyEditorHook.LookupRoot<>nil) then begin
|
||||
Root:=FPropertyEditorHook.LookupRoot;
|
||||
AddComponentToAvailComboBox(Root);
|
||||
for a:=0 to Root.ComponentCount-1 do begin
|
||||
for a:=0 to Root.ComponentCount-1 do
|
||||
AddComponentToAvailComboBox(Root.Components[a]);
|
||||
end;
|
||||
if FComponentList.Count=1 then
|
||||
AvailCompsComboBox.Text:=ComponentToString(FComponentList[0]);
|
||||
end;
|
||||
AvailCompsComboBox.Items.EndUpdate;
|
||||
FUpdatingAvailComboBox:=false;
|
||||
a:=AvailCompsComboBox.Items.IndexOf(OldText);
|
||||
if (OldText='') or (a<0) then begin
|
||||
if AvailCompsComboBox.Items.Count>0 then
|
||||
AvailCompsComboBox.Text:=AvailCompsComboBox.Items[0]
|
||||
else
|
||||
AvailCompsComboBox.Text:='';
|
||||
end else
|
||||
AvailCompsComboBox.ItemIndex:=a;
|
||||
end;
|
||||
|
||||
procedure TObjectinspector.SetSelections(
|
||||
const NewSelections:TComponentSelectionList);
|
||||
begin
|
||||
//XXX writeln('OI: Set Selections');
|
||||
writeln('OI: Set Selections');
|
||||
if FComponentList.IsEqual(NewSelections) then exit;
|
||||
FComponentList.Assign(NewSelections);
|
||||
if FComponentList.Count=1 then begin
|
||||
@ -1260,7 +1340,6 @@ end;
|
||||
|
||||
procedure TObjectinspector.RefreshSelections;
|
||||
begin
|
||||
//XXX writeln('OI: Refresh Selections');
|
||||
PropertyGrid.Selections:=FComponentList;
|
||||
EventGrid.Selections:=FComponentList;
|
||||
end;
|
||||
@ -1288,11 +1367,12 @@ var NewComponent,Root:TComponent;
|
||||
FComponentList.Add(c);
|
||||
RefreshSelections;
|
||||
if Assigned(FOnSelectComponentInOI) then
|
||||
FOnSelectComponentInOI(c);
|
||||
FOnSelectComponentInOI(c);
|
||||
end;
|
||||
|
||||
// AvailComboBoxChange
|
||||
begin
|
||||
if FUpdatingAvailComboBox then exit;
|
||||
if (FPropertyEditorHook=nil) or (FPropertyEditorHook.LookupRoot=nil) then
|
||||
exit;
|
||||
Root:=FPropertyEditorHook.LookupRoot;
|
||||
|
||||
@ -930,252 +930,11 @@ const
|
||||
TPropertyEditor, // tkWChar
|
||||
TBoolPropertyEditor, // tkBool
|
||||
TInt64PropertyEditor, // tkInt64
|
||||
nil // tkQWord
|
||||
,nil // tkDynArray
|
||||
,nil // tkInterfaceRaw
|
||||
nil, // tkQWord
|
||||
nil, // tkDynArray
|
||||
nil // tkInterfaceRaw
|
||||
);
|
||||
|
||||
// XXX ToDo: There are bugs in the typinfo.pp. Thus this workaround -------
|
||||
|
||||
Procedure SetIndexValues (P: PPRopInfo; Var Index,IValue : Longint);
|
||||
begin
|
||||
Index:=((P^.PropProcs shr 6) and 1);
|
||||
If Index<>0 then
|
||||
IValue:=P^.Index
|
||||
else
|
||||
IValue:=0;
|
||||
end;
|
||||
|
||||
function CallIntegerFunc(s: Pointer; Address: Pointer; Index, IValue: LongInt): Int64; assembler;
|
||||
asm
|
||||
movl S,%esi
|
||||
movl Address,%edi
|
||||
// ? Indexed function
|
||||
movl Index,%eax
|
||||
testl %eax,%eax
|
||||
je .LINoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
.LINoPush:
|
||||
push %esi
|
||||
call %edi
|
||||
// now the result is in EDX:EAX
|
||||
end;
|
||||
|
||||
Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
|
||||
Var Res: Shortstring);assembler;
|
||||
asm
|
||||
movl S,%esi
|
||||
movl Address,%edi
|
||||
// ? Indexed function
|
||||
movl Index,%eax
|
||||
testl %eax,%eax
|
||||
jnz .LSSNoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
// the result is stored in an invisible parameter
|
||||
pushl Res
|
||||
.LSSNoPush:
|
||||
push %esi
|
||||
call %edi
|
||||
end;
|
||||
|
||||
Function GetAStrProp(Instance : TObject;PropInfo : PPropInfo):Pointer;
|
||||
{
|
||||
Dirty trick based on fact that AnsiString is just a pointer,
|
||||
hence can be treated like an integer type.
|
||||
}
|
||||
var
|
||||
value : Pointer;
|
||||
Index,Ivalue : Longint;
|
||||
begin
|
||||
SetIndexValues(PropInfo,Index,IValue);
|
||||
case (PropInfo^.PropProcs) and 3 of
|
||||
ptfield:
|
||||
Value:=Pointer(PLongint(Pointer(Instance)+Longint(PropInfo^.GetProc))^);
|
||||
ptstatic:
|
||||
Value:=Pointer(LongInt(
|
||||
CallIntegerFunc(Instance,PropInfo^.GetProc,Index,IValue)));
|
||||
ptvirtual:
|
||||
Value:=Pointer(LongInt(CallIntegerFunc(Instance,
|
||||
PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,
|
||||
Index,IValue)));
|
||||
end;
|
||||
GetAStrProp:=Value;
|
||||
end;
|
||||
|
||||
Function GetSStrProp(Instance : TObject;PropInfo : PPropInfo):ShortString;
|
||||
var
|
||||
value : ShortString;
|
||||
Index,IValue : Longint;
|
||||
begin
|
||||
SetIndexValues(PropInfo,Index,IValue);
|
||||
case (PropInfo^.PropProcs) and 3 of
|
||||
ptfield:
|
||||
Value:=PShortString(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
||||
ptstatic:
|
||||
CallSStringFunc(Instance,PropInfo^.GetProc,Index,IValue,Value);
|
||||
ptvirtual:
|
||||
CallSSTringFunc(Instance,
|
||||
PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,
|
||||
Index,Ivalue,Value);
|
||||
end;
|
||||
GetSStrProp:=Value;
|
||||
end;
|
||||
|
||||
{function GetStrProp(Instance : TObject;PropInfo : PPropInfo) : Ansistring;
|
||||
var s:Ansistring;
|
||||
begin
|
||||
Case Propinfo^.PropType^.Kind of
|
||||
tkSString : Result:=GetSStrProp(Instance,PropInfo);
|
||||
tkAString :
|
||||
// Dirty trick which is necessary to increase the reference
|
||||
// counter of Result...
|
||||
begin
|
||||
Pointer(Result):=GetAStrProp(Instance,Propinfo);
|
||||
s:=Result;
|
||||
Pointer(s):=nil;
|
||||
end;
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
end;}
|
||||
|
||||
function GetStrProp(Instance: TObject; PropInfo: PPropInfo): AnsiString;
|
||||
var
|
||||
Index, IValue: LongInt;
|
||||
ShortResult: ShortString;
|
||||
begin
|
||||
SetIndexValues(PropInfo, Index, IValue);
|
||||
case Propinfo^.PropType^.Kind of
|
||||
tkSString:
|
||||
case (PropInfo^.PropProcs) and 3 of
|
||||
ptField:
|
||||
Result := PShortString(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
|
||||
ptStatic:
|
||||
begin
|
||||
CallSStringFunc(Instance, PropInfo^.GetProc, Index, IValue, ShortResult);
|
||||
Result := ShortResult;
|
||||
end;
|
||||
ptVirtual:
|
||||
begin
|
||||
CallSStringFunc(Instance, PPointer(Pointer(Instance.ClassType) +
|
||||
LongWord(PropInfo^.GetProc))^, Index, IValue, ShortResult);
|
||||
Result := ShortResult;
|
||||
end;
|
||||
end;
|
||||
tkAString:
|
||||
begin
|
||||
case (PropInfo^.PropProcs) and 3 of
|
||||
ptField:
|
||||
Pointer(Result) := PPointer(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
|
||||
ptStatic:
|
||||
Pointer(Result) := Pointer(LongWord(CallIntegerFunc(Instance,
|
||||
PropInfo^.GetProc, Index, IValue)));
|
||||
ptVirtual:
|
||||
Pointer(Result) := Pointer(LongWord(CallIntegerFunc(Instance,
|
||||
PPointer(Pointer(Instance.ClassType) + LongWord(PropInfo^.GetProc))^, Index, IValue)));
|
||||
end;
|
||||
end;
|
||||
else
|
||||
// Property is neither of type AnsiString nor of type ShortString
|
||||
SetLength(Result, 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
//------------------------------------------------------------------------------
|
||||
|
||||
function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer;
|
||||
Index,IValue : Longint) : Integer; assembler;
|
||||
asm
|
||||
movl S,%esi
|
||||
movl Address,%edi
|
||||
// Push value to set
|
||||
movl Value,%eax
|
||||
pushl %eax
|
||||
// ? Indexed procedure
|
||||
movl Index,%eax
|
||||
testl %eax,%eax
|
||||
je .LIPNoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
.LIPNoPush:
|
||||
pushl %esi
|
||||
call %edi
|
||||
end;
|
||||
|
||||
procedure CallSStringProc(s : Pointer;Address : Pointer;
|
||||
const Value : ShortString; Index,IVAlue : Longint); assembler;
|
||||
asm
|
||||
movl S,%esi
|
||||
movl Address,%edi
|
||||
// Push value to set
|
||||
movl Value,%eax
|
||||
pushl %eax
|
||||
// ? Indexed procedure
|
||||
movl Index,%eax
|
||||
testl %eax,%eax
|
||||
// MG: here was a bug (jnz)
|
||||
je .LSSPNoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
.LSSPNoPush:
|
||||
// MG: and here was a bug too (push)
|
||||
pushl %esi
|
||||
call %edi
|
||||
end;
|
||||
|
||||
procedure SetAStrProp(Instance : TObject;PropInfo : PPropInfo;
|
||||
const Value : AnsiString);
|
||||
//Dirty trick based on fact that AnsiString is just a pointer,
|
||||
//hence can be treated like an integer type.
|
||||
var
|
||||
Index,Ivalue : Longint;
|
||||
begin
|
||||
{ Another dirty trick which is necessary to increase the reference
|
||||
counter of Value... }
|
||||
SetIndexValues(PropInfo,Index,IValue);
|
||||
case (PropInfo^.PropProcs shr 2) and 3 of
|
||||
ptfield:
|
||||
PLongint(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=
|
||||
Longint(Pointer(Value)) ;
|
||||
ptstatic:
|
||||
CallIntegerProc(
|
||||
Instance,PropInfo^.SetProc,Longint(Pointer(Value)),Index,IValue);
|
||||
ptvirtual:
|
||||
CallIntegerProc(Instance
|
||||
,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^
|
||||
,Longint(Pointer(Value)),Index,IValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetSStrProp(Instance : TObject;PropInfo : PPropInfo;
|
||||
const Value : ShortString);
|
||||
var Index,IValue: longint;
|
||||
begin
|
||||
SetIndexValues(PropInfo,Index,IValue);
|
||||
case (PropInfo^.PropProcs shr 2) and 3 of
|
||||
ptfield:
|
||||
PShortString(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
||||
ptstatic:
|
||||
// MG: here was a bug (Getproc)
|
||||
CallSStringProc(Instance,PropInfo^.SetProc,Value,Index,IValue);
|
||||
ptvirtual:
|
||||
// MG: here was a bug (Getproc)
|
||||
CallSStringProc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,Value,Index,IValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
|
||||
const Value : AnsiString);
|
||||
begin
|
||||
case Propinfo^.PropType^.Kind of
|
||||
tkSString : SetSStrProp(Instance,PropInfo,Value);
|
||||
tkAString : SetAStrProp(Instance,Propinfo,Value);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
// XXX ToDo: These variables/functions have bugs. Thus I provide my own ------
|
||||
|
||||
@ -2038,6 +1797,7 @@ procedure TEnumPropertyEditor.SetValue(const NewValue: string);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
exit;
|
||||
I := GetEnumValue(GetPropType, NewValue);
|
||||
if I < 0 then begin
|
||||
{raise EPropertyError.CreateRes(@SInvalidPropertyValue)};
|
||||
@ -2904,6 +2664,7 @@ type
|
||||
Memo1 : TMemo;
|
||||
OKButton : TButton;
|
||||
CancelButton : TButton;
|
||||
procedure SetBounds(aLeft,aTop,aWidth,aHeight:integer); override;
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
end;
|
||||
|
||||
@ -2911,65 +2672,72 @@ constructor TStringsPropEditorDlg.Create(AOwner : TComponent);
|
||||
Begin
|
||||
inherited Create(AOwner);
|
||||
position := poScreenCenter;
|
||||
Height := 200;
|
||||
Width := 300;
|
||||
Height := 250;
|
||||
Width := 350;
|
||||
Caption := 'Strings Editor Dialog';
|
||||
|
||||
Memo1 := TMemo.Create(self);
|
||||
with Memo1 do begin
|
||||
Parent := Self;
|
||||
SetBounds(0,0,Width -1,Height-1);
|
||||
SetBounds(0,0,Width -4,Height-50);
|
||||
Visible := true;
|
||||
end;
|
||||
|
||||
OKButton := TButton.Create(self);
|
||||
with OKButton do
|
||||
Begin
|
||||
Parent := self;
|
||||
Caption := '&OK';
|
||||
ModalResult := mrOK;
|
||||
Left := self.width div 2;
|
||||
top := self.height -45;
|
||||
Visible := true;
|
||||
end;
|
||||
with OKButton do Begin
|
||||
Parent := self;
|
||||
Caption := '&OK';
|
||||
ModalResult := mrOK;
|
||||
Left := self.width-180;
|
||||
Top := self.height -40;
|
||||
Height:=25;
|
||||
Width:=60;
|
||||
Visible := true;
|
||||
end;
|
||||
|
||||
CancelButton := TButton.Create(self);
|
||||
with CancelButton do
|
||||
Begin
|
||||
Parent := self;
|
||||
Caption := '&Cancel';
|
||||
ModalResult := mrCancel;
|
||||
Left := (self.width div 2) + 75;
|
||||
top := self.height -45;
|
||||
Visible := true;
|
||||
end;
|
||||
|
||||
with CancelButton do Begin
|
||||
Parent := self;
|
||||
Caption := '&Cancel';
|
||||
ModalResult := mrCancel;
|
||||
Left := self.width-90;
|
||||
Top := self.height -40;
|
||||
Height:=25;
|
||||
Width:=60;
|
||||
Visible := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TStringsPropEditorDlg.SetBounds(aLeft,aTop,aWidth,aHeight:integer);
|
||||
begin
|
||||
inherited;
|
||||
if Memo1<>nil then
|
||||
Memo1.SetBounds(0,0,Width-4,Height-50);
|
||||
if OkButton<>nil then
|
||||
OkButton.SetBounds(Width-180,Height-40,60,25);
|
||||
if CancelButton<>nil then
|
||||
CancelButton.SetBounds(Width-90,Height-40,60,25);
|
||||
end;
|
||||
|
||||
procedure TStringsPropertyEditor.Edit;
|
||||
var
|
||||
TheDialog: TStringsPropEditorDlg;
|
||||
Strings:TStrings;
|
||||
begin
|
||||
Strings:=TStrings(GetOrdValue);
|
||||
TheDialog:=TStringsPropEditorDlg.Create(Application);
|
||||
TheDialog.Memo1.Text:=Strings.Text;
|
||||
try
|
||||
Strings:=TStrings(GetOrdValue);
|
||||
TheDialog:=TStringsPropEditorDlg.Create(Application);
|
||||
TheDialog.Memo1.Lines.Assign(Strings);
|
||||
try
|
||||
if (TheDialog.ShowModal = mrOK) then
|
||||
Strings.Assign(TheDialog.Memo1.Lines);
|
||||
finally
|
||||
TheDialog.Free;
|
||||
end;
|
||||
if (TheDialog.ShowModal = mrOK) then
|
||||
Strings.Text:=TheDialog.Memo1.Text;
|
||||
finally
|
||||
Strings.Free;
|
||||
TheDialog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TStringsPropertyEditor.GetAttributes: TPropertyAttributes;
|
||||
begin
|
||||
Result := [paDialog, paRevertable, paReadOnly];
|
||||
Result := [paMultiSelect, paDialog, paRevertable, paReadOnly];
|
||||
end;
|
||||
|
||||
//==============================================================================
|
||||
@ -3266,7 +3034,7 @@ initialization
|
||||
RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('shortstring'),
|
||||
nil,'',TCaptionPropertyEditor);
|
||||
RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('TStrings'),
|
||||
nil,'',TStringsPropertyEditor);
|
||||
nil,'Lines',TStringsPropertyEditor);
|
||||
|
||||
finalization
|
||||
PropertyEditorMapperList.Free; PropertyEditorMapperList:=nil;
|
||||
|
||||
@ -21,10 +21,10 @@
|
||||
* *
|
||||
***************************************************************************/
|
||||
}
|
||||
{$H+}
|
||||
unit compiler;
|
||||
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
interface
|
||||
|
||||
@ -100,9 +100,8 @@ begin
|
||||
|
||||
Assert(False, 'Trace:' + TheProgram);
|
||||
|
||||
TheProcess:=TProcess.Create(TheProgram,[poRunSuspended,poUsePipes,poNoConsole]);
|
||||
|
||||
TheProcess.Execute;
|
||||
TheProcess:=TProcess.Create(TheProgram,[poExecuteOnCreate,poUsePipes,poNoConsole]);
|
||||
// TheProcess.Execute;
|
||||
|
||||
if Assigned(OutputString)
|
||||
then
|
||||
@ -111,7 +110,7 @@ begin
|
||||
WriteMessage := False;
|
||||
for I:=1 to Count do
|
||||
begin
|
||||
if buf[i] = #10
|
||||
if buf[i] = #10
|
||||
then begin
|
||||
//determine what type of message it is
|
||||
if (pos(') Hint:',Texts) <> 0) then WriteMessage := CompilerOpts.ShowHints
|
||||
@ -123,20 +122,23 @@ begin
|
||||
if (pos(') Warning:',Texts) <> 0) then WriteMessage := CompilerOpts.ShowWarn
|
||||
else
|
||||
WriteMessage := True;
|
||||
|
||||
|
||||
FOutputList.Add(Texts);
|
||||
|
||||
if (WriteMessage) or (CompilerOpts.ShowAll)
|
||||
|
||||
if (WriteMessage) or (CompilerOpts.ShowAll)
|
||||
then begin
|
||||
OutputString(Texts);
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
// Application.ProcessMessages;
|
||||
|
||||
Texts := '';
|
||||
end
|
||||
else Texts := Texts + buf[i];
|
||||
end;
|
||||
until Count=0;
|
||||
TheProcess.Free;
|
||||
Writeln('-----------Exiting Compiler.Compile');
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
|
||||
{--------------------------------------------------------------------------
|
||||
@ -222,6 +224,12 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 2001/02/06 13:38:57 lazarus
|
||||
Fixes from Mattias for EditorOPtions
|
||||
Fixes to COmpiler that should allow people to compile if their path is set up.
|
||||
Changes to code completion.
|
||||
Shane
|
||||
|
||||
Revision 1.6 2001/02/04 18:24:41 lazarus
|
||||
Code cleanup
|
||||
Shane
|
||||
|
||||
@ -19,10 +19,10 @@
|
||||
* *
|
||||
***************************************************************************/
|
||||
}
|
||||
{$H+}
|
||||
unit compileroptions;
|
||||
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
{$ifdef Trace}
|
||||
{$ASSERTIONS ON}
|
||||
|
||||
@ -31,6 +31,8 @@ const
|
||||
ecNextEditor = ecUserFirst+7;
|
||||
ecPrevEditor = ecUserFirst+8;
|
||||
|
||||
ecPeriod = ecUserFirst+9;
|
||||
|
||||
ecFirstParent = ecUserFirst+1000;
|
||||
ecSave = ecFirstParent+1;
|
||||
ecOpen = ecFirstParent+2;
|
||||
|
||||
10
ide/main.pp
10
ide/main.pp
@ -654,7 +654,8 @@ begin
|
||||
MessageDlg.MessageView.OnDblClick := @MessageViewDblClick;
|
||||
}
|
||||
Compiler1 := TCompiler.Create;
|
||||
Compiler1.OutputString := @Messagedlg.Add;
|
||||
//messagedlg.add is not available at this time. It's not yet created.
|
||||
// Compiler1.OutputString := @Messagedlg.Add;
|
||||
|
||||
{ Create other forms }
|
||||
ObjectInspector1 := TObjectInspector.Create(Self);
|
||||
@ -1555,6 +1556,7 @@ if SourceNotebook.Empty then Begin
|
||||
MessageDlg.Width := SourceNotebook.Width;
|
||||
end;
|
||||
MessageDlg.Clear;
|
||||
Compiler1.OutputString := @Messagedlg.Add;
|
||||
Compiler1.Compile(SourceNotebook.ActiveUnitName);
|
||||
end;
|
||||
|
||||
@ -1623,6 +1625,12 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.57 2001/02/06 13:38:57 lazarus
|
||||
Fixes from Mattias for EditorOPtions
|
||||
Fixes to COmpiler that should allow people to compile if their path is set up.
|
||||
Changes to code completion.
|
||||
Shane
|
||||
|
||||
Revision 1.56 2001/02/04 04:18:11 lazarus
|
||||
Code cleanup and JITFOrms bug fix.
|
||||
Shane
|
||||
|
||||
@ -17,7 +17,6 @@
|
||||
* *
|
||||
***************************************************************************/
|
||||
}
|
||||
{$H+}
|
||||
{This unit builds the TSourceNotbook that the editors are held on. It also has
|
||||
a class that controls the editors (TSourceEditor)
|
||||
}
|
||||
@ -27,11 +26,13 @@
|
||||
unit UnitEditor;
|
||||
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
classes, Controls, forms,buttons,comctrls,sysutils,Dialogs,FormEditor,Find_Dlg,EditorOPtions,CustomFormEditor,keymapping,stdctrls,
|
||||
classes, Controls, forms,buttons,comctrls,sysutils,Dialogs,FormEditor,Find_Dlg,EditorOPtions,
|
||||
CustomFormEditor,keymapping,stdctrls,Compiler,dlgMEssage,
|
||||
{$ifdef NEW_EDITOR_SYNEDIT}
|
||||
SynEdit, SynEditHighlighter, SynHighlighterPas,SynEditAutoComplete,
|
||||
SynEditKeyCmds,SynCompletion,
|
||||
@ -95,6 +96,9 @@ type
|
||||
FVisible : Boolean;
|
||||
|
||||
Procedure BuildPopupMenu;
|
||||
|
||||
Function FindFile(Value : String) : String;
|
||||
|
||||
Function GetSource : TStrings;
|
||||
Procedure SetSource(value : TStrings);
|
||||
Function GetCurrentCursorXLine : Integer;
|
||||
@ -109,6 +113,7 @@ type
|
||||
Function GotoMethod(Value : String) : Integer;
|
||||
Function GotoMethodDeclaration(Value : String) : Integer;
|
||||
|
||||
|
||||
Function GotoLine(Value : Integer) : Integer;
|
||||
|
||||
Procedure CreateEditor(AOwner : TComponent; AParent: TWinControl);
|
||||
@ -137,6 +142,11 @@ type
|
||||
|
||||
Procedure EditorStatusChanged(Sender: TObject; Changes: TSynStatusChanges);
|
||||
|
||||
Procedure ccOnTimer(sender : TObject);
|
||||
Procedure ccAddMessage(Texts : String);
|
||||
Function ccParse(Texts : String) : TStrings;
|
||||
|
||||
|
||||
Function StartFind : Boolean;
|
||||
Function FindAgain(StartX,StartLine : Integer) : Boolean;
|
||||
|
||||
@ -146,6 +156,7 @@ type
|
||||
property Visible : Boolean read FVisible write FVisible default False;
|
||||
FindText : String;
|
||||
ccSelection : String;
|
||||
ErrorMsgs : TStrings;
|
||||
public
|
||||
constructor Create(AOwner : TComponent; AParent : TWinControl);
|
||||
destructor Destroy; override;
|
||||
@ -264,28 +275,13 @@ implementation
|
||||
uses
|
||||
LCLLinux,TypInfo,LResources,Main,LazConf;
|
||||
|
||||
{const
|
||||
ecFind = ecUserFirst+1;
|
||||
ecFindAgain = ecUserFirst+2;
|
||||
ecFindProcedureDefinition = ecUserFirst+3;
|
||||
ecFindProcedureMethod = ecUserFirst+4;
|
||||
|
||||
ecNextEditor = ecUserFirst+5;
|
||||
ecPrevEditor = ecUserFirst+6;
|
||||
|
||||
ecFirstParent = ecUserFirst+1000;
|
||||
ecSave = ecFirstParent+1;
|
||||
ecOpen = ecFirstParent+2;
|
||||
ecClose = ecFirstParent+3;
|
||||
|
||||
ecJumpToEditor = ecFirstParent+4;
|
||||
}
|
||||
var
|
||||
Editor_Num : Integer;
|
||||
aHighlighter: TSynPasSyn;
|
||||
aCompletion : TSynCompletion;
|
||||
scompl : TSynBaseCompletion; //used in ccexecute and cccomplete
|
||||
GotoDialog : TfrmGoto;
|
||||
CodeCompletionTimer : TTimer;
|
||||
|
||||
{ TSourceEditor }
|
||||
|
||||
@ -761,38 +757,38 @@ if Command >= ecFirstParent then
|
||||
end;
|
||||
|
||||
ecFindProcedureDefinition : Begin
|
||||
Y := CurrentCursorYLine;
|
||||
Texts2 := Lowercase(Source.Strings[Y-1]);
|
||||
Writeln('The source line = '+Texts2);
|
||||
I := pos('function',Texts2);
|
||||
if I = 0 then
|
||||
I := pos('procedure',Texts2);
|
||||
While (I = 0) and (Y > 0) do
|
||||
begin
|
||||
dec(Y);
|
||||
Texts2 := Lowercase(Source.Strings[Y-1]);
|
||||
Writeln('The source line = '+Texts2);
|
||||
I := pos('function ',Texts2);
|
||||
if I = 0 then
|
||||
I := pos('procedure ',Texts2);
|
||||
end;
|
||||
Y := CurrentCursorYLine;
|
||||
Texts2 := Lowercase(Source.Strings[Y-1]);
|
||||
Writeln('The source line = '+Texts2);
|
||||
I := pos('function',Texts2);
|
||||
if I = 0 then
|
||||
I := pos('procedure',Texts2);
|
||||
While (I = 0) and (Y > 0) do
|
||||
begin
|
||||
dec(Y);
|
||||
Texts2 := Lowercase(Source.Strings[Y-1]);
|
||||
Writeln('The source line = '+Texts2);
|
||||
I := pos('function ',Texts2);
|
||||
if I = 0 then
|
||||
I := pos('procedure ',Texts2);
|
||||
end;
|
||||
|
||||
if I <> 0 then
|
||||
Begin
|
||||
TheName := '';
|
||||
I := pos('.',Texts2);
|
||||
inc(i);
|
||||
while (not(Texts2[i] in [';',' ','('])) do
|
||||
Begin
|
||||
TheName := TheName + Texts2[i];
|
||||
inc(i);
|
||||
end;
|
||||
Writeln('Thename = '+TheName);
|
||||
GotoMethodDeclaration(TheName);
|
||||
end;
|
||||
if I <> 0 then
|
||||
Begin
|
||||
TheName := '';
|
||||
I := pos('.',Texts2);
|
||||
inc(i);
|
||||
while (not(Texts2[i] in [';',' ','('])) do
|
||||
Begin
|
||||
TheName := TheName + Texts2[i];
|
||||
inc(i);
|
||||
end;
|
||||
Writeln('Thename = '+TheName);
|
||||
GotoMethodDeclaration(TheName);
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
end;
|
||||
ecNextEditor: Begin
|
||||
//tell the SourceNotebook
|
||||
TSourceNotebook(FaOwner).NextEditor;
|
||||
@ -811,6 +807,19 @@ if Command >= ecFirstParent then
|
||||
end;
|
||||
end;
|
||||
|
||||
ecPeriod : Begin
|
||||
Y := CurrentCursorYLine;
|
||||
Texts := Lowercase(Source.Strings[Y-1]);
|
||||
if InsertMode then
|
||||
Texts := Copy(Texts,1,CurrentCursorXLine)+'.'+Copy(Texts,CurrentCursorXLine+1,Length(Texts))
|
||||
else
|
||||
Texts[CurrentCursorXLine] := '.';
|
||||
Source.Strings[Y-1] := Texts;
|
||||
CodeCompletionTimer.OnTimer := @CCOnTimer;
|
||||
CodeCompletionTimer.Enabled := True;
|
||||
end;
|
||||
|
||||
|
||||
end; //case
|
||||
|
||||
end;
|
||||
@ -868,10 +877,146 @@ ccSelection := '';
|
||||
scompl.Deactivate;
|
||||
End;
|
||||
|
||||
Function TSourceEditor.FindFile(Value : String) : String;
|
||||
var
|
||||
Found : Boolean;
|
||||
DirDelimiter : String;
|
||||
SearchDir : String;
|
||||
Num : Integer;
|
||||
tempDir : String;
|
||||
Begin
|
||||
Result := '';
|
||||
Found := False;
|
||||
DirDelimiter := '/';
|
||||
SearchDir := TMainIDE(TSourceNotebook(FAOwner).MainIDE).SearchPaths;
|
||||
Writeln('Searcvhdir is '+Searchdir);
|
||||
Num := pos(';',SearchDir);
|
||||
While (not Found) and (SearchDir <> '') do
|
||||
Begin
|
||||
if Num = 0 then Num := Length(SearchDir)+1;
|
||||
TempDir := Copy(SearchDir,1,num-1);
|
||||
Delete(SearchDir,1,Num);
|
||||
if tempDir[Length(TempDir)] <> DirDelimiter then
|
||||
TempDir := TempDir + DirDelimiter;
|
||||
Found := True;
|
||||
|
||||
if FileExists(TempDir+Value) then
|
||||
Result := TempDir+Value
|
||||
else
|
||||
Found := False;
|
||||
end; //while
|
||||
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Function TSourceEditor.ccParse(Texts : String) : TStrings;
|
||||
const
|
||||
symtable = '---Symtable ';
|
||||
Level1 = ' ***';
|
||||
Level2 = ' ***';
|
||||
|
||||
kdClass = 1;
|
||||
kdProcedure = 2;
|
||||
|
||||
var
|
||||
s : TStrings;
|
||||
I : Integer;
|
||||
Browser : TStringList;
|
||||
UnitStart : Integer;
|
||||
Found : Boolean;
|
||||
tempFile : TStringList;
|
||||
tempFileName : String;
|
||||
TempLine : String;
|
||||
kind : Integer;
|
||||
num1,num2 : Integer;
|
||||
begin
|
||||
TempFile := TStringList.Create;
|
||||
S := TStringList.Create;
|
||||
Result := nil;
|
||||
Browser := TstringList.Create;
|
||||
Browser.LoadFromFile(ExtractFilePath(Application.Exename)+'browser.log');
|
||||
|
||||
|
||||
|
||||
For I := 0 to Browser.Count-1 do
|
||||
if Browser.strings[I] = symtable+uppercase(Unitname) then
|
||||
break;
|
||||
|
||||
if I >=Browser.Count-1 then Exit;
|
||||
|
||||
UnitStart := I;
|
||||
|
||||
//remove the period from TEXTS if it's the last character
|
||||
if Texts[length(texts)] = '.' then
|
||||
Begin
|
||||
Texts := Copy(Texts,1,Length(texts)-1);
|
||||
kind := kdClass;
|
||||
end
|
||||
else
|
||||
if Texts[length(texts)] = '(' then
|
||||
Begin
|
||||
Texts := Copy(Texts,1,Length(texts)-1);
|
||||
kind := kdProcedure;
|
||||
end
|
||||
else
|
||||
Exit;
|
||||
|
||||
Texts := uppercase(texts);
|
||||
//find ***TEXTS***
|
||||
Found := False;
|
||||
I := UnitStart+1;
|
||||
While (Browser.strings[I] <> symtable+uppercase(Unitname)) and (not found) do
|
||||
if Browser.Strings[I] = Level1+Texts+'***' then
|
||||
Found := true
|
||||
else
|
||||
inc(i);
|
||||
|
||||
if Found then
|
||||
begin //determine what it is.
|
||||
//grab the line it's defined on.
|
||||
Writeln('The next line is '+Browser.Strings[i+1]);
|
||||
TempFileName := Copy(trim(Browser.Strings[i+1]),1,pos('(',trim(Browser.Strings[i+1]))-1);
|
||||
Writeln('TemmpFileName = '+TempFilename);
|
||||
if FileExists('./temp/'+TempFileName) then
|
||||
TempFileName := './temp/'+TempFileName
|
||||
else
|
||||
TempFileName := FindFile(TempFileName);
|
||||
|
||||
if TempFileName = '' then Exit;
|
||||
tempFile.LoadFromFile(TempFileName);
|
||||
//ok, the file is loaded. Parse it to see what TEXTS is defined as.
|
||||
Num1 := pos('(',Browser.Strings[i+1])+1;
|
||||
Num2 := ((pos(',',Browser.Strings[i+1])-1) - pos('(',Browser.Strings[i+1])+1)-1;
|
||||
tempLine := TempFile.Strings[StrtoInt(Copy(Browser.Strings[i+1],Num1,Num2))-1];
|
||||
writeln('TEMPLINE = '+TempLine);
|
||||
//templine now contains Form1: TForm1; or something like that
|
||||
|
||||
case Kind of
|
||||
kdClass : //search for a colon then the name
|
||||
Begin
|
||||
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
S.Add('testing');
|
||||
Result := s;
|
||||
|
||||
end;
|
||||
|
||||
Procedure TSourceEditor.ccAddMessage(Texts : String);
|
||||
Begin
|
||||
ErrorMsgs.Add(Texts);
|
||||
End;
|
||||
|
||||
|
||||
Procedure TSourceEditor.ccExecute(Sender : TObject);
|
||||
type
|
||||
|
||||
TMethodRec = record
|
||||
Flags : TParamFlags;
|
||||
ParamName : ShortString;
|
||||
@ -885,8 +1030,10 @@ var
|
||||
propKind : TTypeKind;
|
||||
TypeInfo : PTypeInfo;
|
||||
TypeData : PTypeData;
|
||||
NewStr : String;
|
||||
Count : Integer;
|
||||
NewStr,ParamStr : String;
|
||||
Count,Offset,Len : Integer;
|
||||
MethodRec : TMethodRec;
|
||||
|
||||
Begin
|
||||
CompInt := nil;
|
||||
Writeln('[ccExecute]');
|
||||
@ -906,75 +1053,67 @@ Begin
|
||||
Writeln('Property Name is '+CompInt.GetPropName(I));
|
||||
PropKind := CompInt.GetPropType(i);
|
||||
case PropKind of
|
||||
tkMethod : Begin
|
||||
TypeInfo := CompInt.GetPropTypeInfo(I);
|
||||
TypeData := GetTypeData(TypeInfo);
|
||||
NewStr := CompInt.GetPropName(I);
|
||||
case TypeData^.MethodKind of
|
||||
mkProcedure : NewStr := 'property '+CompInt.GetPropName(I)+' :'+CompInt.GetPropTypeName(I);
|
||||
mkFunction : NewStr := 'property '+CompInt.GetPropName(I)+' :'+CompInt.GetPropTypeName(I);
|
||||
mkClassFunction : NewStr := CompInt.GetPropName(I) + ' '+'Function ';
|
||||
mkClassPRocedure : NewStr := CompInt.GetPropName(I) + ' '+'Procedure ';
|
||||
mkConstructor : NewStr := 'constructor '+CompInt.GetPropName(I) + ' '+'procedure ';
|
||||
mkDestructor : NewStr := 'destructor '+CompInt.GetPropName(I) + ' '+'procedure ';
|
||||
tkMethod :
|
||||
Begin
|
||||
TypeInfo := CompInt.GetPropTypeInfo(I);
|
||||
TypeData := GetTypeData(TypeInfo);
|
||||
|
||||
end;
|
||||
|
||||
//check for parameters
|
||||
Writeln('ParamCount = '+inttostr(TypeData^.ParamCount));
|
||||
if TypeData^.ParamCount > 0 then
|
||||
Begin
|
||||
Writeln('----');
|
||||
for Count := 0 to sizeof(TypeData^.ParamList)-1 do
|
||||
if TypeData^.ParamList[4+Count] in ['a'..'z','A'..'Z','0'..'9'] then
|
||||
Write(TypeData^.ParamList[Count])
|
||||
else
|
||||
Begin
|
||||
Writeln('----');
|
||||
break;
|
||||
end;
|
||||
|
||||
{ NewStr := NewStr+'(';
|
||||
for Count := 0 to TypeData^.ParamCount-1 do
|
||||
begin
|
||||
MethodRec.Flags := [];
|
||||
Temp := '';
|
||||
For X := 0 to Sizeof(MethodRec.Flags)-1 do
|
||||
begin
|
||||
Writeln('-->'+TypeData^.ParamList[Sizeof(MethodRec)*Count]);
|
||||
Temp := Temp +TypeData^.ParamList[X+((Sizeof(MethodRec)-1)*Count)];
|
||||
end;
|
||||
Writeln('TEMP is <'+temp+'>');
|
||||
MethodRec.ParamName := '';
|
||||
For X := 0 to Sizeof(MethodRec.ParamName)-1 do
|
||||
if TypeData^.ParamList[(Sizeof(MethodRec.Flags)-1)+((Sizeof(MethodRec)-1)*Count)+x] in ['a'..'z','A'..'Z','0'..'9'] then
|
||||
MethodRec.ParamName := MethodRec.ParamName+TypeData^.ParamList[(Sizeof(MethodRec.Flags)-1)+((Sizeof(MethodRec)-1)*Count)+x]
|
||||
else
|
||||
break;
|
||||
|
||||
Writeln('ParamName is '+MethodRec.ParamName);
|
||||
MethodRec.TypeName := '';
|
||||
For X := 0 to Sizeof(MethodRec.TypeName)-1 do
|
||||
if TypeData^.ParamList[(Sizeof(MethodRec.Paramname)-1)+Sizeof(MethodRec.Flags)+((Sizeof(MethodRec)-1)*Count)+x] in ['a'..'z','A'..'Z','0'..'9'] then
|
||||
MethodRec.TypeName := MethodRec.TypeName+TypeData^.ParamList[Sizeof(MethodRec.Paramname)+Sizeof(MethodRec.Flags)+((Sizeof(MethodRec)-1)*Count)+x]
|
||||
else
|
||||
break;
|
||||
Writeln('TypeName is '+MethodRec.TypeName);
|
||||
|
||||
// TParamFlags = set of (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut);
|
||||
if (pfVar in MethodRec.Flags) then NewStr := NewStr+'var ';
|
||||
if (pfConst in MethodRec.Flags) then NewStr := NewStr+'const ';
|
||||
if (pfOut in MethodRec.Flags) then NewStr := NewStr+'out ';
|
||||
if MethodRec.Typename <> 'void' then
|
||||
NewStr := NewStr+MethodRec.ParamName+' :'+MethodRec.TypeName;
|
||||
|
||||
end;
|
||||
//check for parameters
|
||||
//Writeln('ParamCount = '+inttostr(TypeData^.ParamCount));
|
||||
if TypeData^.ParamCount > 0 then
|
||||
Begin
|
||||
{Writeln('----');
|
||||
for Count := 0 to 60 do
|
||||
if TypeData^.ParamList[Count] in ['a'..'z','A'..'Z','0'..'9'] then
|
||||
Write(TypeData^.ParamList[Count])
|
||||
else
|
||||
Begin
|
||||
Write('$',HexStr(ord(TypeData^.ParamList[Count]),3),' ');
|
||||
end;
|
||||
}
|
||||
ParamStr := '';
|
||||
Offset:=0;
|
||||
for Count := 0 to TypeData^.ParamCount-1 do
|
||||
begin
|
||||
Len:=1; // strange: SizeOf(TParamFlags) is 4, but the data is only 1 byte
|
||||
Move(TypeData^.ParamList[Offset],MethodRec.Flags,Len);
|
||||
inc(Offset,Len);
|
||||
|
||||
Len:=ord(TypeData^.ParamList[Offset]);
|
||||
inc(Offset);
|
||||
SetLength(MethodRec.ParamName,Len);
|
||||
Move(TypeData^.ParamList[Offset],MethodRec.ParamName[1],Len);
|
||||
inc(Offset,Len);
|
||||
|
||||
Len:=ord(TypeData^.ParamList[Offset]);
|
||||
inc(Offset);
|
||||
SetLength(MethodRec.TypeName,Len);
|
||||
Move(TypeData^.ParamList[Offset],MethodRec.TypeName[1],Len);
|
||||
inc(Offset,Len);
|
||||
|
||||
if ParamStr<>'' then ParamStr:=';'+ParamStr;
|
||||
if MethodRec.ParamName='' then
|
||||
ParamStr:=MethodRec.TypeName+ParamStr
|
||||
else
|
||||
ParamStr:=MethodRec.ParamName+':'+MethodRec.TypeName+ParamStr;
|
||||
if (pfVar in MethodRec.Flags) then ParamStr := 'var '+ParamStr;
|
||||
if (pfConst in MethodRec.Flags) then ParamStr := 'const '+ParamStr;
|
||||
if (pfOut in MethodRec.Flags) then ParamStr := 'out '+ParamStr;
|
||||
end;
|
||||
NewStr:='('+ParamStr+')';
|
||||
end else NewStr:='';
|
||||
case TypeData^.MethodKind of
|
||||
mkProcedure : NewStr := 'property '+CompInt.GetPropName(I)+' :'+CompInt.GetPropTypeName(I);
|
||||
mkFunction : NewStr := 'property '+CompInt.GetPropName(I)+' :'+CompInt.GetPropTypeName(I);
|
||||
mkClassFunction : NewStr := 'function '+CompInt.GetPropName(I) + ' :'+'Function '+NewStr;
|
||||
mkClassProcedure : NewStr := 'procedure '+CompInt.GetPropName(I) + ' :'+'Procedure '+NewStr;
|
||||
mkConstructor : NewStr := 'constructor '+CompInt.GetPropName(I) + ' '+'procedure ';
|
||||
mkDestructor : NewStr := 'destructor '+CompInt.GetPropName(I) + ' '+'procedure ';
|
||||
end;
|
||||
//writeln(NewStr);
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
tkObject : NewStr := 'tkobject '+CompInt.GetPropName(I) +' :'+CompInt.GetPropTypeName(I);
|
||||
tkInteger,tkChar,tkEnumeration,tkWChar : NewStr := 'property ' +CompInt.GetPropName(I) +' :'+CompInt.GetPropTypeName(I);
|
||||
tkBool : NewStr := 'property '+CompInt.GetPropName(I) +' :'+CompInt.GetPropTypeName(I);
|
||||
@ -992,6 +1131,14 @@ Writeln('----');
|
||||
sCompl.ItemList := S;
|
||||
End;
|
||||
|
||||
Procedure TSourceEditor.ccOnTimer(sender : TObject);
|
||||
Begin
|
||||
CodeCOmpletionTimer.Enabled := False;
|
||||
// FEditor.KeyDown(FEditor,word(' '),[ssCtrl]);
|
||||
End;
|
||||
|
||||
|
||||
|
||||
|
||||
Procedure TSourceEditor.CreateEditor(AOwner : TComponent; AParent: TWinControl);
|
||||
Begin
|
||||
@ -1229,6 +1376,9 @@ Begin
|
||||
try
|
||||
Add(Format('unit %s;', [FUnitName]));
|
||||
Add('');
|
||||
Add('{$mode objfpc}');
|
||||
Add('{$H+}');
|
||||
Add('');
|
||||
Add('interface');
|
||||
Add('');
|
||||
Add('uses Classes, Graphics, Controls, Forms, Dialogs;');
|
||||
@ -1277,6 +1427,8 @@ Begin
|
||||
try
|
||||
Add(Format('unit %s;', [FUnitName]));
|
||||
Add('');
|
||||
add('{$mode objfpc}');
|
||||
Add('');
|
||||
Add('interface');
|
||||
Add('');
|
||||
Add('implementation');
|
||||
@ -1314,7 +1466,9 @@ Begin
|
||||
FEditor.Lines.LoadFromFile(FileName);
|
||||
FModified := False;
|
||||
FUnitName := ExtractFileName(Filename);
|
||||
|
||||
//remove extension
|
||||
if pos('.',FUnitname) <> 0 then
|
||||
Delete(FUnitName,pos('.',FUnitname),length(FUnitname));
|
||||
//see if this is a form file
|
||||
CreateFormfromUnit;
|
||||
except
|
||||
@ -1463,6 +1617,11 @@ begin
|
||||
|
||||
GotoDialog := TfrmGoto.Create(self);
|
||||
|
||||
CodeCompletionTimer := TTimer.Create(self);
|
||||
CodeCOmpletionTimer.Enabled := False;
|
||||
CodeCompletionTimer.Interval := 500;
|
||||
|
||||
|
||||
Writeln('TSOurceNotebook create exiting');
|
||||
end;
|
||||
|
||||
@ -2006,7 +2165,7 @@ begin
|
||||
inherited;
|
||||
position := poScreenCenter;
|
||||
Width := 250;
|
||||
Height := 150;
|
||||
Height := 100;
|
||||
Caption := 'Goto';
|
||||
|
||||
Label1 := TLabel.Create(self);
|
||||
@ -2035,8 +2194,8 @@ begin
|
||||
with btnOK do
|
||||
Begin
|
||||
Parent := self;
|
||||
Top := 110;
|
||||
Left := 100;
|
||||
Top := 70;
|
||||
Left := 40;
|
||||
Visible := True;
|
||||
kind := bkOK
|
||||
end;
|
||||
@ -2045,8 +2204,8 @@ begin
|
||||
with btnCancel do
|
||||
Begin
|
||||
Parent := self;
|
||||
Top := 110;
|
||||
Left := 180;
|
||||
Top := 70;
|
||||
Left := 120;
|
||||
Visible := True;
|
||||
kind := bkCancel
|
||||
end;
|
||||
@ -2067,3 +2226,77 @@ Editor_Num := 0;
|
||||
{$I designer/bookmark.lrs}
|
||||
|
||||
end.
|
||||
|
||||
{old ccexecute procedure
|
||||
|
||||
Procedure TSourceEditor.ccExecute(Sender : TObject);
|
||||
var
|
||||
Browserfile : TStrings;
|
||||
UnitSource : Tstrings;
|
||||
I : Integer;
|
||||
Texts : String;
|
||||
CompName : String;
|
||||
ccStrings : TStrings;
|
||||
Begin
|
||||
try
|
||||
If FileExists(ExtractFilePath(Application.Exename)+'browser.log') then
|
||||
DeleteFile(ExtractFilePath(Application.Exename)+'browser.log');
|
||||
FEditor.Cursor := crHourGlass;
|
||||
UnitSource := TStringList.Create;
|
||||
UnitSource.Assign(Source);
|
||||
|
||||
sCompl := TSynBaseCompletion(Sender);
|
||||
CompName := sCompl.CurrentString;
|
||||
Writeln('CompName = '+CompName);
|
||||
|
||||
Texts := UnitSource.Strings[CurrentCursorYLine-1];
|
||||
|
||||
(* //delete the selected portion of the source and save it
|
||||
I := CurrentCursorXPos;
|
||||
While (I > 0) and (not Texts[I] in [';','}','(
|
||||
for now just delete the line
|
||||
*)
|
||||
UnitSource.Strings[CurrentCursorYLine-1] := '';
|
||||
if pos('.',UnitName) = 0 then
|
||||
UnitSource.SavetoFile('./temp/'+unitname+'.pp')
|
||||
else
|
||||
UnitSource.SavetoFile('./temp/'+unitname);
|
||||
|
||||
|
||||
|
||||
ErrorMsgs := TStringList.Create;
|
||||
|
||||
Compiler1.OutputString := @ccAddMessage;
|
||||
|
||||
if pos('.',UnitName) = 0 then
|
||||
Compiler1.Compile(' -bl ./temp/'+unitname+'.pp')
|
||||
else
|
||||
Compiler1.Compile(' -bl ./temp/'+unitname);
|
||||
|
||||
|
||||
For I := 0 to ErrorMsgs.Count-1 do
|
||||
Writeln(ErrorMsgs.Strings[i]);
|
||||
|
||||
|
||||
If FileExists(ExtractFilePath(Application.Exename)+'browser.log') then
|
||||
Begin
|
||||
//parse the browser.log file
|
||||
ccStrings := ccParse(CompName);
|
||||
if Assigned(ccStrings) then
|
||||
sCompl.ItemList := ccStrings;
|
||||
end
|
||||
else
|
||||
begin
|
||||
sCompl.Deactivate;
|
||||
Messagedlg.Show;
|
||||
MessageDlg.Clear;
|
||||
For I := 0 to ErrorMsgs.Count-1 do
|
||||
MessageDlg.Add(ErrorMsgs.Strings[i]);
|
||||
end;
|
||||
ErrorMsgs.Free;
|
||||
|
||||
finally
|
||||
FEditor.Cursor := crDefault;
|
||||
end;
|
||||
End;
|
||||
}
|
||||
|
||||
@ -184,6 +184,7 @@ type
|
||||
property FormStyle;
|
||||
property PopupMenu;
|
||||
property Position;
|
||||
property ShowHint;
|
||||
property Visible;
|
||||
// property WindowState;
|
||||
property OnActivate;
|
||||
|
||||
@ -62,6 +62,7 @@ begin
|
||||
Height := 200;
|
||||
end;
|
||||
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCustomRadioGroup.Destroy
|
||||
Params: none
|
||||
@ -93,41 +94,42 @@ var
|
||||
horzDist: integer;
|
||||
rbWidth : integer;
|
||||
begin
|
||||
vertDist := Height DIV ((FItems.Count DIV FColumns) + 2);
|
||||
nextTop := vertDist;
|
||||
horzDist := (Width - 20) DIV FColumns;
|
||||
nextLeft := 10;
|
||||
rbWidth := horzDist;
|
||||
FButtonList.Clear;
|
||||
i := 0;
|
||||
while i < FItems.Count do
|
||||
begin
|
||||
if FItems.Count>0 then begin
|
||||
vertDist := (Height - 20) DIV (((FItems.Count-1) DIV FColumns)+1);
|
||||
horzDist := (Width - 20) DIV FColumns;
|
||||
nextTop := 0;
|
||||
nextLeft := 10;
|
||||
rbWidth := horzDist;
|
||||
FButtonList.Clear;
|
||||
i := 0;
|
||||
while i < FItems.Count do
|
||||
begin
|
||||
Temp := TRadioButton.Create (self);
|
||||
Temp.Parent := self;
|
||||
Temp.Top := nextTop;
|
||||
Temp.Left := nextLeft;
|
||||
Temp.Width := rbWidth;
|
||||
Temp.Height := vertDist;
|
||||
Temp.Caption := FItems.Strings [i];
|
||||
|
||||
if i = FItemIndex
|
||||
then Temp.Checked := true
|
||||
else Temp.Checked := false;
|
||||
Temp.Caption := FItems.Strings[i];
|
||||
Temp.Checked := (i = FItemIndex);
|
||||
Temp.Show;
|
||||
FButtonList.Add (Temp);
|
||||
|
||||
inc (i);
|
||||
if (i MOD FColumns) = 0 then
|
||||
begin
|
||||
inc (nextTop, vertDist);
|
||||
nextLeft := 10;
|
||||
inc(nextTop, vertDist);
|
||||
nextLeft := 10;
|
||||
end
|
||||
else begin
|
||||
inc (nextLeft, horzDist);
|
||||
inc(nextLeft, horzDist);
|
||||
end;
|
||||
end;
|
||||
inherited CreateWnd;
|
||||
end;
|
||||
end;
|
||||
inherited CreateWnd;
|
||||
end;
|
||||
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCustomRadioGroup.ItemsChanged
|
||||
Params: sender : object calling this proc. (in fact the FItems instance)
|
||||
@ -243,6 +245,12 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2001/02/06 13:38:58 lazarus
|
||||
Fixes from Mattias for EditorOPtions
|
||||
Fixes to COmpiler that should allow people to compile if their path is set up.
|
||||
Changes to code completion.
|
||||
Shane
|
||||
|
||||
Revision 1.3 2001/02/01 19:34:50 lazarus
|
||||
TScrollbar created and a lot of code added.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user