diff options
63 files changed, 1687 insertions, 1020 deletions
diff --git a/examples/apps/uidesigner/newformdesigner.pas b/examples/apps/uidesigner/newformdesigner.pas index 175e4fa6..8a96997c 100644 --- a/examples/apps/uidesigner/newformdesigner.pas +++ b/examples/apps/uidesigner/newformdesigner.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -75,7 +75,6 @@ type previewmenu: TfpgPopupMenu; {@VFD_HEAD_END: frmMain} mru: TfpgMRU; - constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetSelectedWidget: TVFDWidgetClass; @@ -89,11 +88,11 @@ type TPropertyList = class(TObject) private FList: TList; + function GetCount: integer; public Widget: TfpgWidget; constructor Create; destructor Destroy; override; - function GetCount: integer; procedure Clear; property Count: integer read GetCount; procedure AddItem(aProp: TVFDWidgetProperty); @@ -346,7 +345,7 @@ begin SetPosition(116, 60, 200, 22); Items.Add('-'); FontDesc := '#List'; - FocusItem := 1; + FocusItem := 0; end; filemenu := TfpgPopupMenu.Create(self); @@ -415,7 +414,7 @@ begin x := 0; - for n := 1 to VFDWidgetCount do + for n := 0 to VFDWidgetCount-1 do begin wgc := VFDWidget(n); btn := TwgPaletteButton.Create(wgpalette); @@ -457,12 +456,10 @@ begin if TwgPaletteButton(Sender).Down then begin s := TwgPaletteButton(Sender).VFDWidget.WidgetClass.ClassName; - i := chlPalette.Items.IndexOf(s); - if i >= 0 then - chlPalette.FocusItem := i + 1; - end - else - chlPalette.FocusItem := 1; + chlPalette.FocusItem := chlPalette.Items.IndexOf(s); + end; + if chlPalette.FocusItem = -1 then + chlPalette.FocusItem := 0; end; { TfrmProperties } @@ -665,20 +662,11 @@ end; procedure TPropertyList.AddItem(aProp: TVFDWidgetProperty); begin - { - result := TPropertyLine.Create; - result.name := aPropName; - result.propclass := apropclass; - result.value := aPropName; -} FList.Add(aProp); end; procedure TPropertyList.Clear; - //var - // n : integer; begin - //for n:=0 to FList.Count-1 do TObject(FList[n]).Free; FList.Clear; end; @@ -702,17 +690,17 @@ end; function TPropertyList.GetItem(index: integer): TVFDWidgetProperty; begin - if (index < 1) or (index > Count) then + if (index < 0) or (index > Count-1) then Result := nil else - Result := TVFDWidgetProperty(FList[index - 1]); + Result := TVFDWidgetProperty(FList[index]); end; { TwgPropertyList } constructor TwgPropertyList.Create(AOwner: TComponent); begin - inherited; + inherited Create(AOwner); NameWidth := 80; editor := nil; OnChange := @OnRowChange; @@ -741,10 +729,9 @@ var prop: TVFDWidgetProperty; r: TfpgRect; begin - //inherited; prop := Props.GetItem(num); if prop = nil then - Exit; + Exit; //==> x := rect.left; y := rect.top; @@ -782,9 +769,7 @@ end; procedure TwgPropertyList.OnUpdateProperty(Sender: TObject); begin -// writeln('updating property...'); editor.StoreValue(props.Widget); -// props.Widget.UpdateWindowPosition; end; procedure TwgPropertyList.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); @@ -887,8 +872,8 @@ end; function TfrmMain.GetSelectedWidget: TVFDWidgetClass; begin - if chlPalette.FocusItem > 1 then - Result := TVFDWidgetClass(chlPalette.Items.Objects[chlPalette.FocusItem - 1]) + if chlPalette.FocusItem > 0 then + Result := TVFDWidgetClass(chlPalette.Items.Objects[chlPalette.FocusItem]) else Result := nil; end; @@ -899,7 +884,7 @@ var begin if wgc = nil then begin - chlPalette.FocusItem := 1; + chlPalette.FocusItem := 0; for n := 0 to wgpalette.ComponentCount - 1 do if wgpalette.Components[n] is TwgPaletteButton then TwgPaletteButton(wgpalette.Components[n]).Down := False; @@ -943,10 +928,7 @@ end; procedure TwgPalette.HandlePaint; begin -// inherited HandlePaint; - Canvas.BeginDraw; Canvas.Clear(clWindowBackground); - Canvas.EndDraw; end; diff --git a/examples/apps/uidesigner/uidesigner.lpr b/examples/apps/uidesigner/uidesigner.lpr index 4b4c371f..96aef118 100644 --- a/examples/apps/uidesigner/uidesigner.lpr +++ b/examples/apps/uidesigner/uidesigner.lpr @@ -12,7 +12,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Description: - The starting unit for the uiDesigner project. + The starting unit for the UI Designer project. } program uidesigner; diff --git a/examples/apps/uidesigner/vfddesigner.pas b/examples/apps/uidesigner/vfddesigner.pas index 6eb79b9b..17e1bedc 100644 --- a/examples/apps/uidesigner/vfddesigner.pas +++ b/examples/apps/uidesigner/vfddesigner.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -49,7 +49,7 @@ type TOtherWidget = class(TfpgWidget) protected FFont: TfpgFont; - procedure HandlePaint; override; + procedure HandlePaint; override; public wgClassName: string; constructor Create(AOwner: TComponent); override; @@ -61,7 +61,7 @@ type TDesignedForm = class(TfpgForm) public - procedure AfterCreate; override; + procedure AfterCreate; override; end; @@ -145,9 +145,6 @@ implementation uses vfdmain, TypInfo; -type - // used to get to SetDesigning() in Form Designer - TComponentFriendClass = class(TComponent); { TWidgetDesigner } @@ -439,13 +436,13 @@ begin FWidgets := TList.Create; FWasDrag := False; - OneClickMove := True; //false; + OneClickMove := True; - FForm := TDesignedForm.Create(nil); - FForm.FormDesigner := self; - FForm.Name := maindsgn.NewFormName; - FForm.WindowTitle := FForm.Name; - FFormOther := ''; + FForm := TDesignedForm.Create(nil); + FForm.FormDesigner := self; + FForm.Name := maindsgn.NewFormName; + FForm.WindowTitle := FForm.Name; + FFormOther := ''; end; destructor TFormDesigner.Destroy; @@ -543,7 +540,7 @@ var n, dir: integer; cd, scd: TWidgetDesigner; begin - if FWidgets.Count < 1 then + if FWidgets.Count = 0 then Exit; if fw then @@ -894,7 +891,7 @@ end; procedure TFormDesigner.OnPaletteChange(Sender: TObject); begin - if PaletteForm.clist.FocusItem > 1 then + if PaletteForm.clist.FocusItem > 0 then FForm.MouseCursor := mcCross else FForm.MouseCursor := mcDefault; @@ -936,18 +933,18 @@ begin wgc := scd.FVFDClass; n := frmProperties.lstProps.FocusItem; - if (n > 0) and (PropList.GetItem(n) <> nil) then + if (n >= 0) and (PropList.GetItem(n) <> nil) then lastpropname := PropList.GetItem(n).Name else lastpropname := ''; - i := 0; + i := -1; if PropList.Widget <> wg then begin frmProperties.lstProps.ReleaseEditor; PropList.Clear; - for n := 1 to wgc.PropertyCount do + for n := 0 to wgc.PropertyCount-1 do begin PropList.AddItem(wgc.GetProperty(n)); if UpperCase(wgc.GetProperty(n).Name) = UpperCase(lastPropName) then @@ -955,7 +952,7 @@ begin end; PropList.Widget := wg; frmProperties.lstProps.Update; - if i > 0 then + if i > -1 then frmProperties.lstProps.FocusItem := i; end; @@ -1475,7 +1472,7 @@ begin s := s + ident + 'Anchors := ' + ts + LineEnding; end; - for n := 1 to wgc.PropertyCount do + for n := 0 to wgc.PropertyCount-1 do s := s + wgc.GetProperty(n).GetPropertySource(wg, ident); { @@ -1642,7 +1639,6 @@ begin WindowPosition := wpUser; WindowTitle := 'New Form'; SetPosition(300, 150, 300, 250); -// TComponentFriendClass(self).SetDesigning(True); end; @@ -1652,9 +1648,6 @@ procedure TOtherWidget.HandlePaint; var s: string; begin - Canvas.BeginDraw; - inherited HandlePaint; - Canvas.Clear(FBackgroundColor); Canvas.SetFont(FFont); Canvas.SetColor(clWidgetFrame); @@ -1662,8 +1655,6 @@ begin Canvas.SetTextColor(clText1); s := Name + ': ' + wgClassName; Canvas.DrawString(2, 2, s); - - Canvas.EndDraw; end; constructor TOtherWidget.Create(AOwner: TComponent); diff --git a/examples/apps/uidesigner/vfdeditors.pas b/examples/apps/uidesigner/vfdeditors.pas index 50a47b37..c5ba41e1 100644 --- a/examples/apps/uidesigner/vfdeditors.pas +++ b/examples/apps/uidesigner/vfdeditors.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -31,14 +31,18 @@ uses vfdforms; type + TItemEditorForm = class(TVFDDialog) + private + procedure btnClearClicked(Sender: TObject); + procedure OnButtonClick(Sender: TObject); public l1: TfpgLabel; edItems: TfpgMemo; - btnOK, + btnOK: TfpgButton; btnCancel: TfpgButton; + btnClear: TfpgButton; procedure AfterCreate; override; - procedure OnButtonClick(Sender: TObject); end; @@ -61,13 +65,23 @@ begin with edItems do begin SetPosition(8, 24, 344, 168); - Anchors := [anLeft, anTop, anRight, anBottom]; + Anchors := AllAnchors; end; - btnOK := CreateButton(self, 8, 200, 105, 'OK', @OnButtonClick); + btnClear := CreateButton(self, 8, 200, 80, 'Clear', @btnClearClicked); + btnClear.Anchors := [anLeft, anBottom]; + + btnOK := CreateButton(self, btnClear.Right + 4, 200, 80, 'OK', @OnButtonClick); btnOK.Anchors := [anLeft, anBottom]; - btnCancel := CreateButton(self, 244, 200, 105, 'Cancel', @OnButtonClick); + + btnCancel := CreateButton(self, Width-84, 200, 80, 'Cancel', @OnButtonClick); btnCancel.Anchors := [anRight, anBottom]; + +end; + +procedure TItemEditorForm.btnClearClicked(Sender: TObject); +begin + edItems.Lines.Clear; end; procedure TItemEditorForm.OnButtonClick(Sender: TObject); diff --git a/examples/apps/uidesigner/vfdfile.pas b/examples/apps/uidesigner/vfdfile.pas index 15e23d75..16910883 100644 --- a/examples/apps/uidesigner/vfdfile.pas +++ b/examples/apps/uidesigner/vfdfile.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -46,20 +46,21 @@ type NewFormsDecl: string; NewFormsImpl: string; constructor Create; - destructor Destroy; override; - function LoadFile(fname: string): boolean; - procedure AddBlock(aposition: integer; ablockid, aformname, ablockdata: string); - function BlockCount: integer; - function Block(index: integer): TVFDFileBlock; - procedure FreeBlocks; - function GetBlocks: integer; // parse file - function MergeBlocks: string; // store file - procedure AddNewFormDecl(formname, formheadblock: string); - procedure AddNewFormImpl(formname, formbody: string); - function FindFormBlock(blockid, formname: string): TVFDFileBlock; - procedure SetFormData(formname, headblock, bodyblock: string); - procedure NewFileSkeleton(unitname: string); + destructor Destroy; override; + function LoadFile(fname: string): boolean; + procedure AddBlock(aposition: integer; ablockid, aformname, ablockdata: string); + function BlockCount: integer; + function Block(index: integer): TVFDFileBlock; + procedure FreeBlocks; + function GetBlocks: integer; // parse file + function MergeBlocks: string; // store file + procedure AddNewFormDecl(formname, formheadblock: string); + procedure AddNewFormImpl(formname, formbody: string); + function FindFormBlock(blockid, formname: string): TVFDFileBlock; + procedure SetFormData(formname, headblock, bodyblock: string); + procedure NewFileSkeleton(unitname: string); end; + implementation @@ -109,9 +110,9 @@ end; function TVFDFile.Block(index: integer): TVFDFileBlock; begin Result := nil; - if (index < 1) or (index > FBlocks.Count) then + if (index < 0) or (index > FBlocks.Count-1) then Exit; - Result := TVFDFileBlock(FBlocks[index - 1]); + Result := TVFDFileBlock(FBlocks[index]); end; function TVFDFile.BlockCount: integer; @@ -141,7 +142,7 @@ var fb: TVFDFileBlock; begin Result := nil; - for n := 1 to BlockCount do + for n := 0 to BlockCount-1 do begin fb := Block(n); if (fb.BlockID = blockid) and (UpperCase(fb.FormName) = UpperCase(formname)) then @@ -156,7 +157,7 @@ procedure TVFDFile.FreeBlocks; var n: integer; begin - for n := 0 to FBlocks.Count - 1 do + for n := 0 to FBlocks.Count-1 do TVFDFileBlock(FBlocks[n]).Free; FBlocks.Clear; NewFormsDecl := ''; @@ -338,10 +339,8 @@ begin end; if not newsaved and (NewFormsImpl <> '') then - rs := rs + NewFormsImpl// do not loose new form data. - ; + rs := rs + NewFormsImpl; // do not loose new form data. - //writeln(rs); Result := rs; end; diff --git a/examples/apps/uidesigner/vfdformparser.pas b/examples/apps/uidesigner/vfdformparser.pas index 1acaed31..a3d7c966 100644 --- a/examples/apps/uidesigner/vfdformparser.pas +++ b/examples/apps/uidesigner/vfdformparser.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -41,7 +41,7 @@ type line: string; lineindex: integer; public - procedure nextline; + procedure NextLine; public constructor Create(const FormName, FormHead, FormBody: string); destructor Destroy; override; @@ -52,15 +52,17 @@ type end; -function GetIdentifier(var s: string): string; -function GetStringValue(var s: string): string; +function GetIdentifier(var s: string): string; +function GetStringValue(var s: string): string; procedure SkipSpaces(var s: string); -function CheckSymbol(var s: string; const sym: string): boolean; -function GetIntValue(var s: string): integer; -function GetBoolValue(var s: string): boolean; +function CheckSymbol(var s: string; const sym: string): boolean; +function GetIntValue(var s: string): integer; +function GetBoolValue(var s: string): boolean; + implementation + { TVFDFormParser } constructor TVFDFormParser.Create(const FormName, FormHead, FormBody: string); @@ -69,7 +71,7 @@ begin ffd := nil; BodyLines := TStringList.Create; BodyLines.Text := FormBody; - lineindex := 0; + lineindex := -1; end; destructor TVFDFormParser.Destroy; @@ -78,13 +80,13 @@ begin inherited; end; -procedure TVFDFormParser.nextline; +procedure TVFDFormParser.NextLine; begin repeat Inc(lineindex); - eob := (lineindex > BodyLines.Count); + eob := (lineindex > BodyLines.Count-1); if not eob then - line := trim(bodylines.Strings[lineindex - 1]) + line := trim(bodylines.Strings[lineindex]) else line := ''; until eob or (line <> ''); @@ -94,16 +96,12 @@ function TVFDFormParser.ParseForm: TFormDesigner; begin ffd := TFormDesigner.Create; ffd.Form.Name := fformname; - // parsing line by line // the unknown lines will be "other properties" - lineindex := 0; - nextline; - + lineindex := -1; + NextLine; ParseFormProperties; - ParseFormWidgets; - Result := ffd; end; @@ -250,10 +248,8 @@ begin while not eob and (pos('.CREATE(', UpperCase(line)) = 0) do begin lok := ReadWGProperty(line, ffd.Form, VFDFormWidget); - if not lok then ffd.FormOther := ffd.FormOther + line + LineEnding; - NextLine; end; end; @@ -307,7 +303,7 @@ begin wg := nil; wgc := nil; - for n := 1 to VFDWidgetCount do + for n := 0 to VFDWidgetCount-1 do begin wgc := VFDWidget(n); if wgclassuc = UpperCase(wgc.WidgetClass.ClassName) then @@ -532,7 +528,7 @@ begin if not lok then if wgc <> nil then - for n := 1 to wgc.PropertyCount do + for n := 0 to wgc.PropertyCount-1 do begin lok := wgc.GetProperty(n).ParseSourceLine(wg, line); if lok then diff --git a/examples/apps/uidesigner/vfdforms.pas b/examples/apps/uidesigner/vfdforms.pas index 508b64bf..8c19104a 100644 --- a/examples/apps/uidesigner/vfdforms.pas +++ b/examples/apps/uidesigner/vfdforms.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -161,18 +161,7 @@ begin clist.Top := 22; clist.Height := Height - clist.top - 2; clist.Anchors := [anLeft, anRight, anTop, anBottom]; - clist.Items.Add('-'); -{ - clist.Items.Add('Label'); - clist.Items.Add('Edit'); - clist.Items.Add('Button'); - clist.Items.Add('CheckBox'); - clist.Items.Add('ComboBox'); - clist.Items.Add('Memo'); - clist.Items.Add('ListBox'); - clist.Items.Add('[OTHER]'); -} clist.OnChange := @(maindsgn.OnPaletteChange); end; @@ -360,8 +349,8 @@ end; procedure TWidgetOrderForm.OnButtonClick(Sender: TObject); var - i, - n, + i: integer; + n: integer; myilev: integer; function IdentLevel(astr: string): integer; @@ -388,16 +377,16 @@ begin begin // up / down i := list.FocusItem; - if i < 1 then + if i < 0 then Exit; - myilev := IdentLevel(list.Items[i - 1]); + myilev := IdentLevel(list.Items[i]); if Sender = btnUP then begin - if (i > 1) and (IdentLevel(list.Items[i - 2]) = myilev) then + if (i > 0) and (IdentLevel(list.Items[i - 1]) = myilev) then begin - list.Items.Move(i - 1, i - 2); + list.Items.Move(i, i - 1); n := i; while (n < list.Items.Count) and (IdentLevel(list.Items[n]) > myilev) do @@ -410,24 +399,21 @@ begin end; end else if Sender = btnDOWN then - if (i < list.Items.Count) then + if (i < list.Items.Count-1) then begin - //list.Items.Move(i-1,i); - n := i; while (n < list.Items.Count) and (IdentLevel(list.Items[n]) > myilev) do - Inc(n)//list.Items.Move(n,n-1); - ; + Inc(n); - if (i = n) and (i < list.Items.Count - 1) and (IdentLevel(list.Items[i + 1]) > myilev) then + if (i = n) and (i < list.Items.Count-1) and (IdentLevel(list.Items[i]) > myilev) then Exit; - if (n > list.Items.Count - 1) then - Exit; + if (n > list.Items.Count-1) then + Exit; //==> while (n >= i) do begin - list.Items.Move(n, n - 1); + list.Items.Move(n, n + 1); Dec(n); end; @@ -444,16 +430,15 @@ begin begin ModalResult := 2; consumed := True; - end - else - inherited HandleKeyPress(keycode, shiftstate, consumed); + end; + inherited HandleKeyPress(keycode, shiftstate, consumed); end; procedure TfrmVFDSetup.LoadSettings; begin - chlGrid.FocusItem := gINI.ReadInteger('Options', 'GridResolution', 2); + chlGrid.FocusItem := gINI.ReadInteger('Options', 'GridResolution', 2); tbMRUFileCount.Position := gINI.ReadInteger('Options', 'MRUFileCount', 4); - cbFullPath.Checked := gINI.ReadBool('Options', 'ShowFullPath', True); + cbFullPath.Checked := gINI.ReadBool('Options', 'ShowFullPath', True); end; procedure TfrmVFDSetup.SaveSettings; diff --git a/examples/apps/uidesigner/vfdmain.pas b/examples/apps/uidesigner/vfdmain.pas index 53145c6d..d0e81778 100644 --- a/examples/apps/uidesigner/vfdmain.pas +++ b/examples/apps/uidesigner/vfdmain.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -38,8 +38,8 @@ type TMainDesigner = class(TObject) private - procedure SetEditedFileName(const Value: string); - procedure LoadGridResolution; + procedure SetEditedFileName(const Value: string); + procedure LoadGridResolution; protected FDesigners: TList; FFile: TVFDFile; @@ -137,23 +137,21 @@ begin TFormDesigner(FDesigners[n]).Free; end; FDesigners.Clear; - + if not fpgFileExists(fname) then begin ShowMessage('File does not exists.', 'Error loading form'); Exit; end; - Writeln('loading file...'); - FFile.LoadFile(fname); FFile.GetBlocks; - for n := 1 to FFile.BlockCount do + for n := 0 to FFile.BlockCount-1 do begin bl := FFile.Block(n); if bl.BlockID = 'VFD_HEAD_BEGIN' then - for m := n + 1 to FFile.BlockCount do + for m := n + 1 to FFile.BlockCount-1 do begin bl2 := FFile.Block(m); if (bl2.BlockID = 'VFD_BODY_BEGIN') and (bl2.FormName = bl.FormName) then @@ -213,7 +211,7 @@ begin FFile.NewFileSkeleton(uname); end; - for n := 1 to DesignerCount do + for n := 0 to DesignerCount-1 do begin fd := Designer(n); FFile.SetFormData(fd.Form.Name, fd.GetFormSourceDecl, fd.GetFormSourceImpl); @@ -229,11 +227,11 @@ begin finally CloseFile(ff); end; - // frmMain.WindowTitle := 'fpGUI Designer v' + program_version + ' - ' + fname; - // everything is done by SetEditedFileName (EditedFileName := ...) frmMain.mru.AddItem(fname); except - Writeln('Form save I/O failure.'); + on E: Exception do + raise Exception.Create('Form save I/O failure in TMainDesigner.OnSaveFile.' + #13 + + E.Message); end; end; @@ -277,7 +275,6 @@ var fd: TFormDesigner; nfrm: TNewFormForm; begin - Writeln('new form'); nfrm := TNewFormForm.Create(nil); if nfrm.ShowModal = 1 then if nfrm.edName.Text <> '' then @@ -292,8 +289,6 @@ begin end; procedure TMainDesigner.CreateWindows; - //var - // fd : TFormDesigner; begin frmMain := TfrmMain.Create(nil); frmMain.WindowTitle := 'fpGUI Designer v' + program_version; @@ -301,12 +296,6 @@ begin frmProperties := TfrmProperties.Create(nil); frmProperties.Show; - - // fd := TFormDesigner.Create; - // fd.Form.Name := 'frmNewForm'; - // fd.Form.WindowTitle := u8('frmNewForm'); - // FDesigners.Add(fd); - // fd.Show; end; constructor TMainDesigner.Create; @@ -338,7 +327,6 @@ end; procedure TMainDesigner.SelectForm(aform: TFormDesigner); begin - //Writeln('selected...'); if (SelectedForm <> nil) and (SelectedForm <> aform) then SelectedForm.DeSelectAll; SelectedForm := aform; @@ -347,9 +335,9 @@ end; function TMainDesigner.Designer(index: integer): TFormDesigner; begin Result := nil; - if (index < 1) or (index > FDesigners.Count) then + if (index < 0) or (index > FDesigners.Count-1) then Exit; - Result := TFormDesigner(FDesigners[index - 1]); + Result := TFormDesigner(FDesigners[index]); end; function TMainDesigner.DesignerCount: integer; @@ -366,14 +354,14 @@ begin repeat Inc(i); s := 'Form' + IntToStr(i); - n := 1; - while (n <= DesignerCount) do + n := 0; + while (n < DesignerCount) do begin if Designer(n).Form.Name = s then Break; Inc(n); end; - until n > DesignerCount; + until n > DesignerCount-1; Result := s; end; @@ -382,8 +370,6 @@ var fd: TFormDesigner; fp: TVFDFormParser; begin - Writeln('CreateParseForm: ', FormName); - fp := TVFDFormParser.Create(FormName, FormHead, FormBody); fd := fp.ParseForm; fp.Free; @@ -446,10 +432,10 @@ end; procedure TMainDesigner.LoadGridResolution; begin - case gINI.ReadInteger('Options', 'GridResolution', 2) of - 1: GridResolution := 2; - 2: GridResolution := 4; - 3: GridResolution := 8; + case gINI.ReadInteger('Options', 'GridResolution', 1) of + 0: GridResolution := 2; + 1: GridResolution := 4; + 2: GridResolution := 8; end; end; diff --git a/examples/apps/uidesigner/vfdpropeditgrid.pas b/examples/apps/uidesigner/vfdpropeditgrid.pas index 97ebb0e6..d31f7f5b 100644 --- a/examples/apps/uidesigner/vfdpropeditgrid.pas +++ b/examples/apps/uidesigner/vfdpropeditgrid.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -56,8 +56,8 @@ type TColumnsGrid = class(TfpgCustomGrid) protected - function GetRowCount: Longword; override; - procedure DrawCell(ARow, ACol: Longword; ARect: TfpgRect; AFlags: TfpgGridDrawState); override; + function GetRowCount: Integer; override; + procedure DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); override; public dbgrid: TfpgStringGrid; constructor Create(AOwner: TComponent); override; @@ -66,7 +66,7 @@ type TColumnEditForm = class(TfpgForm) private - procedure GridRowChange(Sender: TObject; row: Longword); + procedure GridRowChange(Sender: TObject; row: Integer); procedure EditChange(Sender: TObject); procedure NewButtonClick(Sender: TObject); procedure DeleteButtonClick(Sender: TObject); @@ -284,12 +284,12 @@ begin {@VFD_BODY_END: ColumnEditForm} end; -procedure TColumnEditForm.GridRowChange(Sender: TObject; row: Longword); +procedure TColumnEditForm.GridRowChange(Sender: TObject; row: Integer); var i: integer; c: TfpgStringColumn; begin - c := dbgrid.Columns[row{ - 1}]; + c := dbgrid.Columns[row]; if c = nil then Exit; @@ -298,11 +298,11 @@ begin edCOLWIDTH.Text := IntToStr(c.Width); case c.Alignment of taRightJustify: - i := 2; + i := 1; taCenter: - i := 3 + i := 2 else - i := 1; + i := 0; end; chlALIGN.FocusItem := i; end; @@ -311,15 +311,15 @@ procedure TColumnEditForm.SaveColumn(row: integer); var c: TfpgStringColumn; begin - c := dbgrid.Columns[row{ - 1}]; + c := dbgrid.Columns[row]; if c = nil then Exit; c.Title := edTITLE.Text; c.Width := StrToIntDef(edCOLWIDTH.Text, 30); case chlALIGN.FocusItem of - 2: c.Alignment := taRightJustify; - 3: c.Alignment := taCenter; + 1: c.Alignment := taRightJustify; + 2: c.Alignment := taCenter; else c.Alignment := taLeftJustify; end; @@ -330,7 +330,7 @@ end; procedure TColumnEditForm.EditChange(Sender: TObject); begin - if grid.FocusRow < 1 then + if grid.FocusRow < 0 then Exit; SaveColumn(grid.FocusRow); @@ -359,14 +359,14 @@ procedure TColumnEditForm.UpDownButtonClick(Sender: TObject); begin if Sender = btnUP then begin - if grid.FocusRow > 1 then + if grid.FocusRow > 0 then begin dbgrid.MoveColumn(grid.FocusRow - 1, grid.FocusRow - 2); grid.FocusRow := grid.FocusRow - 1; grid.Update; end; end - else if grid.FocusRow < grid.RowCount then + else if grid.FocusRow < grid.RowCount-1 then begin dbgrid.MoveColumn(grid.FocusRow - 1, grid.FocusRow); grid.FocusRow := grid.FocusRow + 1; @@ -377,7 +377,7 @@ end; { TColumnsGrid } -function TColumnsGrid.GetRowCount: Longword; +function TColumnsGrid.GetRowCount: Integer; begin try // Yes, it must be ColumnCount and *not* RowCount! @@ -387,7 +387,7 @@ begin end; end; -procedure TColumnsGrid.DrawCell(ARow, ACol: Longword; ARect: TfpgRect; AFlags: TfpgGridDrawState); +procedure TColumnsGrid.DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); var s: string; x: integer; @@ -404,10 +404,10 @@ begin x := ARect.Left + 1; case ACol of - 1: s := IntToStr(ARow); - 2: s := c.Title; - 3: s := IntToStr(c.Width); - 4: case c.Alignment of + 0: s := IntToStr(ARow); + 1: s := c.Title; + 2: s := IntToStr(c.Width); + 3: case c.Alignment of taRightJustify: s := 'Right'; taCenter: @@ -506,7 +506,7 @@ begin Result := ''; with TfpgStringGrid(wg) do begin - for f := 1 to ColumnCount do + for f := 0 to ColumnCount-1 do begin c := Columns[f]; case c.Alignment of diff --git a/examples/apps/uidesigner/vfdprops.pas b/examples/apps/uidesigner/vfdprops.pas index fa2c8cd7..7e033d24 100644 --- a/examples/apps/uidesigner/vfdprops.pas +++ b/examples/apps/uidesigner/vfdprops.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -62,10 +62,10 @@ type TPropertyStringList = class(TVFDWidgetProperty) public - function ParseSourceLine(wg: TfpgWidget; const line: string): boolean; override; - function GetPropertySource(wg: TfpgWidget; const ident: string): string; override; - function GetValueText(wg: TfpgWidget): string; override; - function CreateEditor(AOwner: TComponent): TVFDPropertyEditor; override; + function ParseSourceLine(wg: TfpgWidget; const line: string): boolean; override; + function GetPropertySource(wg: TfpgWidget; const ident: string): string; override; + function GetValueText(wg: TfpgWidget): string; override; + function CreateEditor(AOwner: TComponent): TVFDPropertyEditor; override; procedure OnExternalEdit(wg: TfpgWidget); override; end; @@ -79,10 +79,8 @@ type end; - { TPropertyFontDesc } - TPropertyFontDesc = class(TPropertyString) - function CreateEditor(AOwner: TComponent): TVFDPropertyEditor; override; + function CreateEditor(AOwner: TComponent): TVFDPropertyEditor; override; procedure OnExternalEdit(wg: TfpgWidget); override; end; @@ -151,19 +149,19 @@ uses fpgfx, gui_dialogs; + procedure EditStringList(sl: TStringList); var - frmie: TItemEditorForm; + frm: TItemEditorForm; begin - frmie := TItemEditorForm.Create(nil); - //GfxGetAbsolutePosition(PropertyForm.btnEdit.WinHandle, PropertyForm.btnEdit.width, 0, ax,ay); - //frmie.Left := ax; - //frmie.Top := ay; - - frmie.edItems.Lines.Assign(sl); - if frmie.ShowModal = 1 then - sl.Assign(frmie.edItems.Lines); - frmie.Free; + frm := TItemEditorForm.Create(nil); + try + frm.edItems.Lines.Assign(sl); + if frm.ShowModal = 1 then + sl.Assign(frm.edItems.Lines); + finally + frm.Free; + end; end; procedure GetEnumPropValueList(wg: TObject; const APropName: string; sl: TStringList); @@ -377,11 +375,18 @@ var f: integer; begin sl := TStringList(GetObjectProp(wg, Name, TStrings)); + if not Assigned(sl) then + raise Exception.Create('Failed to find TStrings type property.'); Result := ''; - for f := 0 to sl.Count - 1 do - Result := Result + ident + Name + '.Add(' + QuotedStr(sl.Strings[f]) + ');' + LineEnding; + //if sl.Text <> '' then + //begin + //writeln('Text = <', sl.Text, '>'); + //writeln('StringList.Count = ', sl.Count); + for f := 0 to sl.Count - 1 do + Result := Result + ident + Name + '.Add(' + QuotedStr(sl.Strings[f]) + ');' + LineEnding; + //end; end; function TPropertyStringList.GetValueText(wg: TfpgWidget): string; @@ -389,6 +394,8 @@ var sl: TStringList; begin sl := TStringList(GetObjectProp(wg, Name, TStrings)); + if not Assigned(sl) then + raise Exception.Create('Failed to find TStrings type property.'); Result := '[' + IntToStr(sl.Count) + ' lines]'; end; @@ -397,6 +404,8 @@ var sl: TStringList; begin sl := TStringList(GetObjectProp(wg, Name, TStrings)); + if not Assigned(sl) then + raise Exception.Create('Failed to find TStrings type property.'); EditStringList(sl); end; @@ -424,6 +433,8 @@ begin if Result then begin sl := TStringList(GetObjectProp(wg, Name, TStrings)); + if not Assigned(sl) then + raise Exception.Create('Failed to find TStrings type property.'); sl.Add(sval); end; end; @@ -498,12 +509,10 @@ begin // Exit; if widget = nil then Exit; - Canvas.BeginDraw; Canvas.Clear(clBoxColor); Canvas.GetWinRect(r); Canvas.SetTextColor(clText1); prop.DrawValue(Widget, Canvas, r, 0); - Canvas.EndDraw; end; procedure TExternalPropertyEditor.CreateLayout; @@ -616,12 +625,12 @@ begin sv := GetEnumProp(wg, prop.Name); sl := TStringList.Create; GetEnumPropValueList(wg, prop.Name, sl); - fi := 1; + fi := 0; for i := 0 to sl.Count - 1 do begin chl.Items.Add(sl.Strings[i]); if UpperCase(sv) = UpperCase(sl.Strings[i]) then - fi := i + 1; + fi := i; end; chl.FocusItem := fi; sl.Free; @@ -642,9 +651,9 @@ begin chl.Items.Add('True'); chl.Items.Add('False'); if b = 1 then - chl.FocusItem := 1 + chl.FocusItem := 0 else - chl.FocusItem := 2; + chl.FocusItem := 1; end; procedure TBooleanPropertyEditor.StoreValue(wg: TfpgWidget); diff --git a/examples/apps/uidesigner/vfdresizer.pas b/examples/apps/uidesigner/vfdresizer.pas index 137fdbd4..9944e3b6 100644 --- a/examples/apps/uidesigner/vfdresizer.pas +++ b/examples/apps/uidesigner/vfdresizer.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -31,10 +31,10 @@ type TwgResizer = class(TfpgWidget) protected wgdesigner: TObject; - procedure HandlePaint; override; - procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; - procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; - procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; + procedure HandlePaint; override; + procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; + procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; + procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; public direction: integer; FDragging: boolean; @@ -43,9 +43,11 @@ type constructor Create(ACompDesigner: TObject; adirection: integer); reintroduce; procedure Show; end; + implementation + uses vfddesigner, vfdmain; @@ -54,10 +56,7 @@ uses procedure TwgResizer.HandlePaint; begin - Canvas.BeginDraw; - inherited HandlePaint; Canvas.Clear(FBackgroundColor); - Canvas.EndDraw; end; procedure TwgResizer.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); diff --git a/examples/apps/uidesigner/vfdutils.pas b/examples/apps/uidesigner/vfdutils.pas index fe60c933..90b99841 100644 --- a/examples/apps/uidesigner/vfdutils.pas +++ b/examples/apps/uidesigner/vfdutils.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, diff --git a/examples/apps/uidesigner/vfdwidgetclass.pas b/examples/apps/uidesigner/vfdwidgetclass.pas index 19308b35..9729691f 100644 --- a/examples/apps/uidesigner/vfdwidgetclass.pas +++ b/examples/apps/uidesigner/vfdwidgetclass.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -133,7 +133,7 @@ end; function TVFDWidgetClass.GetProperty(ind: integer): TVFDWidgetProperty; begin - Result := TVFDWidgetProperty(FProps[ind - 1]); + Result := TVFDWidgetProperty(FProps[ind]); end; function TVFDWidgetClass.PropertyCount: integer; diff --git a/examples/apps/uidesigner/vfdwidgets.pas b/examples/apps/uidesigner/vfdwidgets.pas index 73088160..71cacc1d 100644 --- a/examples/apps/uidesigner/vfdwidgets.pas +++ b/examples/apps/uidesigner/vfdwidgets.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -79,7 +79,7 @@ end; function VFDWidget(ind: integer): TVFDWidgetClass; begin - Result := TVFDWidgetClass(FVFDWidgets[ind - 1]); + Result := TVFDWidgetClass(FVFDWidgets[ind]); end; procedure RegisterVFDWidget(awc: TVFDWidgetClass); @@ -352,6 +352,7 @@ begin wc.AddProperty('Min', TPropertyInteger, ''); wc.AddProperty('Max', TPropertyInteger, ''); wc.AddProperty('Position', TPropertyInteger, ''); + wc.AddProperty('ShowCaption', TPropertyBoolean, ''); wc.WidgetIconName := 'vfd.progressbar'; RegisterVFDWidget(wc); @@ -362,6 +363,7 @@ begin wc.AddProperty('Min', TPropertyInteger, ''); wc.AddProperty('Orientation', TPropertyEnum, ''); wc.AddProperty('Position', TPropertyInteger, ''); + wc.AddProperty('ShowPosition', TPropertyBoolean, ''); wc.AddProperty('TabOrder', TPropertyInteger, 'The tab order'); wc.WidgetIconName := 'vfd.trackbar'; RegisterVFDWidget(wc); diff --git a/examples/gui/colorlistbox/frmMain.pas b/examples/gui/colorlistbox/frmMain.pas index 7fbe0327..5ec2d98c 100644 --- a/examples/gui/colorlistbox/frmMain.pas +++ b/examples/gui/colorlistbox/frmMain.pas @@ -83,7 +83,7 @@ begin cbName1.Items.Add('cpStandardColors'); cbName1.Items.Add('cpSystemColors'); cbName1.Items.Add('cpWebColors'); - cbName1.FocusItem := 1; + cbName1.FocusItem := 0; cbName1.OnChange := @cbName1Change; end; diff --git a/examples/gui/combobox/comboboxtest.lpi b/examples/gui/combobox/comboboxtest.lpi new file mode 100644 index 00000000..41183e45 --- /dev/null +++ b/examples/gui/combobox/comboboxtest.lpi @@ -0,0 +1,58 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="/"/> + <Version Value="6"/> + <General> + <Flags> + <SaveOnlyProjectUnits Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <IconPath Value="./"/> + <TargetFileExt Value=""/> + </General> + <VersionInfo> + <ProjectVersion Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_package"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="comboboxtest.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="comboboxtest"/> + </Unit0> + <Unit1> + <Filename Value="frm_main.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="frm_main"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Other> + <CustomOptions Value="-FUunits"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/examples/gui/combobox/comboboxtest.lpr b/examples/gui/combobox/comboboxtest.lpr new file mode 100644 index 00000000..a3a38da1 --- /dev/null +++ b/examples/gui/combobox/comboboxtest.lpr @@ -0,0 +1,29 @@ +program comboboxtest; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, fpgfx, frm_main; + +procedure MainProc; +var + frm: TMainForm; +begin + fpgApplication.Initialize; + frm := TMainForm.Create(nil); + try + frm.Show; + fpgApplication.Run; + finally + frm.Free; + end; +end; + +begin + MainProc; +end. + + diff --git a/examples/gui/combobox/extrafpc.cfg b/examples/gui/combobox/extrafpc.cfg new file mode 100644 index 00000000..073dc4b6 --- /dev/null +++ b/examples/gui/combobox/extrafpc.cfg @@ -0,0 +1,5 @@ +-FUunits +-Fu../../../lib +-Xs +-XX +-CX diff --git a/examples/gui/combobox/frm_main.pas b/examples/gui/combobox/frm_main.pas new file mode 100644 index 00000000..2b834b51 --- /dev/null +++ b/examples/gui/combobox/frm_main.pas @@ -0,0 +1,251 @@ +unit frm_main; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, gfxbase, fpgfx, gui_edit, + gfx_widget, gui_form, gui_label, gui_button, + gui_listbox, gui_memo, gui_combobox, gui_basegrid, gui_grid, + gui_dialogs, gui_checkbox, gui_tree, gui_trackbar, + gui_progressbar, gui_radiobutton, gui_tab, gui_menu, + gui_panel, gui_popupcalendar, gui_gauge, gui_editcombo; + +type + + TMainForm = class(TfpgForm) + private + procedure cbAutoCompleteChanged(Sender: TObject); + procedure cbAutoDropDownChanged(Sender: TObject); + procedure cbAllowNewChanged(Sender: TObject); + procedure btnAdd1Clicked(Sender: TObject); + procedure btnFocusClicked(Sender: TObject); + procedure btnClearClicked(Sender: TObject); + procedure btnAdd10Clicked(Sender: TObject); + public + {@VFD_HEAD_BEGIN: MainForm} + btnAdd10: TfpgButton; + btnClear: TfpgButton; + btnFocus: TfpgButton; + btnAdd1: TfpgButton; + cbAutoComplete: TfpgCheckBox; + Combo1: TfpgComboBox; + lblName1: TfpgLabel; + lblName2: TfpgLabel; + EditCombo1: TfpgEditCombo; + cbAutoDropdown: TfpgCheckBox; + lblName3: TfpgLabel; + lblName4: TfpgLabel; + cbAllowNew: TfpgComboBox; + {@VFD_HEAD_END: MainForm} + procedure AfterCreate; override; + end; + +{@VFD_NEWFORM_DECL} + +implementation + +{@VFD_NEWFORM_IMPL} + +procedure TMainForm.cbAutoCompleteChanged(Sender: TObject); +begin + EditCombo1.AutoCompletion := cbAutoComplete.Checked; +end; + +procedure TMainForm.cbAutoDropDownChanged(Sender: TObject); +begin + EditCombo1.AutoDropDown := cbAutoDropdown.Checked; +end; + +procedure TMainForm.cbAllowNewChanged(Sender: TObject); +begin + if cbAllowNew.Text = 'anNo' then + EditCombo1.AllowNew := anNo + else if cbAllowNew.Text = 'anYes' then + EditCombo1.AllowNew := anYes + else if cbAllowNew.Text = 'anAsk' then + EditCombo1.AllowNew := anAsk +end; + +procedure TMainForm.btnAdd1Clicked(Sender: TObject); +begin + Combo1.Items.Add(Format('Item %2d', [Combo1.Items.Count])); + EditCombo1.Items.Add(Format('Item %2d', [EditCombo1.Items.Count])); +end; + +procedure TMainForm.btnFocusClicked(Sender: TObject); +begin + if Combo1.Items.Count > 1 then + Combo1.FocusItem := 2; + if EditCombo1.Items.Count > 1 then + EditCombo1.FocusItem := 2; +end; + +procedure TMainForm.btnClearClicked(Sender: TObject); +begin + Combo1.Items.Clear; + EditCombo1.Items.Clear; +end; + +procedure TMainForm.btnAdd10Clicked(Sender: TObject); +var + i: integer; +begin + for i := 1 to 10 do + begin + Combo1.Items.Add(Format('Item %2d', [Combo1.Items.Count])); + EditCombo1.Items.Add(Format('Item %2d', [EditCombo1.Items.Count])); + end; +end; + +procedure TMainForm.AfterCreate; +begin + {@VFD_BODY_BEGIN: MainForm} + Name := 'MainForm'; + SetPosition(345, 220, 344, 260); + WindowTitle := 'ComboBox test'; + WindowPosition := wpScreenCenter; + + btnAdd10 := TfpgButton.Create(self); + with btnAdd10 do + begin + Name := 'btnAdd10'; + SetPosition(220, 28, 92, 23); + Text := 'Add 10 items'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 1; + OnClick := @btnAdd10Clicked; + end; + + btnClear := TfpgButton.Create(self); + with btnClear do + begin + Name := 'btnClear'; + SetPosition(220, 56, 92, 23); + Text := 'Clear Items'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 2; + OnClick := @btnClearClicked; + end; + + btnFocus := TfpgButton.Create(self); + with btnFocus do + begin + Name := 'btnFocus'; + SetPosition(220, 84, 92, 23); + Text := 'FocusItem = 2'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 3; + OnClick := @btnFocusClicked; + end; + + btnAdd1 := TfpgButton.Create(self); + with btnAdd1 do + begin + Name := 'btnAdd1'; + SetPosition(220, 112, 92, 23); + Text := 'Add 1 item'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 4; + OnClick := @btnAdd1Clicked; + end; + + cbAutoComplete := TfpgCheckBox.Create(self); + with cbAutoComplete do + begin + Name := 'cbAutoComplete'; + SetPosition(216, 168, 120, 19); + FontDesc := '#Label1'; + TabOrder := 6; + Text := 'Auto Complete'; + OnChange := @cbAutoCompleteChanged; + end; + + Combo1 := TfpgComboBox.Create(self); + with Combo1 do + begin + Name := 'Combo1'; + SetPosition(8, 24, 168, 21); + FontDesc := '#List'; + TabOrder := 6; + end; + + lblName1 := TfpgLabel.Create(self); + with lblName1 do + begin + Name := 'lblName1'; + SetPosition(8, 8, 176, 15); + FontDesc := '#Label1'; + Text := 'Static ComboBox'; + end; + + lblName2 := TfpgLabel.Create(self); + with lblName2 do + begin + Name := 'lblName2'; + SetPosition(8, 68, 176, 15); + FontDesc := '#Label1'; + Text := 'Edit ComboBox'; + end; + + EditCombo1 := TfpgEditCombo.Create(self); + with EditCombo1 do + begin + Name := 'EditCombo1'; + SetPosition(8, 88, 168, 21); + end; + + cbAutoDropdown := TfpgCheckBox.Create(self); + with cbAutoDropdown do + begin + Name := 'cbAutoDropdown'; + SetPosition(216, 188, 120, 19); + FontDesc := '#Label1'; + TabOrder := 9; + Text := 'Auto Dropdown'; + OnChange := @cbAutoDropDownChanged; + end; + + lblName3 := TfpgLabel.Create(self); + with lblName3 do + begin + Name := 'lblName3'; + SetPosition(204, 148, 128, 15); + FontDesc := '#Label2'; + Text := 'EditCombo only'; + end; + + lblName4 := TfpgLabel.Create(self); + with lblName4 do + begin + Name := 'lblName4'; + SetPosition(204, 8, 136, 15); + FontDesc := '#Label2'; + Text := 'Both components'; + end; + + cbAllowNew := TfpgComboBox.Create(self); + with cbAllowNew do + begin + Name := 'cbAllowNew'; + SetPosition(220, 212, 100, 21); + FontDesc := '#List'; + Items.Add('anNo'); + Items.Add('anYes'); + Items.Add('anAsk'); + TabOrder := 13; + OnChange := @cbAllowNewChanged; + FocusItem := 0; + end; + + {@VFD_BODY_END: MainForm} + +end; + + +end. diff --git a/examples/gui/filedialog/filedialog.lpr b/examples/gui/filedialog/filedialog.lpr index 29635dbb..e7fa99ce 100644 --- a/examples/gui/filedialog/filedialog.lpr +++ b/examples/gui/filedialog/filedialog.lpr @@ -55,7 +55,7 @@ type function TMyDBLoginDlg.GetDatabase: TfpgString; begin - Result := aStringList.ValueFromIndex[cbDatabases.FocusItem-1]; + Result := aStringList.ValueFromIndex[cbDatabases.FocusItem]; end; procedure TMyDBLoginDlg.PopulateComboDb; @@ -64,9 +64,9 @@ var begin aStringList.Clear; aStringList.Add('Database1=192.168.0.1:/data/db1.gdb'); - aStringList.Add('Database2=192.168.0.10:/data/live.gdb'); - aStringList.Add('Database3=192.168.0.150:/data/sometest.gdb'); - aStringList.Add('Database4=192.168.0.200:c:\MyData\test.gdb'); + aStringList.Add('Database2=192.168.0.10:/data/db2.gdb'); + aStringList.Add('Database3=192.168.0.150:/data/db3.gdb'); + aStringList.Add('Database4=192.168.0.200:c:\MyData\db4.gdb'); cbDatabases.Items.Clear; for i := 0 to aStringList.Count-1 do cbDatabases.Items.Add(aStringList.Names[i]); diff --git a/examples/gui/gridtest/gridtest.lpr b/examples/gui/gridtest/gridtest.lpr index a7bbe7fc..2bd6d4ec 100644 --- a/examples/gui/gridtest/gridtest.lpr +++ b/examples/gui/gridtest/gridtest.lpr @@ -34,13 +34,21 @@ type chkDisabled: TfpgCheckBox; edtTopRow: TfpgEditInteger; btnTopRow: TfpgButton; + btnAddFive: TfpgButton; + btnAddOne: TfpgButton; + btnFiveOnly: TfpgButton; {@VFD_HEAD_END: MainForm} + procedure StringGridDoubleClicked(Sender: TObject; AButton: TMouseButton; + AShift: TShiftState; const AMousePos: TPoint); + procedure btnAddFiveClicked(Sender: TObject); + procedure btnAddOneClicked(Sender: TObject); + procedure btnFiveOnlyClicked(Sender: TObject); procedure chkDisabledChange(Sender: TObject); procedure chkRowSelectChange(Sender: TObject); procedure chkShowHeaderChange(Sender: TObject); procedure chkShowGridChange(Sender: TObject); procedure btnQuitClick(Sender: TObject); - procedure stringgridDrawCell(Sender: TObject; const ARow, ACol: Longword; + procedure stringgridDrawCell(Sender: TObject; const ARow, ACol: Integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean); procedure btnTopRowClicked(Sender: TObject); public @@ -51,6 +59,30 @@ type { TMainForm } +procedure TMainForm.StringGridDoubleClicked(Sender: TObject; + AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); +var + lCol, lRow: integer; +begin + StringGrid.MouseToCell(AMousePos.X, AMousePos.Y, lCol, lRow); + StringGrid.Cells[lCol, lRow] := Format('(c%d,r%d)', [lCol, lRow]); +end; + +procedure TMainForm.btnAddFiveClicked(Sender: TObject); +begin + StringGrid.RowCount := StringGrid.RowCount + 5; +end; + +procedure TMainForm.btnAddOneClicked(Sender: TObject); +begin + StringGrid.RowCount := StringGrid.RowCount + 1; +end; + +procedure TMainForm.btnFiveOnlyClicked(Sender: TObject); +begin + StringGrid.RowCount := 5; +end; + procedure TMainForm.chkDisabledChange(Sender: TObject); begin stringgrid.Enabled := not chkDisabled.Checked; @@ -77,7 +109,7 @@ begin end; procedure TMainForm.stringgridDrawCell(Sender: TObject; const ARow, - ACol: Longword; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; + ACol: Integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean); begin if (ACol = 1) and (ARow = 3) then @@ -93,7 +125,7 @@ end; procedure TMainForm.btnTopRowClicked(Sender: TObject); begin - if edtTopRow.Value < 1 then + if edtTopRow.Value < 0 then Exit; stringgrid.TopRow := edtTopRow.Value; end; @@ -104,7 +136,7 @@ var begin {@VFD_BODY_BEGIN: MainForm} Name := 'MainForm'; - SetPosition(351, 214, 566, 350); + SetPosition(351, 214, 515, 350); WindowTitle := 'Grid control test'; WindowPosition := wpScreenCenter; @@ -112,7 +144,7 @@ begin with btnQuit do begin Name := 'btnQuit'; - SetPosition(476, 320, 80, 25); + SetPosition(425, 320, 80, 25); Anchors := [anRight,anBottom]; Text := 'Quit'; FontDesc := '#Label1'; @@ -124,11 +156,12 @@ begin with stringgrid do begin Name := 'stringgrid'; - SetPosition(10, 10, 426, 250); + SetPosition(10, 10, 375, 250); Anchors := [anLeft,anRight,anTop,anBottom]; + AddColumn('Column 0', 65); AddColumn('Column 1', 100, taLeftJustify); AddColumn('Col 2', 50, taCenter); - AddColumn('New', 150, taRightJustify); + AddColumn('Numbers', 150, taRightJustify); FontDesc := '#Grid'; HeaderFontDesc := '#GridHeader'; RowCount := 17; @@ -143,12 +176,14 @@ begin TextColor:= clBlue; ColumnTextColor[1] := clRed; // add some text - Cells[1, 1] := '(r1,c1)'; + Cells[0, 0] := '[c0, r0]'; + Cells[1, 1] := '[c1, r1]'; Cells[1, 3] := 'Custom'; Cells[2, 3] := 'Hello'; - Cells[3, 1] := '(r1,c3)'; + Cells[3, 1] := '[c3, r1]'; // Add custom painting - OnDrawCell := @stringgridDrawCell; + OnDrawCell := @StringGridDrawCell; + OnDoubleClick := @StringGridDoubleClicked; end; chkShowHeader := TfpgCheckBox.Create(self); @@ -168,7 +203,7 @@ begin with chkShowGrid do begin Name := 'chkShowGrid'; - SetPosition(110, 320, 100, 24); + SetPosition(114, 320, 92, 24); Anchors := [anLeft,anBottom]; Checked := True; FontDesc := '#Label1'; @@ -213,7 +248,7 @@ begin with btnTopRow do begin Name := 'btnTopRow'; - SetPosition(76, 280, 91, 24); + SetPosition(72, 280, 91, 23); Anchors := [anLeft,anBottom]; Text := 'Set TopRow'; FontDesc := '#Label1'; @@ -222,9 +257,48 @@ begin OnClick := @btnTopRowClicked; end; + btnAddFive := TfpgButton.Create(self); + with btnAddFive do + begin + Name := 'btnAddFive'; + SetPosition(188, 280, 80, 23); + Anchors := [anLeft,anBottom]; + Text := 'Add 5 lines'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 8; + OnClick := @btnAddFiveClicked; + end; + + btnAddOne := TfpgButton.Create(self); + with btnAddOne do + begin + Name := 'btnAddOne'; + SetPosition(272, 280, 80, 23); + Anchors := [anLeft,anBottom]; + Text := 'Add 1 line'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 9; + OnClick := @btnAddOneClicked; + end; + + btnFiveOnly := TfpgButton.Create(self); + with btnFiveOnly do + begin + Name := 'btnFiveOnly'; + SetPosition(356, 280, 80, 23); + Anchors := [anLeft,anBottom]; + Text := '5 lines only'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 10; + OnClick := @btnFiveOnlyClicked; + end; + {@VFD_BODY_END: MainForm} - for r := 1 to stringgrid.RowCount do + for r := 0 to stringgrid.RowCount-1 do stringgrid.Cells[3, r] := IntToStr(r); end; diff --git a/examples/gui/listbox/frm_main.pas b/examples/gui/listbox/frm_main.pas new file mode 100644 index 00000000..9757bfc9 --- /dev/null +++ b/examples/gui/listbox/frm_main.pas @@ -0,0 +1,160 @@ +unit frm_main; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, gfxbase, fpgfx, gui_edit, + gfx_widget, gui_form, gui_label, gui_button, + gui_listbox, gui_memo, gui_combobox, gui_basegrid, gui_grid, + gui_dialogs, gui_checkbox, gui_tree, gui_trackbar, + gui_progressbar, gui_radiobutton, gui_tab, gui_menu, + gui_panel, gui_popupcalendar, gui_gauge; + +type + + TMainForm = class(TfpgForm) + private + procedure cbHotTrackChanged(Sender: TObject); + procedure btnAdd1Clicked(Sender: TObject); + procedure btnFocusClicked(Sender: TObject); + procedure btnClearClicked(Sender: TObject); + procedure btnAdd10Clicked(Sender: TObject); + public + {@VFD_HEAD_BEGIN: MainForm} + lstName1: TfpgListBox; + btnAdd10: TfpgButton; + btnClear: TfpgButton; + btnFocus: TfpgButton; + btnAdd1: TfpgButton; + memName1: TfpgMemo; + cbHotTrack: TfpgCheckBox; + {@VFD_HEAD_END: MainForm} + procedure AfterCreate; override; + end; + +{@VFD_NEWFORM_DECL} + +implementation + +{@VFD_NEWFORM_IMPL} + +procedure TMainForm.cbHotTrackChanged(Sender: TObject); +begin + lstName1.HotTrack := cbHotTrack.Checked; +end; + +procedure TMainForm.btnAdd1Clicked(Sender: TObject); +begin + lstName1.Items.Add(Format('Item %2d', [lstName1.ItemCount])); +end; + +procedure TMainForm.btnFocusClicked(Sender: TObject); +begin + if lstName1.ItemCount > 1 then + lstName1.FocusItem := 2; +end; + +procedure TMainForm.btnClearClicked(Sender: TObject); +begin + lstName1.Items.Clear; +end; + +procedure TMainForm.btnAdd10Clicked(Sender: TObject); +var + i: integer; +begin + for i := 1 to 10 do + lstName1.Items.Add(Format('Item %2d', [lstName1.ItemCount])); +end; + +procedure TMainForm.AfterCreate; +begin + {@VFD_BODY_BEGIN: MainForm} + Name := 'MainForm'; + SetPosition(345, 220, 300, 270); + WindowTitle := 'ListBox test'; + WindowPosition := wpScreenCenter; + + lstName1 := TfpgListBox.Create(self); + with lstName1 do + begin + Name := 'lstName1'; + SetPosition(12, 12, 128, 168); + FontDesc := '#List'; + end; + + btnAdd10 := TfpgButton.Create(self); + with btnAdd10 do + begin + Name := 'btnAdd10'; + SetPosition(204, 28, 92, 23); + Text := 'Add 10 items'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 1; + OnClick := @btnAdd10Clicked; + end; + + btnClear := TfpgButton.Create(self); + with btnClear do + begin + Name := 'btnClear'; + SetPosition(204, 56, 92, 23); + Text := 'Clear Items'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 2; + OnClick := @btnClearClicked; + end; + + btnFocus := TfpgButton.Create(self); + with btnFocus do + begin + Name := 'btnFocus'; + SetPosition(204, 84, 92, 23); + Text := 'FocusItem = 2'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 3; + OnClick := @btnFocusClicked; + end; + + btnAdd1 := TfpgButton.Create(self); + with btnAdd1 do + begin + Name := 'btnAdd1'; + SetPosition(204, 112, 92, 23); + Text := 'Add 1 item'; + FontDesc := '#Label1'; + ImageName := ''; + TabOrder := 4; + OnClick := @btnAdd1Clicked; + end; + + memName1 := TfpgMemo.Create(self); + with memName1 do + begin + Name := 'memName1'; + SetPosition(12, 188, 280, 77); + FontDesc := '#Edit1'; + TabOrder := 5; + end; + + cbHotTrack := TfpgCheckBox.Create(self); + with cbHotTrack do + begin + Name := 'cbHotTrack'; + SetPosition(204, 140, 120, 19); + FontDesc := '#Label1'; + TabOrder := 6; + Text := 'Track Focus'; + OnChange := @cbHotTrackChanged; + end; + + {@VFD_BODY_END: MainForm} +end; + + +end. diff --git a/examples/gui/listbox/listboxtest.lpi b/examples/gui/listbox/listboxtest.lpi new file mode 100644 index 00000000..f80a70b0 --- /dev/null +++ b/examples/gui/listbox/listboxtest.lpi @@ -0,0 +1,58 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="/"/> + <Version Value="6"/> + <General> + <Flags> + <SaveOnlyProjectUnits Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <IconPath Value="./"/> + <TargetFileExt Value=""/> + </General> + <VersionInfo> + <ProjectVersion Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_package"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="listboxtest.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="listboxtest"/> + </Unit0> + <Unit1> + <Filename Value="frm_main.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="frm_main"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Other> + <CustomOptions Value="-FUunits"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/examples/gui/listbox/listboxtest.lpr b/examples/gui/listbox/listboxtest.lpr new file mode 100644 index 00000000..dd14a408 --- /dev/null +++ b/examples/gui/listbox/listboxtest.lpr @@ -0,0 +1,29 @@ +program listboxtest; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, fpgfx, frm_main, fpgui_package; + +procedure MainProc; +var + frm: TMainForm; +begin + fpgApplication.Initialize; + frm := TMainForm.Create(nil); + try + frm.Show; + fpgApplication.Run; + finally + frm.Free; + end; +end; + +begin + MainProc; +end. + + diff --git a/examples/gui/memo/memotest.lpr b/examples/gui/memo/memotest.lpr index c3e106a8..e4eed10b 100644 --- a/examples/gui/memo/memotest.lpr +++ b/examples/gui/memo/memotest.lpr @@ -57,9 +57,9 @@ begin memo.Lines.Add('Memo Test0'); memo.Lines.Add('Memo Test1'); - //memo.Lines.Add('Memo Test2'); - //memo.Lines.Add('Memo Test3'); - //memo.Lines.Add('Memo Test4'); + memo.Lines.Add('Memo Test2'); + memo.Lines.Add('Memo Test3'); + memo.Lines.Add('Memo Test4'); memo.Lines.Insert(1,'0 Before 1 after'); //memo.Lines.Delete(1); //memo.Lines.Text := 'Dude'+LineEnding+'What''s mine say?'+LineEnding;; diff --git a/examples/gui/menutest/menutest.lpr b/examples/gui/menutest/menutest.lpr index c95c49de..801bdb97 100644 --- a/examples/gui/menutest/menutest.lpr +++ b/examples/gui/menutest/menutest.lpr @@ -77,8 +77,7 @@ begin FHelpSubMenu.AddMenuItem('Test Russian text -> Òåñò', '', @miMenuItemSelected); // Create main menu bar - FMenuBar := TfpgMenuBar.Create(self); - FMenuBar.SetPosition(0, 0, Width, FMenuBar.Height); + FMenuBar := CreateMenuBar(self); FMenuBar.AddMenuItem('&File', nil).SubMenu := FFileSubMenu; FMenuBar.AddMenuItem('&Edit', nil).SubMenu := FEditSubMenu; FMenuBar.AddMenuItem('&Windows', nil); diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas index 977ec960..0873d682 100644 --- a/src/corelib/gdi/gfx_gdi.pas +++ b/src/corelib/gdi/gfx_gdi.pas @@ -44,7 +44,6 @@ var FontSmoothingType: Cardinal; type - TfpgGContext = HDC; // forward declaration TfpgWindowImpl = class; @@ -93,9 +92,9 @@ type FDrawing: boolean; FBufferBitmap: HBitmap; FDrawWindow: TfpgWindowImpl; - Fgc: TfpgGContext; - fBufgc: TfpgGContext; - FWinGC: TfpgGContext; + Fgc: TfpgDCHandle; + fBufgc: TfpgDCHandle; + FWinGC: TfpgDCHandle; FBackgroundColor: TfpgColor; FCurFontRes: TfpgFontResourceImpl; FClipRect: TfpgRect; @@ -132,6 +131,7 @@ type procedure SetPixel(X, Y: integer; const AValue: TfpgColor); override; procedure DoDrawArc(x, y, w, h: TfpgCoord; a1, a2: Extended); override; procedure DoFillArc(x, y, w, h: TfpgCoord; a1, a2: Extended); override; + property DCHandle: TfpgDCHandle read Fgc; public constructor Create; override; destructor Destroy; override; diff --git a/src/corelib/gdi/gfx_impl.pas b/src/corelib/gdi/gfx_impl.pas index 2f8eddf2..3aabb3d6 100644 --- a/src/corelib/gdi/gfx_impl.pas +++ b/src/corelib/gdi/gfx_impl.pas @@ -9,6 +9,7 @@ uses type TfpgWinHandle = HWND; + TfpgDCHandle = HDC; implementation diff --git a/src/corelib/gfx_utf8utils.pas b/src/corelib/gfx_utf8utils.pas index 6ce45891..137e39de 100644 --- a/src/corelib/gfx_utf8utils.pas +++ b/src/corelib/gfx_utf8utils.pas @@ -127,7 +127,10 @@ end; function UTF8Length(const s: string): integer; begin - Result := UTF8Length(PChar(s),length(s)); + if s = '' then + Result := length(s) + else + Result := UTF8Length(PChar(s),length(s)); end; function UTF8Length(p: PChar; ByteCount: integer): integer; diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas index 4497e4dc..3acadb64 100644 --- a/src/corelib/gfxbase.pas +++ b/src/corelib/gfxbase.pas @@ -524,15 +524,15 @@ type destructor Destroy; override; function Count: integer; function CurrentSpecialDir: integer; - property HasFileMode: boolean read FHasFileMode; function ReadDirectory(const aDirectory: TfpgString = ''): boolean; procedure Clear; procedure Sort(AOrder: TFileListSortOrder); - property Entry[i: integer]: TFileEntry read GetEntry; - property SpecialDirs: TStringList read FSpecialDirs; property DirectoryName: TfpgString read FDirectoryName; + property Entry[i: integer]: TFileEntry read GetEntry; property FileMask: TfpgString read FFileMask write FFileMask; + property HasFileMode: boolean read FHasFileMode; property ShowHidden: boolean read FShowHidden write FShowHidden; + property SpecialDirs: TStringList read FSpecialDirs; end; @@ -2050,10 +2050,10 @@ end; function TfpgFileListBase.GetEntry(i: integer): TFileEntry; begin - if (i < 1) or (i > FEntries.Count) then + if (i < 0) or (i > FEntries.Count-1) then Result := nil else - Result := TFileEntry(FEntries[i-1]); + Result := TFileEntry(FEntries[i]); end; function TfpgFileListBase.InitializeEntry(sr: TSearchRec): TFileEntry; diff --git a/src/corelib/x11/gfx_impl.pas b/src/corelib/x11/gfx_impl.pas index 0bd6b311..897e0cbf 100644 --- a/src/corelib/x11/gfx_impl.pas +++ b/src/corelib/x11/gfx_impl.pas @@ -9,6 +9,8 @@ uses type TfpgWinHandle = TXID; + TfpgDCHandle = TXID; + implementation diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas index d507ecb5..034030bb 100644 --- a/src/corelib/x11/gfx_x11.pas +++ b/src/corelib/x11/gfx_x11.pas @@ -136,8 +136,8 @@ type private FDrawing: boolean; FDrawWindow: TfpgWindowImpl; - FBufferPixmap: TPixmap; - FDrawHandle: TXID; + FBufferPixmap: TfpgDCHandle; + FDrawHandle: TfpgDCHandle; Fgc: TfpgGContext; FCurFontRes: TfpgFontResourceImpl; FClipRect: TfpgRect; @@ -174,6 +174,7 @@ type procedure SetPixel(X, Y: integer; const AValue: TfpgColor); override; procedure DoDrawArc(x, y, w, h: TfpgCoord; a1, a2: Extended); override; procedure DoFillArc(x, y, w, h: TfpgCoord; a1, a2: Extended); override; + property DCHandle: TfpgDCHandle read FDrawHandle; public constructor Create; override; destructor Destroy; override; @@ -261,8 +262,6 @@ type end; - { TfpgFileListImpl } - TfpgFileListImpl = class(TfpgFileListBase) function EncodeModeString(FileMode: longword): TFileModeString; function GetUserName(uid: integer): string; @@ -281,7 +280,7 @@ uses {$if defined(linux) and defined(cpu386)}libc,{$endif} fpgfx, gfx_widget, - gui_form, // remove this!!!!! + gui_form, cursorfont, gfx_popupwindow, xatom, // used for XA_WM_NAME diff --git a/src/gui/db/fpgui_db.pas b/src/gui/db/fpgui_db.pas index 810abe70..ec91e8e3 100644 --- a/src/gui/db/fpgui_db.pas +++ b/src/gui/db/fpgui_db.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_basegrid.pas b/src/gui/gui_basegrid.pas index e2049481..a16fd08a 100644 --- a/src/gui/gui_basegrid.pas +++ b/src/gui/gui_basegrid.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -12,7 +12,8 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Description: - Defines a Base Grid control. + Defines a Base Grid control. Usable as the base for any grid type of + component. } unit gui_basegrid; @@ -35,10 +36,10 @@ type TfpgGridDrawState = set of (gdSelected, gdFocused, gdFixed); - TfpgFocusChangeNotify = procedure(Sender: TObject; ARow, ACol: Longword) of object; - TfpgRowChangeNotify = procedure(Sender: TObject; ARow: Longword) of object; - TfpgCanSelectCellEvent = procedure(Sender: TObject; const ARow, ACol: Longword; var ACanSelect: boolean) of object; - TfpgDrawCellEvent = procedure(Sender: TObject; const ARow, ACol: Longword; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean) of object; + TfpgFocusChangeNotify = procedure(Sender: TObject; ARow, ACol: Integer) of object; + TfpgRowChangeNotify = procedure(Sender: TObject; ARow: Integer) of object; + TfpgCanSelectCellEvent = procedure(Sender: TObject; const ARow, ACol: Integer; var ACanSelect: boolean) of object; + TfpgDrawCellEvent = procedure(Sender: TObject; const ARow, ACol: Integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean) of object; // Column 2 is special just for testing purposes. Descendant classes will // override that special behavior anyway. @@ -53,16 +54,16 @@ type FResizedCol: integer; // used for column resizing FDefaultColWidth: integer; FDefaultRowHeight: integer; - FFocusCol: Longword; - FFocusRow: Longword; + FFocusCol: Integer; + FFocusRow: Integer; FHeaderHeight: integer; FOnCanSelectCell: TfpgCanSelectCellEvent; FOnFocusChange: TfpgFocusChangeNotify; FOnRowChange: TfpgRowChangeNotify; - FPrevCol: Longword; - FPrevRow: Longword; - FFirstRow: Longword; - FFirstCol: Longword; + FPrevCol: Integer; + FPrevRow: Integer; + FFirstRow: Integer; + FFirstCol: Integer; FMargin: integer; FFont: TfpgFont; FHeaderFont: TfpgFont; @@ -84,32 +85,32 @@ type procedure VScrollBarMove(Sender: TObject; position: integer); procedure SetDefaultColWidth(const AValue: integer); procedure SetDefaultRowHeight(const AValue: integer); - procedure SetFocusCol(const AValue: Longword); - procedure SetFocusRow(const AValue: Longword); + procedure SetFocusCol(const AValue: Integer); + procedure SetFocusRow(const AValue: Integer); procedure CheckFocusChange; procedure SetShowGrid(const AValue: boolean); procedure SetShowHeader(const AValue: boolean); - function VisibleLines: Longword; + function VisibleLines: Integer; function VisibleWidth: integer; function VisibleHeight: integer; - procedure SetFirstRow(const AValue: Longword); + procedure SetFirstRow(const AValue: Integer); protected procedure UpdateScrollBars; virtual; - function GetHeaderText(ACol: Longword): string; virtual; - function GetColumnWidth(ACol: Longword): integer; virtual; - procedure SetColumnWidth(ACol: Longword; const AValue: integer); virtual; - function GetColumnBackgroundColor(ACol: Longword): TfpgColor; virtual; - procedure SetColumnBackgroundColor(ACol: Longword; const AValue: TfpgColor); virtual; - function GetColumnTextColor(ACol: Longword): TfpgColor; virtual; - procedure SetColumnTextColor(ACol: Longword; const AValue: TfpgColor); virtual; - function GetColumnCount: Longword; virtual; - function GetRowCount: Longword; virtual; - function CanSelectCell(const ARow, ACol: Longword): boolean; - function DoDrawCellEvent(ARow, ACol: Longword; ARect: TfpgRect; AFlags: TfpgGridDrawState): boolean; virtual; - procedure DoCanSelectCell(const ARow, ACol: integer; var ACanSelect: boolean); - procedure DrawCell(ARow, ACol: Longword; ARect: TfpgRect; AFlags: TfpgGridDrawState); virtual; - procedure DrawHeader(ACol: Longword; ARect: TfpgRect; AFlags: integer); virtual; - procedure DrawGrid(ARow, ACol: Longword; ARect: TfpgRect; AFlags: integer); virtual; + function GetHeaderText(ACol: Integer): string; virtual; + function GetColumnWidth(ACol: Integer): integer; virtual; + procedure SetColumnWidth(ACol: Integer; const AValue: integer); virtual; + function GetColumnBackgroundColor(ACol: Integer): TfpgColor; virtual; + procedure SetColumnBackgroundColor(ACol: Integer; const AValue: TfpgColor); virtual; + function GetColumnTextColor(ACol: Integer): TfpgColor; virtual; + procedure SetColumnTextColor(ACol: Integer; const AValue: TfpgColor); virtual; + function GetColumnCount: Integer; virtual; + function GetRowCount: Integer; virtual; + function CanSelectCell(const ARow, ACol: Integer): boolean; + function DoDrawCellEvent(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState): boolean; virtual; + procedure DoCanSelectCell(const ARow, ACol: Integer; var ACanSelect: boolean); + procedure DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); virtual; + procedure DrawHeader(ACol: Integer; ARect: TfpgRect; AFlags: integer); virtual; + procedure DrawGrid(ARow, ACol: Integer; ARect: TfpgRect; AFlags: integer); virtual; procedure HandlePaint; override; procedure HandleShow; override; procedure HandleResize(awidth, aheight: TfpgCoord); override; @@ -125,20 +126,20 @@ type property FontDesc: string read GetFontDesc write SetFontDesc; property HeaderFont: TfpgFont read FHeaderFont; property HeaderFontDesc: string read GetHeaderFontDesc write SetHeaderFontDesc; - property FocusCol: Longword read FFocusCol write SetFocusCol; - property FocusRow: Longword read FFocusRow write SetFocusRow; + property FocusCol: Integer read FFocusCol write SetFocusCol; + property FocusRow: Integer read FFocusRow write SetFocusRow; property RowSelect: boolean read FRowSelect write SetRowSelect; - property ColumnCount: Longword read GetColumnCount; - property RowCount: Longword read GetRowCount; + property ColumnCount: Integer read GetColumnCount; + property RowCount: Integer read GetRowCount; property ShowHeader: boolean read FShowHeader write SetShowHeader default True; property ShowGrid: boolean read FShowGrid write SetShowGrid default True; property ScrollBarStyle: TfpgScrollStyle read FScrollBarStyle write SetScrollBarStyle default ssAutoBoth; property HeaderHeight: integer read FHeaderHeight; // property ColResizing: boolean read FColResizing write FColResizing; - property ColumnWidth[ACol: Longword]: integer read GetColumnWidth write SetColumnWidth; - property ColumnBackgroundColor[ACol: Longword]: TfpgColor read GetColumnBackgroundColor write SetColumnBackgroundColor; - property ColumnTextColor[ACol: Longword]: TfpgColor read GetColumnTextColor write SetColumnTextColor; - property TopRow: Longword read FFirstRow write SetFirstRow; + property ColumnWidth[ACol: Integer]: integer read GetColumnWidth write SetColumnWidth; + property ColumnBackgroundColor[ACol: Integer]: TfpgColor read GetColumnBackgroundColor write SetColumnBackgroundColor; + property ColumnTextColor[ACol: Integer]: TfpgColor read GetColumnTextColor write SetColumnTextColor; + property TopRow: Integer read FFirstRow write SetFirstRow; property OnDrawCell: TfpgDrawCellEvent read FOnDrawCell write FOnDrawCell; property OnFocusChange: TfpgFocusChangeNotify read FOnFocusChange write FOnFocusChange; property OnRowChange: TfpgRowChangeNotify read FOnRowChange write FOnRowChange; @@ -150,7 +151,7 @@ type procedure Update; procedure BeginUpdate; procedure EndUpdate; - procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longword); + procedure MouseToCell(X, Y: Integer; var ACol, ARow: Integer); end; implementation @@ -159,10 +160,10 @@ implementation procedure TfpgBaseGrid.HScrollBarMove(Sender: TObject; position: integer); begin - if FFirstCol <> Longword(position) then + if FFirstCol <> position then begin - if Position < 1 then - Position := 1; + if Position < 0 then + Position := 0; FFirstCol := position; RePaint; end; @@ -213,7 +214,7 @@ end; procedure TfpgBaseGrid.VScrollBarMove(Sender: TObject; position: integer); begin - if FFirstRow <> LongWord(position) then + if FFirstRow <> position then begin FFirstRow := position; RePaint; @@ -236,12 +237,12 @@ begin RePaint; end; -function TfpgBaseGrid.GetColumnWidth(ACol: Longword): integer; +function TfpgBaseGrid.GetColumnWidth(ACol: Integer): integer; begin Result := 50; end; -procedure TfpgBaseGrid.SetColumnWidth(ACol: Longword; const AValue: integer); +procedure TfpgBaseGrid.SetColumnWidth(ACol: Integer; const AValue: integer); begin // GetColumnWidth and SetColumnWidth will be overriden in decendant! // Column 2 is special just for testing purposes @@ -253,44 +254,44 @@ begin end; end; -function TfpgBaseGrid.GetColumnBackgroundColor(ACol: Longword): TfpgColor; +function TfpgBaseGrid.GetColumnBackgroundColor(ACol: Integer): TfpgColor; begin // implemented in descendant end; -procedure TfpgBaseGrid.SetColumnBackgroundColor(ACol: Longword; const AValue: TfpgColor); +procedure TfpgBaseGrid.SetColumnBackgroundColor(ACol: Integer; const AValue: TfpgColor); begin // implemented in descendant end; -function TfpgBaseGrid.GetColumnTextColor(ACol: Longword): TfpgColor; +function TfpgBaseGrid.GetColumnTextColor(ACol: Integer): TfpgColor; begin // implemented in descendant end; -procedure TfpgBaseGrid.SetColumnTextColor(ACol: Longword; const AValue: TfpgColor); +procedure TfpgBaseGrid.SetColumnTextColor(ACol: Integer; const AValue: TfpgColor); begin // implemented in descendant end; -function TfpgBaseGrid.GetColumnCount: Longword; +function TfpgBaseGrid.GetColumnCount: Integer; begin Result := 7; end; -function TfpgBaseGrid.GetRowCount: Longword; +function TfpgBaseGrid.GetRowCount: Integer; begin Result := 24; end; -function TfpgBaseGrid.CanSelectCell(const ARow, ACol: Longword): boolean; +function TfpgBaseGrid.CanSelectCell(const ARow, ACol: Integer): boolean; begin - Result := (ARow > 0) and (ACol > 0) and (ARow <= RowCount) and (ACol <= ColumnCount); + Result := (ARow >= 0) and (ACol >= 0) and (ARow < RowCount) and (ACol < ColumnCount); if Result then DoCanSelectCell(ARow, ACol, Result); end; -function TfpgBaseGrid.DoDrawCellEvent(ARow, ACol: Longword; ARect: TfpgRect; +function TfpgBaseGrid.DoDrawCellEvent(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState): boolean; begin Result := True; @@ -298,14 +299,14 @@ begin FOnDrawCell(self, ARow, ACol, ARect, AFlags, Result); end; -procedure TfpgBaseGrid.DoCanSelectCell(const ARow, ACol: integer; var +procedure TfpgBaseGrid.DoCanSelectCell(const ARow, ACol: Integer; var ACanSelect: boolean); begin if Assigned(OnCanSelectCell) then FOnCanSelectCell(self, ARow, ACol, ACanSelect); end; -procedure TfpgBaseGrid.DrawCell(ARow, ACol: Longword; ARect: TfpgRect; AFlags: TfpgGridDrawState); +procedure TfpgBaseGrid.DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); var s: string; begin @@ -314,10 +315,10 @@ begin s := 'Here lives Graeme!'; if not Enabled then Canvas.SetTextColor(clShadow1); - Canvas.DrawString(ARect.Left+1, ARect.Top+1, s); + Canvas.DrawText(ARect, s, [txtHCenter, txtVCenter]); end; -procedure TfpgBaseGrid.DrawHeader(ACol: Longword; ARect: TfpgRect; AFlags: integer); +procedure TfpgBaseGrid.DrawHeader(ACol: Integer; ARect: TfpgRect; AFlags: integer); var s: string; r: TfpgRect; @@ -349,7 +350,7 @@ begin fpgStyle.DrawString(Canvas, x, ARect.Top+1, s, Enabled); end; -procedure TfpgBaseGrid.DrawGrid(ARow, ACol: Longword; ARect: TfpgRect; +procedure TfpgBaseGrid.DrawGrid(ARow, ACol: Integer; ARect: TfpgRect; AFlags: integer); begin // default is inside bottom/right edge or cell @@ -358,33 +359,33 @@ begin Canvas.DrawLine(ARect.Right, ARect.Bottom, ARect.Right, ARect.Top-1); // cell right end; -procedure TfpgBaseGrid.SetFocusCol(const AValue: Longword); +procedure TfpgBaseGrid.SetFocusCol(const AValue: Integer); begin if FFocusCol = AValue then Exit; //==> FFocusCol := AValue; // apply min/max limit - if FFocusCol < 1 then - FFocusCol := 1; - if FFocusCol > ColumnCount then - FFocusCol := ColumnCount; + if FFocusCol < 0 then + FFocusCol := 0; + if FFocusCol > ColumnCount-1 then + FFocusCol := ColumnCount-1; FollowFocus; CheckFocusChange; end; -procedure TfpgBaseGrid.SetFocusRow(const AValue: Longword); +procedure TfpgBaseGrid.SetFocusRow(const AValue: Integer); begin if FFocusRow = AValue then Exit; //==> FFocusRow := AValue; // apply min/max limit - if FFocusRow < 1 then - FFocusRow := 1; - if FFocusRow > RowCount then - FFocusRow := RowCount; + if FFocusRow < 0 then + FFocusRow := 0; + if FFocusRow > RowCount-1 then + FFocusRow := RowCount-1; FollowFocus; CheckFocusChange; @@ -422,7 +423,7 @@ begin end; // Return the fully visible lines only. Partial lines not counted -function TfpgBaseGrid.VisibleLines: Longword; +function TfpgBaseGrid.VisibleLines: Integer; var hh: integer; begin @@ -432,7 +433,7 @@ begin hh := 0; if ShowHeader then hh := hh + FHeaderHeight+1; - Result := (Height - (2*FMargin) - hh) div (FDefaultRowHeight); + Result := (Height - (2*FMargin) - hh) div FDefaultRowHeight; end; function TfpgBaseGrid.VisibleWidth: integer; @@ -457,14 +458,14 @@ begin Result := Height - (FMargin*2) - sw; end; -procedure TfpgBaseGrid.SetFirstRow(const AValue: Longword); +procedure TfpgBaseGrid.SetFirstRow(const AValue: Integer); begin if FFirstRow = AValue then - Exit; - if AValue < ((RowCount - VisibleLines) + 1) then + Exit; //==> + if AValue < ((RowCount - VisibleLines)) then FFirstRow := AValue else - FFirstRow := (RowCount - VisibleLines) + 1; + FFirstRow := (RowCount - VisibleLines); UpdateScrollBars; RePaint; end; @@ -482,7 +483,7 @@ begin vw := VisibleWidth; cw := 0; - for i := 1 to ColumnCount do + for i := 0 to ColumnCount-1 do cw := cw + ColumnWidth[i]; // This needs improving while resizing @@ -491,7 +492,7 @@ begin else begin FHScrollBar.Visible := False; - FFirstCol := 1; + FFirstCol := 0; end; // This needs improving while resizing @@ -500,18 +501,18 @@ begin else begin FVScrollBar.Visible := False; - FFirstRow := 1; + FFirstRow := 0; end; if FVScrollBar.Visible then begin Dec(HWidth, FVScrollBar.Width); - FVScrollBar.Min := 1; + FVScrollBar.Min := 0; if RowCount > 0 then FVScrollBar.SliderSize := VisibleLines / RowCount else FVScrollBar.SliderSize := 0; - FVScrollBar.Max := RowCount-VisibleLines+1; + FVScrollBar.Max := RowCount-VisibleLines; FVScrollBar.Position := FFirstRow; FVScrollBar.RepaintSlider; end; @@ -519,9 +520,9 @@ begin if FHScrollBar.Visible then begin Dec(VHeight, FHScrollBar.Height); - FHScrollBar.Min := 1; + FHScrollBar.Min := 0; FHScrollBar.SliderSize := 0.2; - FHScrollBar.Max := ColumnCount; + FHScrollBar.Max := ColumnCount-1; FHScrollBar.Position := FFirstCol; FHScrollBar.RepaintSlider; end; @@ -538,7 +539,7 @@ begin FHScrollBar.UpdateWindowPosition; end; -function TfpgBaseGrid.GetHeaderText(ACol: Longword): string; +function TfpgBaseGrid.GetHeaderText(ACol: Integer): string; begin Result := 'Head ' + IntToStr(ACol); end; @@ -547,8 +548,8 @@ procedure TfpgBaseGrid.HandlePaint; var r: TfpgRect; r2: TfpgRect; - col: Longword; - row: Longword; + col: Integer; + row: Integer; clipr: TfpgRect; // clip rectangle drawstate: TfpgGridDrawState; begin @@ -573,7 +574,7 @@ begin // Drawing horizontal headers r.Height := FHeaderHeight; Canvas.SetFont(FHeaderFont); - for col := FFirstCol to ColumnCount do + for col := FFirstCol to ColumnCount-1 do begin r.Width := ColumnWidth[col]; Canvas.SetClipRect(clipr); @@ -592,14 +593,13 @@ begin r.Height := DefaultRowHeight; Canvas.SetFont(FFont); - for row := FFirstRow to RowCount do + for row := FFirstRow to RowCount-1 do begin r.Left := FMargin; - for col := FFirstCol to ColumnCount do + for col := FFirstCol to ColumnCount-1 do begin r.Width := ColumnWidth[col]; Canvas.SetClipRect(clipr); -// Canvas.SetClipRect(r); if (row = FFocusRow) and (RowSelect or (col = FFocusCol)) then begin @@ -684,8 +684,6 @@ end; procedure TfpgBaseGrid.HandleShow; begin inherited HandleShow; -// if (csDesigning in ComponentState) then -// Exit; if (csLoading in ComponentState) then Exit; UpdateScrollBars; @@ -703,7 +701,7 @@ procedure TfpgBaseGrid.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); var w: integer; - r: Longword; + r: integer; begin consumed := True; case keycode of @@ -765,10 +763,10 @@ begin keyPageUp: begin r := FFocusRow-VisibleLines; - if r < 1 then - r := 1; + if r < 0 then + r := 0; - if (FFocusRow <> 1) and CanSelectCell(r, FFocusCol) then + if (FFocusRow <> 0) and CanSelectCell(r, FFocusCol) then begin FFocusRow := r; FollowFocus; @@ -779,10 +777,10 @@ begin keyPageDown: begin r := FFocusRow+VisibleLines; - if r > RowCount then - r := RowCount; + if r > (RowCount-1) then + r := RowCount-1; - if (FFocusRow <> RowCount) and CanSelectCell(r, FFocusCol) then + if (FFocusRow <> (RowCount-1)) and CanSelectCell(r, FFocusCol) then begin FFocusRow := r; FollowFocus; @@ -794,16 +792,16 @@ begin begin if FRowSelect then begin - if (FFocusRow <> 1) and CanSelectCell(1, FFocusCol) then + if (FFocusRow <> 0) and CanSelectCell(0, FFocusCol) then begin - FFocusRow := 1; + FFocusRow := 0; FollowFocus; RePaint; end; end - else if (FFocusCol <> 1) and CanSelectCell(FFocusRow, 1) then + else if (FFocusCol <> 0) and CanSelectCell(FFocusRow, 0) then begin - FFocusCol := 1; + FFocusCol := 0; FollowFocus; RePaint; end; @@ -813,16 +811,16 @@ begin begin if FRowSelect then begin - if (FFocusRow <> RowCount) and CanSelectCell(RowCount, FFocusCol) then + if (FFocusRow <> (RowCount-1)) and CanSelectCell(RowCount-1, FFocusCol) then begin - FFocusRow := RowCount; + FFocusRow := RowCount-1; FollowFocus; RePaint; end; end - else if (FFocusCol <> ColumnCount) and CanSelectCell(FFocusRow, ColumnCount) then + else if (FFocusCol <> (ColumnCount-1)) and CanSelectCell(FFocusRow, ColumnCount-1) then begin - FFocusCol := ColumnCount; + FFocusCol := ColumnCount-1; FollowFocus; RePaint; end; @@ -840,8 +838,8 @@ end; procedure TfpgBaseGrid.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); var - lRow: Longword; - lCol: Longword; + lRow: Integer; + lCol: Integer; begin inherited HandleMouseScroll(x, y, shiftstate, delta); @@ -851,27 +849,28 @@ begin if delta > 0 then // scroll down inc(FFirstRow, abs(delta)) else // scroll up - dec(FFirstRow, abs(delta)); + if FFirstRow > 0 then + dec(FFirstRow, abs(delta)); // apply limits - if FFirstRow > RowCount - VisibleLines + 1 then - FFirstRow := RowCount - VisibleLines + 1; - if FFirstRow < 1 then - FFirstRow := 1; + if FFirstRow > RowCount - VisibleLines then + FFirstRow := RowCount - VisibleLines; + if FFirstRow < 0 then + FFirstRow := 0; // scroll left/right // If vertical scrollbar is not visible, but // horizontal is. Mouse wheel will scroll horizontally. :) - if FHScrollBar.Visible and (not FVScrollBar.Visible) then + if FHScrollBar.Visible and (not FVScrollBar.Visible) then begin if delta > 0 then // scroll right begin - if FFirstCol < ColumnCount then + if FFirstCol < (ColumnCount-1) then inc(FFirstCol); end else begin - if FFirstCol > 1 then + if FFirstCol > 0 then dec(FFirstCol); end; end; @@ -892,7 +891,7 @@ var begin inherited HandleMouseMove(x, y, btnstate, shiftstate); - if (ColumnCount < 0) or (RowCount < 1) then + if (ColumnCount = 0) or (RowCount = 0) then Exit; //==> if FColResizing then @@ -916,7 +915,7 @@ begin if (y <= FMargin + hh) then // we are over the Header row begin cw := 0; - for n := FFirstCol to ColumnCount do + for n := FFirstCol to ColumnCount-1 do begin inc(cw, ColumnWidth[n]); // Resizing is enabled 4 pixel either way of the cell border @@ -955,15 +954,15 @@ end; procedure TfpgBaseGrid.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); var hh: integer; - n: Longword; + n: Integer; cw: integer; nw: integer; - prow: Longword; - pcol: Longword; + prow: Integer; + pcol: Integer; begin inherited HandleLMouseDown(x, y, shiftstate); - if (ColumnCount < 0) or (RowCount < 1) then + if (ColumnCount = 0) or (RowCount = 0) then Exit; //==> pcol := FFocusCol; @@ -979,7 +978,7 @@ begin begin {$IFDEF DEBUG} Writeln('header click...'); {$ENDIF} cw := 0; - for n := FFirstCol to ColumnCount do + for n := FFirstCol to ColumnCount-1 do begin inc(cw, ColumnWidth[n]); if (x >= (FMargin+cw - 4)) and (x <= (FMargin+cw + 4)) then @@ -1031,23 +1030,23 @@ end; procedure TfpgBaseGrid.FollowFocus; var - n: Longword; + n: Integer; w: TfpgCoord; begin - if (RowCount > 0) and (FFocusRow < 1) then - FFocusRow := 1; - if FFocusRow > RowCount then - FFocusRow := RowCount; + if (RowCount > 0) and (FFocusRow < 0) then + FFocusRow := 0; + if FFocusRow > RowCount-1 then + FFocusRow := RowCount-1; - if (ColumnCount > 0) and (FFocusCol < 1) then - FFocusCol := 1; - if FFocusCol > ColumnCount then - FFocusCol := ColumnCount; + if (ColumnCount > 0) and (FFocusCol < 0) then + FFocusCol := 0; + if FFocusCol > ColumnCount-1 then + FFocusCol := ColumnCount-1; - if FFirstRow < 1 then - FFirstRow := 1; - if FFirstCol < 1 then - FFirstCol := 1; + if FFirstRow < 0 then + FFirstRow := 0; + if FFirstCol < 0 then + FFirstCol := 0; if FFocusRow < FFirstRow then FFirstRow := FFocusRow @@ -1086,12 +1085,12 @@ begin Focusable := True; Width := 120; Height := 80; - FFocusCol := 1; - FPrevCol := 0; - FFocusRow := 1; - FPrevRow := 0; - FFirstRow := 1; - FFirstCol := 1; + FFocusCol := 0; + FPrevCol := -1; + FFocusRow := 0; + FPrevRow := -1; + FFirstRow := 0; + FFirstCol := 0; FMargin := 2; FShowHeader := True; FShowGrid := True; @@ -1161,23 +1160,23 @@ begin end; end; -procedure TfpgBaseGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longword); +procedure TfpgBaseGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Integer); var hh: integer; cw: integer; - n: Longword; + n: Integer; begin if ShowHeader then hh := FHeaderHeight+1 else hh := 0; - ARow := FFirstRow + Longword((y - FMargin - hh) div FDefaultRowHeight); - if ARow > RowCount then - ARow := RowCount; + ARow := FFirstRow + ((y - FMargin - hh) div FDefaultRowHeight); + if ARow > RowCount-1 then + ARow := RowCount-1; cw := 0; - for n := FFirstCol to ColumnCount do + for n := FFirstCol to ColumnCount-1 do begin inc(cw, ColumnWidth[n]); if FMargin+cw >= x then diff --git a/src/gui/gui_bevel.pas b/src/gui/gui_bevel.pas index d5458f1f..f62e18af 100644 --- a/src/gui/gui_bevel.pas +++ b/src/gui/gui_bevel.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_button.pas b/src/gui/gui_button.pas index 46ad9aea..66cd514c 100644 --- a/src/gui/gui_button.pas +++ b/src/gui/gui_button.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_checkbox.pas b/src/gui/gui_checkbox.pas index 5458a955..463ea405 100644 --- a/src/gui/gui_checkbox.pas +++ b/src/gui/gui_checkbox.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_combobox.pas b/src/gui/gui_combobox.pas index f103c13a..0f251357 100644 --- a/src/gui/gui_combobox.pas +++ b/src/gui/gui_combobox.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -60,7 +60,6 @@ type TfpgComboOption = (wo_FocusItemTriggersOnChange); TfpgComboOptions = set of TfpgComboOption; - { TfpgBaseComboBox } TfpgBaseComboBox = class(TfpgWidget) private @@ -79,8 +78,10 @@ type FFocusItem: integer; FItems: TStringList; procedure InternalOnClose(Sender: TObject); + procedure InternalItemsChanged(Sender: TObject); virtual; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure DoOnChange; virtual; + procedure DoOnDropDown; virtual; procedure DoDropDown; virtual; abstract; procedure DoOnCloseUp; virtual; function GetDropDownPos(AParent, AComboBox, ADropDown: TfpgWidget): TfpgRect; virtual; @@ -99,8 +100,6 @@ type end; - { TfpgAbstractComboBox } - TfpgAbstractComboBox = class(TfpgBaseComboBox) private procedure InternalBtnClick(Sender: TObject); @@ -193,9 +192,9 @@ begin Result := FFont.FontDesc; end; -{ Focusitem is 1 based and NOT 0 based like the Delphi ItemIndex property. - So at startup, FocusItem = 0 which means nothing is selected. If FocusItem = 1 - it means the first item is selected etc. } +{ Focusitem is 0 based like the Delphi ItemIndex property. + So at startup, FocusItem = -1 which means nothing is selected. If + FocusItem = 0 it means the first item is selected etc. } procedure TfpgBaseComboBox.SetFocusItem(const AValue: integer); begin if FFocusItem = AValue then @@ -203,10 +202,10 @@ begin FFocusItem := AValue; // do some limit check corrections - if FFocusItem < 0 then - FFocusItem := 0 // nothing is selected - else if FFocusItem > FItems.Count then - FFocusItem := FItems.Count; + if FFocusItem < -1 then + FFocusItem := -1 // nothing is selected + else if FFocusItem > FItems.Count-1 then + FFocusItem := FItems.Count-1; RePaint; if wo_FocusItemTriggersOnChange in FOptions then @@ -218,7 +217,7 @@ begin FFont.Free; FFont := fpgGetFont(AValue); if Height < FFont.Height + 6 then - Height:= FFont.Height + 6; + Height := FFont.Height + 6; RePaint; end; @@ -227,6 +226,12 @@ begin DoOnCloseUp; end; +procedure TfpgBaseComboBox.InternalItemsChanged(Sender: TObject); +begin + if FItems.Count = 0 then + FocusItem := -1; +end; + procedure TfpgBaseComboBox.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); var @@ -267,6 +272,12 @@ begin FOnChange(self); end; +procedure TfpgBaseComboBox.DoOnDropDown; +begin + if Assigned(OnDropDown) then + FOnDropDown(self); +end; + procedure TfpgBaseComboBox.DoOnCloseUp; begin if Assigned(OnCloseUp) then @@ -298,18 +309,15 @@ begin Result.Left := AComboBox.Left; Result.Width := ADropDown.Width; - -// writeln('H:', fpgApplication.ScreenHeight, ' W:', fpgApplication.ScreenWidth); -// writeln('Point x:', pt.x, ' y:', pt.y); -// PrintRect(Result); end; constructor TfpgBaseComboBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FDropDownCount := 8; - FFocusItem := 0; // nothing is selected + FFocusItem := -1; // nothing is selected FItems := TStringList.Create; + FItems.OnChange := @InternalItemsChanged; FFont := fpgGetFont('#List'); FOptions := []; FOnChange := nil; @@ -329,12 +337,12 @@ procedure TComboboxDropdownWindow.SetFirstItem; var i: integer; begin - // If FocusItem is less than DropDownCount FirsItem = 1 - if ListBox.FocusItem <= FCallerWidget.DropDownCount then - ListBox.SetFirstItem(1) + // If FocusItem is less than DropDownCount FirsItem = 0 + if ListBox.FocusItem+1 <= FCallerWidget.DropDownCount then + ListBox.SetFirstItem(0) // If FocusItem is in the last DropDownCount of items - else if (ListBox.ItemCount - ListBox.FocusItem) < FCallerWidget.DropDownCount then - ListBox.SetFirstItem(ListBox.ItemCount - FCallerWidget.DropDownCount+1) + else if (ListBox.ItemCount - (ListBox.FocusItem+1)) < FCallerWidget.DropDownCount then + ListBox.SetFirstItem(ListBox.ItemCount - FCallerWidget.DropDownCount) else // Try and centre FocusItem in the drow down window ListBox.SetFirstItem(ListBox.FocusItem - (FCallerWidget.DropDownCount div 2)); @@ -405,15 +413,15 @@ end; function TfpgAbstractComboBox.GetText: string; begin - if (FocusItem > 0) and (FocusItem <= FItems.Count) then - Result := Items.Strings[FocusItem-1] + if (FocusItem >= 0) and (FocusItem < FItems.Count) then + Result := Items.Strings[FocusItem] else Result := ''; end; function TfpgAbstractComboBox.HasText: boolean; begin - Result := FocusItem > 0; + Result := FocusItem >= 0; end; procedure TfpgAbstractComboBox.DoDropDown; @@ -449,8 +457,8 @@ begin r := GetDropDownPos(Parent, self, ddw); // find suitable position ddw.Height := r.Height; // in case GetDropDownPos resized us - if (FItems.Count > 0) and Assigned(OnDropDown) then - OnDropDown(self); + if (FItems.Count > 0) then + DoOnDropDown; ddw.OnClose := @InternalOnClose; ddw.ShowAt(Parent, r.Left, r.Top); @@ -477,25 +485,25 @@ var i: integer; begin if AValue = '' then - SetFocusItem(0) // nothing selected + SetFocusItem(-1) // nothing selected else begin - for i := 0 to FItems.Count - 1 do + for i := 0 to FItems.Count-1 do begin if SameText(Items.Strings[i], AValue) then begin - SetFocusItem(i+1); // our FocusItem is 1-based. TStringList is 0-based. - Exit; + SetFocusItem(i); + Exit; //==> end; end; // if we get here, we didn't find a match - SetFocusItem(0); + SetFocusItem(-1); end; end; procedure TfpgAbstractComboBox.SetWidth(const AValue: TfpgCoord); begin - inherited; + inherited SetWidth(AValue); CalculateInternalButtonRect; RePaint; end; @@ -514,7 +522,7 @@ end; procedure TfpgAbstractComboBox.SetHeight(const AValue: TfpgCoord); begin - inherited; + inherited SetHeight(AValue); CalculateInternalButtonRect; RePaint; end; @@ -541,17 +549,17 @@ var NewIndex: Integer; begin if (FDropDown <> nil) and FDropDown.Visible then - Exit; + Exit; //==> if Items.Count < 1 then - Exit; + Exit; //==> NewIndex := FocusItem + Delta; - if NewIndex > Items.Count then - NewIndex := Items.Count; + if NewIndex > Items.Count-1 then + NewIndex := Items.Count-1; - if NewIndex < 1 then - NewIndex := 1; + if NewIndex < 0 then + NewIndex := 0; if NewIndex <> FocusItem then begin @@ -651,8 +659,8 @@ begin FBackgroundColor := clBoxColor; FTextColor := Parent.TextColor; FWidth := 120; - FHeight := Font.Height + 6; FMargin := 3; + FHeight := Font.Height + (2*FMargin); FFocusable := True; FBtnPressed := False; @@ -667,7 +675,7 @@ end; procedure TfpgAbstractComboBox.Update; begin - FFocusItem := 0; + FFocusItem := -1; Repaint; end; diff --git a/src/gui/gui_customgrid.pas b/src/gui/gui_customgrid.pas index 53123cec..42f41fe2 100644 --- a/src/gui/gui_customgrid.pas +++ b/src/gui/gui_customgrid.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -56,38 +56,34 @@ type end; - { TfpgCustomGrid } - TfpgCustomGrid = class(TfpgBaseGrid) protected - FRowCount: Longword; + FRowCount: Integer; FColumns: TList; procedure SetTextColor(const AValue: TfpgColor); override; function GetColumns(AIndex: integer): TfpgGridColumn; virtual; procedure DoDeleteColumn(ACol: integer); virtual; procedure DoSetRowCount(AValue: integer); virtual; function DoCreateColumnClass: TfpgGridColumn; virtual; - function GetColumnCount: Longword; override; - procedure SetColumnCount(const AValue: Longword); virtual; - function GetRowCount: Longword; override; - procedure SetRowCount(const AValue: LongWord); virtual; - function GetColumnWidth(ACol: Longword): integer; override; - procedure SetColumnWidth(ACol: Longword; const AValue: integer); override; - function GetColumnBackgroundColor(ACol: Longword): TfpgColor; override; - procedure SetColumnBackgroundColor(ACol: Longword; const AValue: TfpgColor); override; - function GetColumnTextColor(ACol: Longword): TfpgColor; override; - procedure SetColumnTextColor(ACol: Longword; const AValue: TfpgColor); override; - function GetHeaderText(ACol: Longword): string; override; - property RowCount: Longword read GetRowCount write SetRowCount; - property ColumnCount: Longword read GetColumnCount write SetColumnCount; - { Columns AIndex is 1-based. } + function GetColumnCount: Integer; override; + procedure SetColumnCount(const AValue: Integer); virtual; + function GetRowCount: Integer; override; + procedure SetRowCount(const AValue: Integer); virtual; + function GetColumnWidth(ACol: Integer): integer; override; + procedure SetColumnWidth(ACol: Integer; const AValue: integer); override; + function GetColumnBackgroundColor(ACol: Integer): TfpgColor; override; + procedure SetColumnBackgroundColor(ACol: Integer; const AValue: TfpgColor); override; + function GetColumnTextColor(ACol: Integer): TfpgColor; override; + procedure SetColumnTextColor(ACol: Integer; const AValue: TfpgColor); override; + function GetHeaderText(ACol: Integer): string; override; + property RowCount: Integer read GetRowCount write SetRowCount; + property ColumnCount: Integer read GetColumnCount write SetColumnCount; property Columns[AIndex: integer]: TfpgGridColumn read GetColumns; // property AlternateColor: TColor read FAlternateColor write SetAlternateColor stored IsAltColorStored; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function AddColumn(ATitle: string; AWidth: integer): TfpgGridColumn; virtual; - { AIndex is 1-based. } procedure DeleteColumn(AIndex: integer); virtual; procedure MoveColumn(oldindex, newindex: integer); virtual; end; @@ -106,7 +102,7 @@ end; { TfpgCustomGrid } -function TfpgCustomGrid.GetRowCount: Longword; +function TfpgCustomGrid.GetRowCount: Integer; begin Result := FRowCount; end; @@ -125,16 +121,16 @@ end; function TfpgCustomGrid.GetColumns(AIndex: integer): TfpgGridColumn; begin - if (AIndex < 1) or (AIndex > FColumns.Count) then + if (AIndex < 0) or (AIndex > FColumns.Count-1) then Result := nil else - Result := TfpgGridColumn(FColumns[AIndex-1]); + Result := TfpgGridColumn(FColumns[AIndex]); end; procedure TfpgCustomGrid.DoDeleteColumn(ACol: integer); begin - TfpgGridColumn(FColumns.Items[ACol-1]).Free; - FColumns.Delete(ACol-1); + TfpgGridColumn(FColumns.Items[ACol]).Free; + FColumns.Delete(ACol); end; procedure TfpgCustomGrid.DoSetRowCount(AValue: integer); @@ -147,14 +143,14 @@ begin Result := TfpgGridColumn.Create; end; -function TfpgCustomGrid.GetColumnCount: Longword; +function TfpgCustomGrid.GetColumnCount: Integer; begin Result := FColumns.Count; end; -procedure TfpgCustomGrid.SetColumnCount(const AValue: Longword); +procedure TfpgCustomGrid.SetColumnCount(const AValue: Integer); var - n: Longword; + n: Integer; begin n := FColumns.Count; if (n = AValue) or (AValue < 0) then @@ -171,6 +167,7 @@ begin end else begin + // removing columns while n > AValue do begin DoDeleteColumn(n); @@ -184,35 +181,34 @@ begin RePaint; end; -procedure TfpgCustomGrid.SetRowCount(const AValue: Longword); +procedure TfpgCustomGrid.SetRowCount(const AValue: Integer); begin if FRowCount = AValue then Exit; //==> FRowCount := AValue; - if FocusRow > FRowCount then - begin - FocusRow := FRowCount; - end; + if FocusRow > FRowCount-1 then + FocusRow := FRowCount-1; DoSetRowCount(AValue); // could be implemented by descendants + if csUpdating in ComponentState then Exit; UpdateScrollBars; RePaint; end; -function TfpgCustomGrid.GetColumnWidth(ACol: Longword): integer; +function TfpgCustomGrid.GetColumnWidth(ACol: Integer): integer; begin - if (ACol > 0) and (ACol <= ColumnCount) then - Result := TfpgGridColumn(FColumns[ACol-1]).Width + if (ACol >= 0) and (ACol < ColumnCount) then + Result := TfpgGridColumn(FColumns[ACol]).Width else result := DefaultColWidth; end; -procedure TfpgCustomGrid.SetColumnWidth(ACol: Longword; const AValue: integer); +procedure TfpgCustomGrid.SetColumnWidth(ACol: Integer; const AValue: integer); var lCol: TfpgGridColumn; begin - lCol := TfpgGridColumn(FColumns[ACol-1]); + lCol := TfpgGridColumn(FColumns[ACol]); if lCol.Width <> AValue then begin @@ -225,19 +221,19 @@ begin end; end; -function TfpgCustomGrid.GetColumnBackgroundColor(ACol: Longword): TfpgColor; +function TfpgCustomGrid.GetColumnBackgroundColor(ACol: Integer): TfpgColor; begin - if (ACol > 0) and (ACol <= ColumnCount) then - Result := TfpgGridColumn(FColumns[ACol-1]).FBackgroundColor + if (ACol >= 0) and (ACol < ColumnCount) then + Result := TfpgGridColumn(FColumns[ACol]).FBackgroundColor else result := BackgroundColor; end; -procedure TfpgCustomGrid.SetColumnBackgroundColor(ACol: Longword; const AValue: TfpgColor); +procedure TfpgCustomGrid.SetColumnBackgroundColor(ACol: Integer; const AValue: TfpgColor); var lCol: TfpgGridColumn; begin - lCol := TfpgGridColumn(FColumns[ACol-1]); + lCol := TfpgGridColumn(FColumns[ACol]); if lCol.FBackgroundColor <> AValue then begin @@ -247,19 +243,19 @@ begin end; end; -function TfpgCustomGrid.GetColumnTextColor(ACol: Longword): TfpgColor; +function TfpgCustomGrid.GetColumnTextColor(ACol: Integer): TfpgColor; begin - if (ACol > 0) and (ACol <= ColumnCount) then - Result := TfpgGridColumn(FColumns[ACol-1]).FTextColor + if (ACol >= 0) and (ACol < ColumnCount) then + Result := TfpgGridColumn(FColumns[ACol]).FTextColor else result := TextColor; end; -procedure TfpgCustomGrid.SetColumnTextColor(ACol: Longword; const AValue: TfpgColor); +procedure TfpgCustomGrid.SetColumnTextColor(ACol: Integer; const AValue: TfpgColor); var lCol: TfpgGridColumn; begin - lCol := TfpgGridColumn(FColumns[ACol-1]); + lCol := TfpgGridColumn(FColumns[ACol]); if lCol.FTextColor <> AValue then begin @@ -269,9 +265,9 @@ begin end; end; -function TfpgCustomGrid.GetHeaderText(ACol: Longword): string; +function TfpgCustomGrid.GetHeaderText(ACol: Integer): string; begin - Result := TfpgGridColumn(FColumns[ACol-1]).Title; + Result := TfpgGridColumn(FColumns[ACol]).Title; end; constructor TfpgCustomGrid.Create(AOwner: TComponent); diff --git a/src/gui/gui_dialogs.pas b/src/gui/gui_dialogs.pas index f7c2060b..62e87c80 100644 --- a/src/gui/gui_dialogs.pas +++ b/src/gui/gui_dialogs.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -138,8 +138,6 @@ type end; - { TfpgFileDialog } - TfpgFileDialog = class(TfpgBaseDialog) private chlDir: TfpgComboBox; @@ -159,7 +157,7 @@ type procedure SetFilter(const Value: string); function GetShowHidden: boolean; procedure SetShowHidden(const Value: boolean); - procedure ListChanged(Sender: TObject; ARow: Longword); + procedure ListChanged(Sender: TObject; ARow: Integer); procedure GridDblClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); procedure InitializeComponents; procedure ProcessFilterString; @@ -508,14 +506,13 @@ end; procedure TfpgFontSelectDialog.CreateFontList; var fl: TStringList; - i: integer; begin - lbFaces.Items.Clear; + lbFaces.BeginUpdate; fl := fpgApplication.GetFontFaceList; - for i := 0 to fl.Count-1 do - lbFaces.Items.Add(fl[i]); + lbFaces.Items.Assign(fl); fl.Free; - lbFaces.FocusItem := 1; + lbFaces.FocusItem := 0; + lbFaces.EndUpdate; end; procedure TfpgFontSelectDialog.CreateFontAliasList; @@ -523,12 +520,14 @@ var fl: TStringList; i: integer; begin - lbFaces.Items.Clear; + lbFaces.BeginUpdate; fl := fpgGetNamedFontList; + lbFaces.Items.Clear; for i := 0 to fl.Count-1 do lbFaces.Items.Add(fl.Names[i]); fl.Free; - lbFaces.FocusItem := 1 + lbFaces.FocusItem := 0; + lbFaces.EndUpdate; end; procedure TfpgFontSelectDialog.SetupUI(AMode: Byte); @@ -537,23 +536,23 @@ begin case FMode of 1: // Normal Fonts begin - lblSize.Enabled := True; - lblTypeFace.Enabled := True; - lbSize.Enabled := True; - cbBold.Enabled := True; - cbItalic.Enabled := True; - cbUnderline.Enabled := True; - cbAntiAlias.Enabled := True; + lblSize.Enabled := True; + lblTypeFace.Enabled := True; + lbSize.Enabled := True; + cbBold.Enabled := True; + cbItalic.Enabled := True; + cbUnderline.Enabled := True; + cbAntiAlias.Enabled := True; end; 2: // Font Aliases begin - lblSize.Enabled := False; - lblTypeFace.Enabled := False; - lbSize.Enabled := False; - cbBold.Enabled := False; - cbItalic.Enabled := False; - cbUnderline.Enabled := False; - cbAntiAlias.Enabled := False; + lblSize.Enabled := False; + lblTypeFace.Enabled := False; + lbSize.Enabled := False; + cbBold.Enabled := False; + cbItalic.Enabled := False; + cbUnderline.Enabled := False; + cbAntiAlias.Enabled := False; end; end; end; @@ -589,7 +588,6 @@ procedure TfpgFontSelectDialog.SetFontDesc(Desc: string); var cp: integer; c: char; - i: integer; token: string; prop: string; propval: string; @@ -619,9 +617,9 @@ var i: integer; begin lbCollection.FocusItem := lbCollection.ItemCount; - for i := 1 to lbFaces.ItemCount do + for i := 0 to lbFaces.ItemCount-1 do begin - if SameText(lbFaces.Items[i-1], Desc) then + if SameText(lbFaces.Items[i], Desc) then begin lbFaces.FocusItem := i; Exit; //==> @@ -651,16 +649,13 @@ begin cbAntiAlias.Checked := True; NextToken; - i := lbFaces.Items.IndexOf(token); - if i >= 0 then - lbFaces.FocusItem := i+1; + lbFaces.FocusItem := lbFaces.Items.IndexOf(token); + if c = '-' then begin NextC; NextToken; - i := lbSize.Items.IndexOf(token); - if i >= 0 then - lbSize.FocusItem := i+1; + lbSize.FocusItem := lbSize.Items.IndexOf(token); end; while c = ':' do @@ -728,7 +723,7 @@ begin Text := fpgAddColon(rsCollection); end; - { TODO : This need to be implemented at some stage. } + { TODO : This need to be fully implemented at some stage. } lbCollection := TfpgListBox.Create(self); with lbCollection do begin @@ -743,7 +738,7 @@ begin Items.Add(rsCollectionSans); Items.Add(rsCollectionSerif); Items.Add(rsCollectionFontAliases); - FocusItem := 1; + FocusItem := 0; OnChange := @OnCollectionChanged; // Enabled := False; end; @@ -779,7 +774,6 @@ begin begin Name := 'lbSize'; SetPosition(401, 28, 52, 236); - { We need to improve this! } Items.Add('6'); Items.Add('7'); Items.Add('8'); @@ -877,7 +871,7 @@ end; { TfpgFileDialog } -procedure TfpgFileDialog.ListChanged(Sender: TObject; ARow: Longword); +procedure TfpgFileDialog.ListChanged(Sender: TObject; ARow: Integer); var s: string; begin @@ -1049,10 +1043,7 @@ begin ActiveWidget := grid; FileName := ''; SetFilter(rsAllFiles + ' (*)|*'); - // we don't want chlFilter to call FilterChange - chlFilter.OnChange := nil; - chlFilter.FocusItem := 1; - chlFilter.OnChange := @FilterChange; // restore event handler + chlFilter.FocusItem := 0; end; procedure TfpgFileDialog.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); @@ -1213,13 +1204,13 @@ begin // we don't want chlDir to call DirChange while populating items chlDir.OnChange := nil; chlDir.Items.Assign(grid.FileList.SpecialDirs); - chlDir.FocusItem := grid.FileList.CurrentSpecialDir + 1; + chlDir.FocusItem := grid.FileList.CurrentSpecialDir; chlDir.OnChange := @DirChange; // restore event handler if fsel <> '' then SelectFile(fsel) else - grid.FocusRow := 1; + grid.FocusRow := 0; grid.Update; grid.SetFocus; @@ -1229,7 +1220,7 @@ function TfpgFileDialog.SelectFile(const AFilename: string): boolean; var n: integer; begin - for n := 1 to grid.FileList.Count do + for n := 0 to grid.FileList.Count-1 do begin if grid.FileList.Entry[n].Name = AFilename then begin @@ -1280,6 +1271,7 @@ begin FFilterList.Add(fm); end; until (fs = '') or (fm = ''); { repeat/until } + chlFilter.FocusItem := 0; // first filter // restore event handler chlFilter.OnChange := @FilterChange; end; @@ -1289,8 +1281,8 @@ var i: integer; begin i := chlFilter.FocusItem; - if (i > 0) and (i <= FFilterList.Count) then - Result := FFilterList[i-1] + if (i >= 0) and (i < FFilterList.Count) then + Result := FFilterList[i] else Result := '*'; end; diff --git a/src/gui/gui_edit.pas b/src/gui/gui_edit.pas index fd3d2ad7..ccfe5418 100644 --- a/src/gui/gui_edit.pas +++ b/src/gui/gui_edit.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -75,6 +75,7 @@ type FSelOffset: integer; FCursorPos: integer; // Caret position (characters) FCursorX: integer; // Caret position (pixels) + procedure DoOnChange; virtual; procedure ShowDefaultPopupMenu(const x, y: integer; const shiftstate: TShiftState); virtual; procedure HandlePaint; override; procedure HandleResize(awidth, aheight: TfpgCoord); override; @@ -457,8 +458,7 @@ begin end; if prevval <> Text then - if Assigned(FOnChange) then - FOnChange(self); + DoOnChange; end; if consumed then @@ -855,6 +855,12 @@ begin end; end; +procedure TfpgCustomEdit.DoOnChange; +begin + if Assigned(FOnChange) then + FOnChange(self); +end; + procedure TfpgCustomEdit.ShowDefaultPopupMenu(const x, y: integer; const shiftstate: TShiftState); var diff --git a/src/gui/gui_editcombo.pas b/src/gui/gui_editcombo.pas index a9c32cc9..fe5b1d89 100644 --- a/src/gui/gui_editcombo.pas +++ b/src/gui/gui_editcombo.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -77,7 +77,6 @@ type procedure InternalBtnClick(Sender: TObject); procedure InternalListBoxSelect(Sender: TObject); procedure CalculateInternalButtonRect; - procedure MsgPopupClose(var msg: TfpgMessageRec); message FPGM_POPUPCLOSE; protected FMargin: integer; FBtnPressed: Boolean; @@ -253,7 +252,7 @@ end; procedure TfpgAbstractEditCombo.SetAllowNew(const AValue: TAllowNew); begin if FAllowNew <> AValue then - FAllowNew:= AValue; + FAllowNew := AValue; end; function TfpgAbstractEditCombo.GetText: string; @@ -262,10 +261,10 @@ var begin if FAutoCompletion then begin - if (FocusItem > 0) and (FocusItem <= FItems.Count) then + if (FocusItem >= 0) and (FocusItem <= FItems.Count-1) then begin - FText := FItems.Strings[FocusItem-1]; - FSelectedItem:= FocusItem-1; + FText := FItems.Strings[FocusItem]; + FSelectedItem:= FocusItem; end else if FText <> '' then @@ -290,32 +289,34 @@ begin end; case FAllowNew of anNo: - if FSelectedItem= -1 then + if FSelectedItem = -1 then begin UTF8Delete(FText, FCursorPos, 1); Dec(FCursorPos); end; - anAsk,anYes: - if FSelectedItem= -1 then + + anAsk, + anYes: + if FSelectedItem = -1 then begin FNewItem:= True; end; - end; - end; + end; { case } + end; { if/else } FCursorPos := UTF8Length(FText); FSelStart := FCursorPos; Result := FText; end else - if (FocusItem > 0) and (FocusItem <= FItems.Count) then - Result := FItems.Strings[FocusItem-1] + if (FocusItem >= 0) and (FocusItem <= FItems.Count-1) then + Result := FItems.Strings[FocusItem] else Result := ''; end; function TfpgAbstractEditCombo.HasText: boolean; begin - Result := FFocusItem > 0; + Result := FFocusItem >= 0; end; procedure TfpgAbstractEditCombo.DoDropDown; @@ -337,7 +338,7 @@ begin // Assign combobox text items to internal listbox if FAutoCompletion then begin - for i := 0 to FItems.Count - 1 do + for i := 0 to FItems.Count-1 do if SameText(UTF8Copy(FItems.Strings[i], 1, UTF8Length(FText)), FText) then ddw.ListBox.Items.Add(FItems.Strings[i]); end @@ -360,8 +361,8 @@ begin r := GetDropDownPos(Parent, self, ddw); ddw.Height := r.Height; - if (FItems.Count > 0) and Assigned(OnDropDown) then - OnDropDown(self); + if (FItems.Count > 0) then + DoOnDropDown; ddw.OnClose := @InternalOnClose; ddw.ShowAt(Parent, r.Left, r.Top); @@ -386,10 +387,9 @@ var begin for i := 0 to Items.Count-1 do begin - // Items is 0-based and FocusItem is 1-based - if Items[i]= TDropDownWindow(FDropDown).ListBox.Items[TDropDownWindow(FDropDown).ListBox.FocusItem-1] then + if Items[i]= TDropDownWindow(FDropDown).ListBox.Items[TDropDownWindow(FDropDown).ListBox.FocusItem] then begin - FocusItem := i+1; + FocusItem := i; Break; end; end; @@ -406,26 +406,26 @@ begin if AValue = '' then begin FText:= ''; - FocusItem := 0; // nothing selected + FocusItem := -1; // nothing selected end else begin - for i := 0 to Items.Count - 1 do + for i := 0 to Items.Count-1 do begin if SameText(UTF8Copy(Items.Strings[i], 1, UTF8Length(AVAlue)), AValue) then begin - FocusItem := i+1; // our FocusItem is 1-based. TStringList is 0-based. - Exit; + FocusItem := i; + Exit; //==> end; end; // if we get here, we didn't find a match - FocusItem := 0; + FocusItem := -1; end; end; procedure TfpgAbstractEditCombo.SetWidth(const AValue: TfpgCoord); begin - inherited; + inherited SetWidth(AValue); CalculateInternalButtonRect; RePaint; end; @@ -436,14 +436,9 @@ begin Height-4); end; -procedure TfpgAbstractEditCombo.MsgPopupClose(var msg: TfpgMessageRec); -begin - DoDropDown; -end; - procedure TfpgAbstractEditCombo.SetHeight(const AValue: TfpgCoord); begin - inherited; + inherited SetHeight(AValue); CalculateInternalButtonRect; RePaint; end; @@ -451,7 +446,7 @@ end; procedure TfpgAbstractEditCombo.HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); var - s: string; + s: TfpgChar; prevval: string; begin prevval := FText; @@ -459,7 +454,7 @@ begin consumed := False; // Handle only printable characters - // Note: This is not UTF-8 compliant! + // Note: This is now UTF-8 compliant! if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) or (Length(AText) > 1) then begin if (FMaxLength <= 0) or (UTF8Length(FText) < FMaxLength) then @@ -493,34 +488,34 @@ begin keyBackSpace: begin if HasText then - FocusItem := 0; + FocusItem := -1; if FCursorPos > 0 then begin UTF8Delete(FText, FCursorPos, 1); Dec(FCursorPos); hasChanged := True; - end;// backspace + end; end; keyDelete: begin if HasText then - FocusItem := 0; + FocusItem := -1; FSelectedItem := -2; // detects delete has been pressed hasChanged := True; end; - keyReturn, keyPEnter: + keyReturn, + keyPEnter: begin if FSelectedItem > -1 then SetText(Items[FSelectedItem]) else SetText(FText); - FSelectedItem:= -4; // detects return has been pressed (must be 4 due to number of repaints) + FSelectedItem := -4; // detects return has been pressed (must be 4 due to number of repaints) if FNewItem and (FAllowNew = anYes) then FItems.Add(FText); - if Assigned(FDropDown) then - FDropDown.Close; + DoOnDropDown; end; else @@ -606,6 +601,17 @@ var end; tw := Font.TextWidth(UTF8Copy(Items[FSelectedItem], 1, st)); tw2 := Font.TextWidth(UTF8Copy(Items[FSelectedItem], 1, st + len)); + + // XOR on Anti-aliased text doesn't look to good. Lets try standard + // Blue & White like what was doen in TfpgEdit. +{ Canvas.SetColor(lcolor); + Canvas.FillRectangle(-FDrawOffset + FMargin + tw, 3, tw2 - tw, Font.Height); + r.SetRect(-FDrawOffset + FMargin + tw, 3, tw2 - tw, Font.Height); + Canvas.AddClipRect(r); + Canvas.SetTextColor(clWhite); + fpgStyle.DrawString(Canvas, -FDrawOffset + FMargin, 3, Text, Enabled); + Canvas.ClearClipRect; +} Canvas.XORFillRectangle(fpgColorToRGB(lcolor) xor $FFFFFF, -FDrawOffset + FMargin + tw, 3, tw2 - tw, Font.Height); end; @@ -663,23 +669,23 @@ begin begin if HasText then begin - FSelOffset:= 0; + FSelOffset := 0; fpgStyle.DrawString(Canvas, FMargin+1, FMargin, Text, Enabled); end else begin - Texte:= Text; + Texte := Text; if Texte <> '' then if FSelectedItem > -1 then begin - FSelOffset:= Font.TextWidth(UTF8Copy(Items[FSelectedItem], UTF8Length(FText) + 1, + FSelOffset := Font.TextWidth(UTF8Copy(Items[FSelectedItem], UTF8Length(FText) + 1, UTF8Length(Items[FSelectedItem]) - UTF8Length(FText))); fpgStyle.DrawString(Canvas, FMargin+1, FMargin, FText + UTF8Copy(Items[FSelectedItem], UTF8Length(FText) + 1, UTF8Length(Items[FSelectedItem]) - UTF8Length(FText)), Enabled); end else begin - FSelOffset:= 0; + FSelOffset := 0; fpgStyle.DrawString(Canvas, FMargin+1, FMargin, FText, Enabled); end; end; @@ -725,9 +731,7 @@ begin if Enabled then Canvas.SetColor(clText1) else - begin Canvas.SetColor(clShadow1); - end; // paint arrow fpgStyle.DrawDirectionArrow(Canvas, ar.Left, ar.Top, ar.Width, ar.Height, 1); Canvas.EndDraw(FInternalBtnRect); @@ -744,7 +748,8 @@ begin FFocusable := True; FBtnPressed := False; FAutocompletion := False; - AutoDropDown := False; + FAutoDropDown := False; + FAllowNew := anNo; FText := ''; FCursorPos := UTF8Length(FText); @@ -765,7 +770,7 @@ end; procedure TfpgAbstractEditCombo.Update; begin - FFocusItem := 0; + FFocusItem := -1; Repaint; end; diff --git a/src/gui/gui_form.pas b/src/gui/gui_form.pas index 69e1470a..ea68397b 100644 --- a/src/gui/gui_form.pas +++ b/src/gui/gui_form.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_gauge.pas b/src/gui/gui_gauge.pas index 16d4fd74..b3685d50 100644 --- a/src/gui/gui_gauge.pas +++ b/src/gui/gui_gauge.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_grid.pas b/src/gui/gui_grid.pas index 906b3d6a..eaeb9ddc 100644 --- a/src/gui/gui_grid.pas +++ b/src/gui/gui_grid.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -39,43 +39,14 @@ uses gui_customgrid; type -{ - TfpgGrid = class(TfpgCustomGrid) - public - property Font; - property HeaderFont; - published - property Columns; - property DefaultColWidth; - property DefaultRowHeight; - property FontDesc; - property HeaderFontDesc; - property BackgroundColor; - property FocusCol; - property FocusRow; - property RowSelect; - property ColumnCount; - property RowCount; - property ShowHeader; - property ShowGrid; - property HeaderHeight; - property ColResizing; - property ColumnWidth; - property OnFocusChange; - property OnRowChange; - property OnDoubleClick; - end; -} - - { TfpgFileGrid } TfpgFileGrid = class(TfpgCustomGrid) private FFileList: TfpgFileList; FFixedFont: TfpgFont; protected - function GetRowCount: Longword; override; - procedure DrawCell(ARow, ACol: Longword; ARect: TfpgRect; AFlags: TfpgGridDrawState); override; + function GetRowCount: Integer; override; + procedure DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -111,33 +82,31 @@ type TfpgCustomStringGrid = class(TfpgCustomGrid) private - function GetCell(ACol, ARow: Longword): string; - function GetColumnTitle(ACol: Longword): string; - function GetObjects(ACol, ARow: Longword): TObject; - procedure SetCell(ACol, ARow: Longword; const AValue: string); - procedure SetColumnTitle(ACol: Longword; const AValue: string); - procedure SetObjects(ACol, ARow: Longword; const AValue: TObject); + function GetCell(ACol, ARow: Integer): string; + function GetColumnTitle(ACol: Integer): string; + function GetObjects(ACol, ARow: Integer): TObject; + procedure SetCell(ACol, ARow: Integer; const AValue: string); + procedure SetColumnTitle(ACol: Integer; const AValue: string); + procedure SetObjects(ACol, ARow: Integer; const AValue: TObject); protected - function GetColumnWidth(ACol: Longword): integer; override; - procedure SetColumnWidth(ACol: Longword; const AValue: integer); override; - function GetColumns(AIndex: Longword): TfpgStringColumn; reintroduce; + function GetColumnWidth(ACol: Integer): integer; override; + procedure SetColumnWidth(ACol: Integer; const AValue: integer); override; + function GetColumns(AIndex: Integer): TfpgStringColumn; reintroduce; procedure DoDeleteColumn(ACol: integer); override; procedure DoSetRowCount(AValue: integer); override; function DoCreateColumnClass: TfpgStringColumn; reintroduce; override; - procedure DrawCell(ARow, ACol: Longword; ARect: TfpgRect; AFlags: TfpgGridDrawState); override; - { AIndex is 1-based. } - property Columns[AIndex: Longword]: TfpgStringColumn read GetColumns; + procedure DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); override; + property Columns[AIndex: Integer]: TfpgStringColumn read GetColumns; public constructor Create(AOwner: TComponent); override; function AddColumn(ATitle: string; AWidth: integer; AAlignment: TAlignment = taLeftJustify; AbackgroundColor: TfpgColor = clDefault; ATextColor: TfpgColor = clDefault): TfpgStringColumn; overload; - { ACol and ARow is 1-based. } - property Cells[ACol, ARow: Longword]: string read GetCell write SetCell; - property Objects[ACol, ARow: Longword]: TObject read GetObjects write SetObjects; - property ColumnTitle[ACol: Longword]: string read GetColumnTitle write SetColumnTitle; - property ColumnWidth[ACol: Longword]: integer read GetColumnWidth write SetColumnWidth; - property ColumnBackgroundColor[ACol: Longword]: TfpgColor read GetColumnBackgroundColor write SetColumnBackgroundColor; - property ColumnTextColor[ACol: Longword]: TfpgColor read GetColumnTextColor write SetColumnTextColor; + property Cells[ACol, ARow: Integer]: string read GetCell write SetCell; + property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects; + property ColumnTitle[ACol: Integer]: string read GetColumnTitle write SetColumnTitle; + property ColumnWidth[ACol: Integer]: integer read GetColumnWidth write SetColumnWidth; + property ColumnBackgroundColor[ACol: Integer]: TfpgColor read GetColumnBackgroundColor write SetColumnBackgroundColor; + property ColumnTextColor[ACol: Integer]: TfpgColor read GetColumnTextColor write SetColumnTextColor; // property Cols[index: Integer]: TStrings read GetCols write SetCols; // property Rows[index: Integer]: TStrings read GetRows write SetRows; end; @@ -192,12 +161,12 @@ end; { TfpgFileGrid } -function TfpgFileGrid.GetRowCount: Longword; +function TfpgFileGrid.GetRowCount: Integer; begin Result := FFileList.Count; end; -procedure TfpgFileGrid.DrawCell(ARow, ACol: Longword; ARect: TfpgRect; AFlags: TfpgGridDrawState); +procedure TfpgFileGrid.DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); const picture_width = 20; var @@ -215,13 +184,13 @@ begin y := ARect.Top;// + 1; s := ''; - if (e.EntryType = etDir) and (ACol = 1) then + if (e.EntryType = etDir) and (ACol = 0) then Canvas.SetFont(HeaderFont) else Canvas.SetFont(Font); case ACol of - 1: begin + 0: begin if e.EntryType = etDir then img := fpgImages.GetImage('stdimg.folder') // Do NOT localize else if e.IsExecutable then @@ -238,16 +207,16 @@ begin s := e.Name; end; - 2: begin + 1: begin s := FormatFloat('###,###,###,##0', e.size); x := ARect.Right - Font.TextWidth(s) - 1; if x < (ARect.Left + 2) then x := ARect.Left + 2; end; - 3: s := FormatDateTime('yyyy-mm-dd hh:nn', e.ModTime); + 2: s := FormatDateTime('yyyy-mm-dd hh:nn', e.ModTime); - 4: begin + 3: begin if FFileList.HasFileMode then // on unix s := e.Mode else // on windows @@ -259,8 +228,8 @@ begin if FFileList.HasFileMode then // unix case ACol of - 5: s := e.Owner; - 6: s := e.Group; + 4: s := e.Owner; + 5: s := e.Group; end; // centre text in row height @@ -289,7 +258,8 @@ begin AddColumn(rsFileRights, 78); AddColumn(rsFileOwner, 54); AddColumn(rsFileGroup, 54); - end else + end + else AddColumn(rsFileAttributes, 78); RowSelect := True; @@ -325,93 +295,93 @@ end; { TfpgCustomStringGrid } -function TfpgCustomStringGrid.GetCell(ACol, ARow: Longword): string; +function TfpgCustomStringGrid.GetCell(ACol, ARow: Integer): string; begin - if ACol > ColumnCount then + if ACol > ColumnCount-1 then Exit; //==> - if ARow > RowCount then + if ARow > RowCount-1 then Exit; //==> - Result := TfpgStringColumn(FColumns.Items[ACol-1]).Cells[ARow-1]; + Result := TfpgStringColumn(FColumns.Items[ACol]).Cells[ARow]; end; -function TfpgCustomStringGrid.GetColumnTitle(ACol: Longword): string; +function TfpgCustomStringGrid.GetColumnTitle(ACol: Integer): string; begin - if ACol > ColumnCount then + if ACol > ColumnCount-1 then Exit; //==> - Result := TfpgStringColumn(FColumns.Items[ACol-1]).Title; + Result := TfpgStringColumn(FColumns.Items[ACol]).Title; end; -function TfpgCustomStringGrid.GetObjects(ACol, ARow: Longword): TObject; +function TfpgCustomStringGrid.GetObjects(ACol, ARow: Integer): TObject; begin - if ACol > ColumnCount then + if ACol > ColumnCount-1 then Exit; //==> - if ARow > RowCount then + if ARow > RowCount-1 then Exit; //==> - Result := TfpgStringColumn(FColumns.Items[ACol-1]).Cells.Objects[ARow-1]; + Result := TfpgStringColumn(FColumns.Items[ACol]).Cells.Objects[ARow]; end; -function TfpgCustomStringGrid.GetColumnWidth(ACol: Longword): integer; +function TfpgCustomStringGrid.GetColumnWidth(ACol: Integer): integer; begin - if ACol > ColumnCount then + if ACol > ColumnCount-1 then Exit; //==> - Result := TfpgStringColumn(FColumns.Items[ACol-1]).Width; + Result := TfpgStringColumn(FColumns.Items[ACol]).Width; end; -procedure TfpgCustomStringGrid.SetCell(ACol, ARow: Longword; +procedure TfpgCustomStringGrid.SetCell(ACol, ARow: Integer; const AValue: string); begin - if ACol > ColumnCount then + if ACol > ColumnCount-1 then Exit; //==> - if ARow > RowCount then + if ARow > RowCount-1 then Exit; //==> - if TfpgStringColumn(FColumns.Items[ACol-1]).Cells[ARow-1] <> AValue then + if TfpgStringColumn(FColumns.Items[ACol]).Cells[ARow] <> AValue then begin BeginUpdate; - TfpgStringColumn(FColumns.Items[ACol-1]).Cells[ARow-1] := AValue; + TfpgStringColumn(FColumns.Items[ACol]).Cells[ARow] := AValue; EndUpdate; end; end; -procedure TfpgCustomStringGrid.SetColumnTitle(ACol: Longword; const AValue: string); +procedure TfpgCustomStringGrid.SetColumnTitle(ACol: Integer; const AValue: string); begin - if ACol > ColumnCount then + if ACol > ColumnCount-1 then Exit; //==> BeginUpdate; - TfpgStringColumn(FColumns.Items[ACol-1]).Title := AValue; + TfpgStringColumn(FColumns.Items[ACol]).Title := AValue; EndUpdate; end; -procedure TfpgCustomStringGrid.SetObjects(ACol, ARow: Longword; +procedure TfpgCustomStringGrid.SetObjects(ACol, ARow: Integer; const AValue: TObject); begin - if ACol > ColumnCount then + if ACol > ColumnCount-1 then Exit; //==> - if ARow > RowCount then + if ARow > RowCount-1 then Exit; //==> - TfpgStringColumn(FColumns.Items[ACol-1]).Cells.Objects[ARow-1] := AValue; + TfpgStringColumn(FColumns.Items[ACol]).Cells.Objects[ARow] := AValue; end; -procedure TfpgCustomStringGrid.SetColumnWidth(ACol: Longword; const AValue: integer); +procedure TfpgCustomStringGrid.SetColumnWidth(ACol: Integer; const AValue: integer); begin - if ACol > ColumnCount then + if ACol > ColumnCount-1 then Exit; //==> BeginUpdate; - TfpgStringColumn(FColumns.Items[ACol-1]).Width := AValue; + TfpgStringColumn(FColumns.Items[ACol]).Width := AValue; EndUpdate; end; -function TfpgCustomStringGrid.GetColumns(AIndex: Longword): TfpgStringColumn; +function TfpgCustomStringGrid.GetColumns(AIndex: Integer): TfpgStringColumn; begin - if (AIndex < 1) or (AIndex > ColumnCount) then + if (AIndex < 0) or (AIndex > ColumnCount-1) then Result := nil else - Result := TfpgStringColumn(FColumns.Items[AIndex-1]); + Result := TfpgStringColumn(FColumns.Items[AIndex]); end; procedure TfpgCustomStringGrid.DoDeleteColumn(ACol: integer); begin - TfpgStringColumn(FColumns.Items[ACol-1]).Free; - FColumns.Delete(ACol-1); + TfpgStringColumn(FColumns.Items[ACol]).Free; + FColumns.Delete(ACol); end; procedure TfpgCustomStringGrid.DoSetRowCount(AValue: integer); @@ -439,7 +409,7 @@ begin Result := TfpgStringColumn.Create; end; -procedure TfpgCustomStringGrid.DrawCell(ARow, ACol: Longword; ARect: TfpgRect; +procedure TfpgCustomStringGrid.DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); var x: TfpgCoord; @@ -497,7 +467,7 @@ begin else Result.TextColor:= ATextColor; - for r := 1 to RowCount do + for r := 0 to RowCount-1 do Result.Cells.Append(''); Updated; end; diff --git a/src/gui/gui_hyperlink.pas b/src/gui/gui_hyperlink.pas index ee424a53..a4310fb9 100644 --- a/src/gui/gui_hyperlink.pas +++ b/src/gui/gui_hyperlink.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_iniutils.pas b/src/gui/gui_iniutils.pas index 9bd204a8..34e85ba3 100644 --- a/src/gui/gui_iniutils.pas +++ b/src/gui/gui_iniutils.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_label.pas b/src/gui/gui_label.pas index 96ed5d2b..09fc21ff 100644 --- a/src/gui/gui_label.pas +++ b/src/gui/gui_label.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_listbox.pas b/src/gui/gui_listbox.pas index f606099a..2825df34 100644 --- a/src/gui/gui_listbox.pas +++ b/src/gui/gui_listbox.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -52,6 +52,7 @@ type FOnSelect: TNotifyEvent; FPopupFrame: boolean; FAutoHeight: boolean; + FUpdateCount: Integer; function GetFontDesc: string; procedure SetFocusItem(const AValue: integer); procedure SetFontDesc(const AValue: string); @@ -65,12 +66,13 @@ type FMouseDragging: boolean; FFirstItem: integer; FMargin: integer; + procedure MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT; procedure UpdateScrollBar; procedure FollowFocus; function ListHeight: TfpgCoord; function ScrollBarWidth: TfpgCoord; function PageLength: integer; - procedure ScrollBarMove(Sender: TObject; position: integer); + procedure ScrollBarMove(Sender: TObject; APosition: integer); procedure DrawItem(num: integer; rect: TfpgRect; flags: integer); virtual; procedure DoChange; procedure DoSelect; @@ -89,22 +91,23 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure BeginUpdate; + procedure EndUpdate; procedure Update; function ItemCount: integer; virtual; function RowHeight: integer; virtual; procedure SetFirstItem(item: integer); property Font: TfpgFont read FFont; property OnChange: TNotifyEvent read FOnChange write FOnChange; - property OnSelect: TNotifyEvent read FOnSelect write FOnSelect; - property OnScroll: TNotifyEvent read FOnScroll write FOnScroll; property OnKeyPress; // to allow to detect return or tab key has been pressed + property OnScroll: TNotifyEvent read FOnScroll write FOnScroll; + property OnSelect: TNotifyEvent read FOnSelect write FOnSelect; end; // Listbox containg strings - the normal listbox as we know it. Used by // component developers. TfpgTextListBox = class(TfpgBaseListBox) - private protected FItems: TStringList; procedure DrawItem(num: integer; rect: TfpgRect; flags: integer); override; @@ -246,20 +249,28 @@ function TfpgListBoxStrings.Add(const s: String): Integer; begin Result := inherited Add(s); if Assigned(ListBox) and (ListBox.HasHandle) then + begin ListBox.UpdateScrollBar; + ListBox.Invalidate; + end; end; procedure TfpgListBoxStrings.Delete(Index: Integer); begin inherited Delete(Index); if Assigned(ListBox) and (ListBox.HasHandle) then + begin ListBox.UpdateScrollBar; + ListBox.Invalidate; + end; end; procedure TfpgListBoxStrings.Clear; begin inherited Clear; - ListBox.FocusItem := 0; + ListBox.FocusItem := -1; + ListBox.UpdateScrollBar; + ListBox.Invalidate; end; @@ -279,19 +290,19 @@ begin old := FFocusItem; // do some sanity checks - if AValue < 0 then // zero is a valid focusitem (no selection) - FFocusItem := 1 - else if AValue > ItemCount then - FFocusItem := ItemCount + if AValue < -1 then // -1 is a valid focusitem (no selection) + FFocusItem := -1 + else if AValue > ItemCount-1 then + FFocusItem := ItemCount-1 else FFocusItem := AValue; if FFocusItem = old then Exit; //==> - if FFocusItem <= 1 then - FFirstItem := 1; - + if FFocusItem <= 0 then + FFirstItem := 0; + FollowFocus; UpdateScrollbar; RePaint; @@ -340,6 +351,13 @@ begin Height := (PageLength * RowHeight) + (2 * FMargin); end; +procedure TfpgBaseListBox.MsgPaint(var msg: TfpgMessageRec); +begin + // Optimising painting and preventing OnPaint from firing if not needed + if FUpdateCount = 0 then + inherited MsgPaint(msg); +end; + procedure TfpgBaseListBox.SetFirstItem(item: integer); begin FFirstItem := item; @@ -351,16 +369,16 @@ var pn : integer; begin pn := PageLength; - FScrollBar.Visible := PageLength < ItemCount; + FScrollBar.Visible := PageLength < ItemCount-1; if FScrollBar.Visible then begin - FScrollBar.Min := 1; + FScrollBar.Min := 0; if ItemCount <> 0 then FScrollBar.SliderSize := pn / ItemCount else FScrollBar.SliderSize := 1; - FScrollBar.Max := ItemCount-pn+1; + FScrollBar.Max := ItemCount-1-pn; FScrollBar.Position := FFirstItem; FScrollBar.RepaintSlider; end; @@ -368,14 +386,11 @@ end; procedure TfpgBaseListBox.FollowFocus; var - n : integer; - h : TfpgCoord; + n: integer; + h: TfpgCoord; begin if FFocusItem < FFirstItem then - begin - FFirstItem := FFocusItem; - UpdateScrollBar; - end + FFirstItem := FFocusItem else begin h := 0; @@ -385,11 +400,14 @@ begin if h > ListHeight then begin FFirstItem := n+1; - UpdateScrollBar; - break; + Break; end; end; end; + + if FFirstItem < 0 then + FFirstItem := 0; + UpdateScrollBar; end; function TfpgBaseListBox.ListHeight: TfpgCoord; @@ -407,12 +425,12 @@ end; function TfpgBaseListBox.PageLength: integer; begin - result := Trunc(ListHeight / RowHeight); + result := (ListHeight div RowHeight)-1; // component height minus 1 line end; -procedure TfpgBaseListBox.ScrollBarMove(Sender: TObject; position: integer); +procedure TfpgBaseListBox.ScrollBarMove(Sender: TObject; APosition: integer); begin - FFirstItem := position; + FFirstItem := APosition; Repaint; if Assigned(FOnScroll) then FOnScroll(self); @@ -420,9 +438,6 @@ end; procedure TfpgBaseListBox.DoChange; begin - {$IFDEF DEBUG} - writeln(Name + '.OnChange assigned'); - {$ENDIF} if Assigned(OnChange) then FOnChange(self); end; @@ -441,39 +456,51 @@ begin case keycode of keyUp: begin - if FFocusItem > 1 then + if FFocusItem > 0 then FocusItem := FFocusItem - 1; end; keyDown: begin - if FFocusItem < ItemCount then + if FFocusItem < (ItemCount-1) then FocusItem := FFocusItem + 1; end; keyPageUp: begin - FocusItem := FFocusItem - PageLength; + if ItemCount > 0 then + begin + if ((FFocusItem - PageLength) < 0) then + FocusItem := 0 + else + FocusItem := FFocusItem - PageLength; + end; end; keyPageDown: begin - FocusItem := FFocusItem + PageLength; + if ItemCount > 0 then + begin + if (FFocusItem + PageLength) > ItemCount-1 then + FocusItem := ItemCount - 1 + else + FocusItem := FFocusItem + PageLength; + end; end; keyHome: begin - FocusItem := 1; + FocusItem := 0; end; keyEnd: begin - FocusItem := ItemCount; + FocusItem := ItemCount-1; end; keyReturn, keyPEnter: begin - if FocusItem > 0 then + if FocusItem > -1 then DoSelect; consumed := false; // to allow the forms to detect it end; @@ -495,10 +522,7 @@ begin end; procedure TfpgBaseListBox.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); -var - r: TfpgRect; begin - r.SetRect(Left, Top, Width, Height); inherited HandleLMouseUp(x, y, shiftstate); if ItemCount < 1 then Exit; //==> @@ -520,8 +544,8 @@ begin Exit; //==> NewFocus := FFirstItem + Trunc((y - FMargin) / RowHeight); - if NewFocus < 1 then - NewFocus := 1; + if NewFocus < 0 then + NewFocus := 0; FocusItem := NewFocus; end; @@ -536,10 +560,10 @@ begin else // scroll up FFirstItem := FFirstItem - abs(delta); - if FFirstItem + PageLength > ItemCount then - FFirstItem := ItemCount - PageLength + 1; - if FFirstItem < 1 then - FFirstItem := 1; + if FFirstItem + PageLength > (ItemCount-1) then + FFirstItem := ItemCount - 1 - PageLength; + if FFirstItem < 0 then + FFirstItem := 0; if pfi <> FFirstItem then begin UpdateScrollBar; @@ -561,6 +585,9 @@ var n: integer; r: TfpgRect; begin + //if FUpdateCount > 0 then + //Exit; //==> + inherited HandlePaint; Canvas.ClearClipRect; @@ -591,7 +618,11 @@ begin r.Height := RowHeight; - for n := FFirstItem to ItemCount do + if ItemCount = 0 then + Exit; //==> + if FFirstItem = -1 then + FFirstItem := 0; + for n := FFirstItem to ItemCount-1 do begin if n = FFocusItem then begin @@ -661,11 +692,12 @@ begin FTextColor := Parent.TextColor; FFocusable := True; - FFocusItem := 0; - FFirstItem := 1; + FFocusItem := -1; + FFirstItem := 0; FWidth := 80; FHeight := 80; FMargin := 2; + FUpdateCount := 0; FMouseDragging := False; FPopupFrame := False; FHotTrack := False; @@ -685,10 +717,24 @@ begin inherited Destroy; end; +procedure TfpgBaseListBox.BeginUpdate; +begin + Inc(FUpdateCount); +end; + +procedure TfpgBaseListBox.EndUpdate; +begin + if FUpdateCount = 0 then + Exit; //==> + Dec(FUpdateCount); + if FUpdateCount = 0 then + Repaint; +end; + procedure TfpgBaseListBox.Update; begin - FFirstItem := 1; - FFocusItem := 1; + FFirstItem := -1; + FFocusItem := -1; UpdateScrollBar; Repaint; end; @@ -717,9 +763,9 @@ end; procedure TfpgTextListBox.DrawItem(num: integer; rect: TfpgRect; flags: integer); begin - if num < 1 then - Exit; - fpgStyle.DrawString(Canvas, rect.left+2, rect.top+1, FItems.Strings[num-1], Enabled); + //if num < 0 then + //Exit; //==> + fpgStyle.DrawString(Canvas, rect.left+2, rect.top+1, FItems.Strings[num], Enabled); end; procedure TfpgTextListBox.HandleKeyChar(var AText: TfpgChar; @@ -727,12 +773,12 @@ procedure TfpgTextListBox.HandleKeyChar(var AText: TfpgChar; var i: integer; begin - // if user press a key then it will search the stringlist for a word - // beginning with such as letter - if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) and (FFocusItem > 0) or (Length(AText) > 1 ) then - for i := FFocusItem to FItems.Count do + // If the user pressed a key then it will search the stringlist for a word + // beginning with that letter + if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) and (FFocusItem > -1) or (Length(AText) > 1 ) then + for i := FFocusItem to FItems.Count-1 do begin - if SameText(LeftStr(FItems.Strings[i-1], Length(AText)), AText) then + if SameText(LeftStr(FItems.Strings[i], Length(AText)), AText) then begin FocusItem := i; Consumed := True; @@ -746,7 +792,7 @@ constructor TfpgTextListBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FItems := TfpgListBoxStrings.Create(self); - FFocusItem := 0; + FFocusItem := -1; end; destructor TfpgTextListBox.Destroy; @@ -762,8 +808,8 @@ end; function TfpgTextListBox.Text: string; begin - if (ItemCount > 0) and (FocusItem <> 0) then - result := FItems[FocusItem-1] + if (ItemCount > 0) and (FocusItem <> -1) then + result := FItems[FocusItem] else result := ''; end; @@ -798,7 +844,7 @@ end; function TfpgBaseColorListBox.GetColor: TfpgColor; begin - Result := TColorItem(FItems.Items[FocusItem-1]).ColorValue; + Result := TColorItem(FItems.Items[FocusItem]).ColorValue; end; procedure TfpgBaseColorListBox.SetColor(const AValue: TfpgColor); @@ -806,12 +852,12 @@ var i: integer; begin if GetColor = AValue then - Exit; + Exit; //==> for i := 0 to FItems.Count-1 do begin if TColorItem(FItems.Items[i]).ColorValue = AValue then begin - FocusItem := i+1; + FocusItem := i; Exit; end; end; @@ -1022,7 +1068,7 @@ begin FItems.Add(TColorItem.Create('clYellowGreen', clYellowGreen)); end; end; - FocusItem := 1; + FocusItem := 0; FollowFocus; UpdateScrollbar; end; @@ -1036,13 +1082,13 @@ begin FItems.Clear; end; -procedure TfpgBaseColorListBox.DrawItem (num: integer; rect: TfpgRect; flags: integer ); +procedure TfpgBaseColorListBox.DrawItem(num: integer; rect: TfpgRect; flags: integer); var itm: TColorItem; begin - if num < 1 then - Exit; - itm := TColorItem(FItems.Items[num-1]); + if num < 0 then + Exit; //==> + itm := TColorItem(FItems.Items[num]); // color box Canvas.SetColor(itm.ColorValue); Canvas.FillRectangle(rect.Left + 2, rect.Top + 4, FColorBoxWidth, FColorboxHeight); @@ -1053,7 +1099,7 @@ begin fpgStyle.DrawString(Canvas, FColorboxWidth + 8 + rect.left, rect.top+1, itm.ColorName, Enabled); end; -constructor TfpgBaseColorListBox.Create (AOwner: TComponent ); +constructor TfpgBaseColorListBox.Create(AOwner: TComponent); begin inherited Create (AOwner ); FColorBoxWidth := 35; diff --git a/src/gui/gui_listview.pas b/src/gui/gui_listview.pas index 90980bff..543d61c2 100644 --- a/src/gui/gui_listview.pas +++ b/src/gui/gui_listview.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_memo.pas b/src/gui/gui_memo.pas index 4330c3f3..fc4a0f86 100644 --- a/src/gui/gui_memo.pas +++ b/src/gui/gui_memo.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -33,8 +33,6 @@ uses type - { TfpgMemo } - TfpgMemo = class(TfpgWidget) private FLines: TStringList; @@ -77,8 +75,8 @@ type function VisibleWidth: integer; procedure VScrollBarMove(Sender: TObject; position: integer); procedure HScrollBarMove(Sender: TObject; position: integer); - procedure SetText(const AValue: string); - function GetText: string; + procedure SetText(const AValue: TfpgString); + function GetText: TfpgString; procedure SetCursorLine(aValue: integer); procedure UpdateScrollBarCoords; protected @@ -102,7 +100,7 @@ type property LineHeight: integer read FLineHeight; property MaxLength: integer read FMaxLength write FMaxLength; property TabWidth: integer read FTabWidth write FTabWidth; - property Text: string read GetText write SetText; + property Text: TfpgString read GetText write SetText; property UseTabs: boolean read FUseTabs write FUseTabs default False; published property BackgroundColor default clBoxColor; @@ -192,7 +190,7 @@ var MaxLine: integer; yp: integer; begin - if (aValue < 1) or (aValue = FCursorLine) then + if (aValue < 0) or (aValue = FCursorLine) then Exit; // wrong value if aValue < FFirstLine then begin @@ -204,7 +202,7 @@ begin end; yp := 2; MaxLine := 0; - for i := FFirstLine to LineCount do + for i := FFirstLine to LineCount-1 do begin yp := yp + LineHeight; if yp > Height then @@ -274,14 +272,14 @@ begin FTabWidth := 4; FLines := TfpgMemoStrings.Create(self); - FFirstLine := 1; - FCursorLine := 1; + FFirstLine := 0; + FCursorLine := 0; FCursorPos := 0; FSelStartPos := FCursorPos; FSelEndPos := 0; - FSelStartLine := 0; - FSelEndLine := 0; + FSelStartLine := -1; + FSelEndLine := -1; FDrawOffset := 0; FMouseDragging := False; @@ -311,7 +309,7 @@ var lw: TfpgCoord; begin FLongestLineWidth := 0; - for n := 1 to LineCount do + for n := 0 to LineCount-1 do begin lw := FFont.TextWidth(getlinetext(n)); if lw > FlongestLineWidth then @@ -335,7 +333,7 @@ var len: integer; st: integer; begin - if FSelEndLine < 1 then + if FSelEndLine < 0 then Exit; if (FSelStartLine shl 16) + FSelStartPos <= (FSelEndLine shl 16) + FSelEndPos then @@ -351,6 +349,7 @@ begin selep := FSelStartPos; selsl := FSelEndLine; selsp := FSelEndPos; + end; for n := selsl to selel do @@ -378,11 +377,11 @@ begin end; for n := selsl + 1 to selel do - FLines.Delete(selsl); + FLines.Delete(n); FCursorPos := selsp; FCursorLine := selsl; - FSelEndLine := 0; + FSelEndLine := -1; end; procedure TfpgMemo.DoCopy; @@ -397,7 +396,7 @@ var st: integer; s: string; begin - if FSelEndLine < 1 then + if FSelEndLine < 0 then Exit; if (FSelStartLine shl 16) + FSelStartPos <= (FSelEndLine shl 16) + FSelEndPos then @@ -528,11 +527,11 @@ begin if FCursorline - FFirstLine + 1 > VisibleLines then FFirstLine := FCursorline - VisibleLines + 1; - if FFirstLine + VisibleLines > LineCount then + if (FFirstLine + VisibleLines) > LineCount then begin FFirstLine := LineCount - VisibleLines + 1; - if FFirstline < 1 then - FFirstLine := 1; + if FFirstline < 0 then + FFirstLine := 0; end; UpdateScrollbars; @@ -583,12 +582,12 @@ begin if FVScrollBar.Visible then begin - FVScrollBar.Min := 1; + FVScrollBar.Min := 0; // TODO: Look at calculation of vlines value to improve this! if LineCount > 0 then begin FVScrollBar.SliderSize := VisibleLines / LineCount; - FVScrollBar.Max := LineCount - VisibleLines + 1; + FVScrollBar.Max := LineCount - VisibleLines; end else begin @@ -610,10 +609,10 @@ end; function TfpgMemo.GetLineText(linenum: integer): string; begin - if LineCount < 1 then + if LineCount = 0 then FLines.Add(''); - if (linenum >= 1) and (linenum <= LineCount) then - Result := FLines.Strings[linenum - 1] + if (linenum >= 0) and (linenum < LineCount) then + Result := FLines.Strings[linenum] else Result := ''; end; @@ -627,7 +626,7 @@ end; procedure TfpgMemo.SetLineText(linenum: integer; Value: string); begin - FLines.Strings[linenum - 1] := Value; + FLines.Strings[linenum] := Value; end; function TfpgMemo.GetCursorX: integer; @@ -774,7 +773,7 @@ begin end; yp := 3; - for n := FFirstline to LineCount do + for n := FFirstline to LineCount-1 do begin ls := GetLineText(n); if FUseTabs then @@ -802,7 +801,7 @@ begin if Focused then begin // drawing selection - if (FSelEndLine > 0) and (selsl <= n) and (selel >= n) then + if (FSelEndLine > -1) and (selsl <= n) and (selel >= n) then begin if selsl < n then st := 0 @@ -863,6 +862,8 @@ begin begin if (FMaxLength <= 0) or (UTF8Length(FLines.Text) < FMaxLength) then begin + if FCursorLine < 0 then + FCursorLine := 0; DeleteSelection; ls := GetLineText(FCursorLine); UTF8Insert(s, ls, FCursorPos + 1); @@ -870,7 +871,7 @@ begin Inc(FCursorPos); FSelStartPos := FCursorPos; FSelStartLine := FCursorLine; - FSelEndLine := 0; + FSelEndLine := -1; AdjustCursor; end; @@ -897,7 +898,7 @@ var begin FSelStartLine := FCursorLine; FSelStartPos := FCursorPos; - FSelEndLine := 0; + FSelEndLine := -1; end; begin @@ -967,7 +968,7 @@ begin keyUp: begin // up cx := GetCursorX; - if FCursorLine > 1 then + if FCursorLine > 0 then begin Dec(FCursorline); SetCPByX(cx); @@ -977,7 +978,7 @@ begin keyDown: begin cx := GetCursorX; - if FCursorLine < LineCount then + if FCursorLine < (LineCount-1) then begin Inc(FCursorline); SetCPByX(cx); @@ -987,35 +988,35 @@ begin keyHome: begin if (ssCtrl in shiftstate) then - FCursorLine := 1; + FCursorLine := 0; FCursorPos := 0; end; keyEnd: begin if (ssCtrl in shiftstate) then - FCursorLine := LineCount; + FCursorLine := LineCount-1; FCursorPos := UTF8Length(CurrentLine); end; keyPageUp: - if FCursorLine > 1 then + if FCursorLine > 0 then begin cx := GetCursorX; Dec(FCursorLine, VisibleLines); - if FCursorLine < 1 then - FCursorLine := 1; + if FCursorLine < 0 then + FCursorLine := 0; SetCPByX(cx); end; keyPageDown: begin cx := GetCursorX; - if FCursorLine < LineCount then + if FCursorLine < (LineCount-1) then begin Inc(FCursorline, VisibleLines); - if FCursorLine > LineCount then - FCursorLine := LineCount; + if FCursorLine > (LineCount-1) then + FCursorLine := LineCount-1; SetCPByX(cx); end; end; @@ -1043,16 +1044,18 @@ begin consumed := True; case keycode of - keyReturn, keyPEnter: + keyReturn, + keyPEnter: begin - ls := UTF8Copy(FLines[FCursorline - 1], 1, FCursorPos); - ls2 := UTF8Copy(FLines[FCursorline - 1], FCursorPos + 1, UTF8Length(FLines[FCursorline - 1])); - FLines.Insert(FCursorLine - 1, ls); + ls := UTF8Copy(FLines[FCursorline], 1, FCursorPos); + ls2 := UTF8Copy(FLines[FCursorline], FCursorPos + 1, UTF8Length(FLines[FCursorline])); + FLines.Insert(FCursorLine, ls); Inc(FCursorLine); SetLineText(FCursorLine, ls2); FCursorPos := 0; hasChanged := True; end; + keyBackSpace: begin if FCursorPos > 0 then @@ -1062,13 +1065,13 @@ begin SetLineText(FCursorLine, ls); Dec(FCursorPos); end - else if FCursorLine > 1 then + else if FCursorLine > 0 then begin - ls := CurrentLine; - FLines.Delete(FCursorLine - 1); + ls := CurrentLine; + FLines.Delete(FCursorLine); Dec(FCursorLine); - FCursorPos := UTF8Length(FLines.Strings[FCursorLine - 1]); - FLines.Strings[FCursorLine - 1] := FLines.Strings[FCursorLine - 1] + ls; + FCursorPos := UTF8Length(FLines.Strings[FCursorLine]); + FLines.Strings[FCursorLine] := FLines.Strings[FCursorLine] + ls; end; hasChanged := True; end; @@ -1076,21 +1079,22 @@ begin keyDelete: begin ls := GetLineText(FCursorLine); - if FSelEndLine > 0 then + if FSelEndLine > -1 then DeleteSelection else if FCursorPos < UTF8Length(ls) then begin UTF8Delete(ls, FCursorPos + 1, 1); SetLineText(FCursorLine, ls); end - else if FCursorLine < LineCount then + else if FCursorLine < (LineCount-1) then begin - ls2 := FLines.Strings[FCursorLine]; + ls2 := FLines.Strings[FCursorLine+1]; FLines.Delete(FCursorLine); - FLines.Strings[FCursorLine - 1] := ls + ls2; + FLines.Strings[FCursorLine] := ls + ls2; end; hasChanged := True; end; + keyTab: begin if FUseTabs then @@ -1150,8 +1154,8 @@ begin // searching the appropriate character position lnum := FFirstLine + (y - FSideMargin) div LineHeight; - if lnum > LineCount then - lnum := LineCount; + if lnum > (LineCount-1) then + lnum := LineCount-1; ls := GetLineText(lnum); cpx := FFont.TextWidth(UTF8Copy(ls, 1, FCursorPos)) - FDrawOffset + FSideMargin; @@ -1181,7 +1185,7 @@ begin begin FSelStartLine := lnum; FSelStartPos := cp; - FSelEndLine := 0; + FSelEndLine := -1; end; Repaint; end; @@ -1203,8 +1207,8 @@ begin // searching the appropriate character position lnum := FFirstLine + (y - FSideMargin) div LineHeight; - if lnum > LineCount then - lnum := LineCount; + if lnum > LineCount-1 then + lnum := LineCount-1; ls := GetLineText(lnum); cpx := FFont.TextWidth(UTF8Copy(ls, 1, FCursorPos)) - FDrawOffset + FSideMargin; @@ -1326,10 +1330,10 @@ begin else inc(FFirstLine, abs(delta)); // scroll down - if FFirstLine > LineCount - VisibleLines + 1 then - FFirstLine := LineCount - VisibleLines + 1; - if FFirstLine < 1 then - FFirstLine := 1; + if FFirstLine > LineCount - VisibleLines{ + 1} then + FFirstLine := LineCount - VisibleLines {+ 1}; + if FFirstLine < 0 then + FFirstLine := 0; if FHScrollBar.Visible then begin @@ -1365,26 +1369,26 @@ begin Result := ''; end; -function TfpgMemo.GetText: string; +function TfpgMemo.GetText: TfpgString; var n: integer; - s: string; + s: TfpgString; begin s := ''; - for n := 1 to LineCount do + for n := 0 to LineCount-1 do begin - if n > 1 then + if n > 0 then s := s + #13#10; s := s + GetLineText(n); end; Result := s; end; -procedure TfpgMemo.SetText(const AValue: string); +procedure TfpgMemo.SetText(const AValue: TfpgString); var n: integer; - c: string[2]; - s: string; + c: TfpgChar; + s: TfpgString; begin FLines.Clear; s := ''; @@ -1410,10 +1414,10 @@ begin FDrawOffset := 0; FCursorPos := 0; - FCursorLine := 1; + FCursorLine := 0; FSelStartLine := FCursorLine; FSelStartPos := FCursorPos; - FSelEndLine := 0; + FSelEndLine := -1; AdjustCursor; Repaint; diff --git a/src/gui/gui_menu.pas b/src/gui/gui_menu.pas index bd6f10a2..3242685c 100644 --- a/src/gui/gui_menu.pas +++ b/src/gui/gui_menu.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -62,12 +62,12 @@ type FOnClick: TNotifyEvent; FSeparator: boolean; FSubMenu: TfpgPopupMenu; - FText: string; + FText: TfpgString; FVisible: boolean; procedure SetEnabled(const AValue: boolean); procedure SetHotKeyDef(const AValue: TfpgHotKeyDef); procedure SetSeparator(const AValue: boolean); - procedure SetText(const AValue: string); + procedure SetText(const AValue: TfpgString); procedure SetVisible(const AValue: boolean); public constructor Create(AOwner: TComponent); override; @@ -77,7 +77,7 @@ type procedure DrawText(ACanvas: TfpgCanvas; x, y: TfpgCoord); function GetCommand: ICommand; procedure SetCommand(ACommand: ICommand); - property Text: string read FText write SetText; + property Text: TfpgString read FText write SetText; property HotKeyDef: TfpgHotKeyDef read FHotKeyDef write SetHotKeyDef; property Separator: boolean read FSeparator write SetSeparator; property Visible: boolean read FVisible write SetVisible; @@ -128,8 +128,8 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Close; override; - function AddMenuItem(const AMenuName: string; const hotkeydef: string; HandlerProc: TNotifyEvent): TfpgMenuItem; - function MenuItemByName(const AMenuName: string): TfpgMenuItem; + function AddMenuItem(const AMenuName: TfpgString; const hotkeydef: string; HandlerProc: TNotifyEvent): TfpgMenuItem; + function MenuItemByName(const AMenuName: TfpgString): TfpgMenuItem; function MenuItem(const AMenuPos: integer): TfpgMenuItem; // added to allow for localization property BeforeShow: TNotifyEvent read FBeforeShow write FBeforeShow; end; @@ -176,7 +176,9 @@ type property BeforeShow: TNotifyEvent read FBeforeShow write FBeforeShow; end; -function CreateMenuBar(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgMenuBar; + +function CreateMenuBar(AOwner: TfpgWidget; x, y, w, h: TfpgCoord): TfpgMenuBar; overload; +function CreateMenuBar(AOwner: TfpgWidget): TfpgMenuBar; overload; implementation @@ -184,23 +186,34 @@ implementation var uFocusedPopupMenu: TfpgPopupMenu; -function CreateMenuBar(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgMenuBar; +function CreateMenuBar(AOwner: TfpgWidget; x, y, w, h: TfpgCoord): TfpgMenuBar; begin + if AOwner = nil then + raise Exception.Create('MenuBar component must have an Owner assigned'); Result := TfpgMenuBar.Create(AOwner); Result.Left := x; Result.Top := y; - Result.Width := w; + if w = 0 then + Result.Width := AOwner.Width + else + Result.Width := w; if h > 0 then Result.Height := h; end; +function CreateMenuBar(AOwner: TfpgWidget): TfpgMenuBar; +begin + Result := CreateMenuBar(AOwner, 0, 0, 0, 0); +end; + { TfpgMenuItem } -procedure TfpgMenuItem.SetText(const AValue: string); +procedure TfpgMenuItem.SetText(const AValue: TfpgString); begin - if FText=AValue then exit; - FText:=AValue; + if FText = AValue then + Exit; //==> + FText := AValue; end; procedure TfpgMenuItem.SetVisible(const AValue: boolean); @@ -358,10 +371,10 @@ end; function TfpgMenuBar.VisibleItem(ind: integer): TfpgMenuItem; begin - if (ind < 1) or (ind > FItems.Count) then + if (ind < 0) or (ind > FItems.Count-1) then Result := nil else - Result := TfpgMenuItem(FItems.Items[ind-1]); + Result := TfpgMenuItem(FItems.Items[ind]); end; procedure TfpgMenuBar.HandleShow; @@ -488,7 +501,7 @@ begin Canvas.SetColor(clHilite1); Canvas.DrawLine(r.Left, r.Bottom, r.Right+1, r.Bottom); // bottom - for n := 1 to VisibleCount do + for n := 0 to VisibleCount-1 do DrawColumn(n, n = FocusItem); Canvas.EndDraw; end; @@ -498,8 +511,8 @@ begin inherited Create(AOwner); FItems := TList.Create; FBeforeShow := nil; - FFocusItem := 0; - FPrevFocusItem := 0; + FFocusItem := -1; + FPrevFocusItem := -1; FFocusable := False; FBackgroundColor := Parent.BackgroundColor; FTextColor := Parent.TextColor; @@ -520,7 +533,7 @@ end; function TfpgMenuBar.ItemWidth(mi: TfpgMenuItem): integer; begin - Result := fpgStyle.MenuFont.TextWidth(mi.Text) + 2*6; + Result := fpgStyle.MenuFont.TextWidth(mi.Text) + (2*6); end; procedure TfpgMenuBar.DrawColumn(col: integer; focus: boolean); @@ -532,7 +545,7 @@ begin Canvas.BeginDraw; r.SetRect(2, 1, 1, fpgStyle.MenuFont.Height+1); - for n := 1 to VisibleCount do + for n := 0 to VisibleCount-1 do begin mi := VisibleItem(n); r.width := ItemWidth(mi); @@ -579,10 +592,10 @@ var w: integer; n: integer; begin - Result := 1; + Result := 0; w := 0; - n := 1; - while (w <= x) and (n <= VisibleCount) do + n := 0; + while (w <= x) and (n < VisibleCount) do begin Result := n; inc(w, ItemWidth(VisibleItem(n))); @@ -595,10 +608,10 @@ var n: integer; begin Result := 0; - if index < 1 then + if index < 0 then Exit; //==> - n := 1; - while (n <= VisibleCount) and (n < index) do + n := 0; + while (n < VisibleCount) and (n < index) do begin Inc(result, ItemWidth(VisibleItem(n))); inc(n); @@ -617,11 +630,10 @@ begin ActivateMenu; // showing the submenu mi.SubMenu.ShowAt(self, GetItemPosX(FocusItem)+2, fpgStyle.MenuFont.Height+4); - mi.SubMenu.OpenerPopup := nil; - mi.SubMenu.OpenerMenuBar := self; - mi.SubMenu.DontCloseWidget := self; - - uFocusedPopupMenu := mi.SubMenu; + mi.SubMenu.OpenerPopup := nil; + mi.SubMenu.OpenerMenuBar := self; + mi.SubMenu.DontCloseWidget := self; + uFocusedPopupMenu := mi.SubMenu; RePaint; end else @@ -636,7 +648,7 @@ var n: integer; begin // Close all previous popups - for n := 1 to VisibleCount do + for n := 0 to VisibleCount-1 do with VisibleItem(n) do begin if (SubMenu <> nil) and (SubMenu.HasHandle) then @@ -650,7 +662,7 @@ var mi: TfpgMenuItem; begin Result := True; - for n := 1 to VisibleCount do + for n := 0 to VisibleCount-1 do begin mi := VisibleItem(n); if (mi.SubMenu <> nil) and (mi.SubMenu.HasHandle) then @@ -666,7 +678,7 @@ var n: integer; begin Result := -1; - for n := 1 to VisibleCount do + for n := 0 to VisibleCount-1 do begin with VisibleItem(n) do begin @@ -745,7 +757,7 @@ var n: integer; begin // Close all previous popups - for n := 1 to VisibleCount do + for n := 0 to VisibleCount-1 do with VisibleItem(n) do begin if (SubMenu <> nil) and (SubMenu.HasHandle) then @@ -758,10 +770,10 @@ var n: integer; begin Result := 2; - if index < 1 then + if index < 0 then Exit; //==> - n := 1; - while (n <= VisibleCount) and (n < index) do + n := 0; + while (n < VisibleCount) and (n < index) do begin Inc(Result, ItemHeight(VisibleItem(n))); inc(n); @@ -778,7 +790,7 @@ begin Exit; //==> newf := CalcMouseRow(y); - if newf < 1 then + if newf < 0 then Exit; //==> if newf = FFocusItem then @@ -797,9 +809,8 @@ begin r.SetRect(0, 0, Width, Height); if not PtInRect(r, Point(x, y)) then begin -// writeln('Pointer out of bounds.'); ClosePopups; - Exit; + Exit; //==> end; end; @@ -812,7 +823,7 @@ begin inherited HandleLMouseUp(x, y, shiftstate); newf := CalcMouseRow(y); - if newf < 1 then + if newf < 0 then Exit; if not VisibleItem(newf).Selectable then @@ -853,69 +864,75 @@ begin consumed := true; case keycode of keyUp: - begin // up - trycnt := 2; - i := FFocusItem-1; - repeat - while (i >= 1) and not VisibleItem(i).Selectable do dec(i); - - if i >= 1 then break; - - i := VisibleCount; - dec(trycnt); - until trycnt > 0; - - if i >= 1 then FFocusItem := i; - end; + begin // up + trycnt := 2; + i := FFocusItem-1; + repeat + while (i >= 0) and not VisibleItem(i).Selectable do + dec(i); + + if i >= 0 then + break; //==> + + i := VisibleCount-1; + dec(trycnt); + until trycnt > 0; + + if i >= 0 then + FFocusItem := i; + end; + keyDown: - begin // down - - trycnt := 2; - i := FFocusItem+1; - repeat - while (i <= VisibleCount) and not VisibleItem(i).Selectable do inc(i); - - if i <= VisibleCount then break; - - i := 1; - dec(trycnt); - until trycnt > 0; - - if i <= VisibleCount then FFocusItem := i; - - end; + begin // down + trycnt := 2; + i := FFocusItem+1; + repeat + while (i < VisibleCount) and not VisibleItem(i).Selectable do + inc(i); + if i < VisibleCount then + Break; //==> + i := 0; + dec(trycnt); + until trycnt > 0; + + if i < VisibleCount then + FFocusItem := i; + end; + keyReturn: - begin - DoSelect; - end; + begin + DoSelect; + end; keyLeft: - begin - if OpenerMenubar <> nil then OpenerMenubar.HandleKeyPress(keycode, shiftstate, consumed); - end; + begin + if OpenerMenubar <> nil then + OpenerMenubar.HandleKeyPress(keycode, shiftstate, consumed); + end; keyRight: - begin - if OpenerMenubar <> nil then OpenerMenubar.HandleKeyPress(keycode, shiftstate, consumed); - // VisibleItem(FFocusItem).SubMenu <> nil then DoSelect; - end; + begin + if OpenerMenubar <> nil then + OpenerMenubar.HandleKeyPress(keycode, shiftstate, consumed); + // VisibleItem(FFocusItem).SubMenu <> nil then DoSelect; + end; keyBackSpace: - begin - //if self.OpenerPopup <> nil then - Close; - end; + begin + //if self.OpenerPopup <> nil then + Close; + end; keyEscape: - begin - Close; - op := OpenerPopup; - while op <> nil do - begin - op.Close; - op := op.OpenerPopup; - end; - end; + begin + Close; + op := OpenerPopup; + while op <> nil do + begin + op.Close; + op := op.OpenerPopup; + end; + end; else consumed := false; end; @@ -927,7 +944,7 @@ begin // normal char s := chr(keycode and $00FF) + chr((keycode and $FF00) shr 8); i := SearchItemByAccel(s); - if i > 0 then + if i >= 0 then begin FFocusItem := i; FollowFocus; @@ -948,7 +965,7 @@ begin Canvas.DrawRectangle(0, 0, Width, Height); // black rectangle border Canvas.DrawButtonFace(1, 1, Width-1, Height-1, []); // 3d rectangle inside black border - for n := 1 to VisibleCount do + for n := 0 to VisibleCount-1 do DrawRow(n, n = FFocusItem); Canvas.EndDraw; @@ -956,7 +973,6 @@ end; procedure TfpgPopupMenu.HandleShow; begin -// CaptureMouse; PrepareToShow; inherited HandleShow; end; @@ -966,7 +982,6 @@ begin {$IFDEF DEBUG} writeln(Classname, '.HandleClose'); {$ENDIF} -// ReleaseMouse; inherited HandleClose; end; @@ -977,10 +992,10 @@ end; function TfpgPopupMenu.VisibleItem(ind: integer): TfpgMenuItem; begin - if (ind < 1) or (ind > FItems.Count) then + if (ind < 0) or (ind > FItems.Count-1) then Result := nil else - Result := TfpgMenuItem(FItems.Items[ind-1]); + Result := TfpgMenuItem(FItems.Items[ind]); end; procedure TfpgPopupMenu.DrawItem(mi: TfpgMenuItem; rect: TfpgRect); @@ -1028,7 +1043,7 @@ begin Canvas.BeginDraw; r.SetRect(FMargin, FMargin, FWidth-(2*FMargin), FHeight-(2*FMargin)); - for n := 1 to VisibleCount do + for n := 0 to VisibleCount-1 do begin mi := VisibleItem(n); @@ -1092,7 +1107,7 @@ var n: integer; begin result := -1; - for n := 1 to VisibleCount do + for n := 0 to VisibleCount-1 do begin with VisibleItem(n) do begin @@ -1111,7 +1126,6 @@ begin {$IFDEF DEBUG} writeln(Classname, '.HandleMouseEnter'); {$ENDIF} -// CaptureMouse; inherited HandleMouseEnter; end; @@ -1121,9 +1135,8 @@ begin writeln(Classname, '.HandleMouseExit'); {$ENDIF} inherited HandleMouseExit; - FFocusItem := 0; + FFocusItem := -1; Repaint; -// ReleaseMouse; end; // Collecting visible items and measuring sizes @@ -1157,7 +1170,7 @@ begin tw := 0; // text width hkw := 0; // hotkey width FSymbolWidth := 0; - for n := 1 to VisibleCount do + for n := 0 to VisibleCount-1 do begin mi := VisibleItem(n); x := ItemHeight(mi); @@ -1193,12 +1206,12 @@ begin Result := n; // sanity check - if y < 1 then + if y < 0 then Exit else - n := 1; + n := 0; - while (h <= y) and (n <= VisibleCount) do + while (h <= y) and (n < VisibleCount) do begin Result := n; inc(h, ItemHeight(VisibleItem(n))); @@ -1220,7 +1233,7 @@ begin FSymbolWidth := FMenuFont.Height+2; FBeforeShow := nil; - FFocusItem := 0; + FFocusItem := -1; OpenerPopup := nil; OpenerMenubar := nil; end; @@ -1230,7 +1243,6 @@ begin {$IFDEF DEBUG} writeln(Classname, '.Destroy'); {$ENDIF} -// ReleaseMouse; FItems.Free; inherited Destroy; end; @@ -1267,7 +1279,7 @@ begin end; end; -function TfpgPopupMenu.AddMenuItem(const AMenuName: string; +function TfpgPopupMenu.AddMenuItem(const AMenuName: TfpgString; const hotkeydef: string; HandlerProc: TNotifyEvent): TfpgMenuItem; begin result := TfpgMenuItem.Create(self); @@ -1283,7 +1295,7 @@ begin end; end; -function TfpgPopupMenu.MenuItemByName(const AMenuName: string): TfpgMenuItem; +function TfpgPopupMenu.MenuItemByName(const AMenuName: TfpgString): TfpgMenuItem; var i: integer; begin diff --git a/src/gui/gui_mru.pas b/src/gui/gui_mru.pas index b4523ba9..1c97dc58 100644 --- a/src/gui/gui_mru.pas +++ b/src/gui/gui_mru.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_panel.pas b/src/gui/gui_panel.pas index 94b83b35..463aaa32 100644 --- a/src/gui/gui_panel.pas +++ b/src/gui/gui_panel.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -51,6 +51,7 @@ type public constructor Create(AOwner: TComponent); override; end; + TfpgBevel = class(TfpgAbstractPanel) private @@ -65,6 +66,7 @@ type property OnClick; property OnDoubleClick; end; + TfpgPanel = class(TfpgAbstractPanel) private @@ -109,6 +111,7 @@ type property OnClick; property OnDoubleClick; end; + TfpgGroupBox = class(TfpgAbstractPanel) private diff --git a/src/gui/gui_popupcalendar.pas b/src/gui/gui_popupcalendar.pas index 1fcfb44b..51f11d28 100644 --- a/src/gui/gui_popupcalendar.pas +++ b/src/gui/gui_popupcalendar.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -54,8 +54,6 @@ type TfpgOnDateSetEvent = procedure(Sender: TObject; const ADate: TDateTime) of object; - { TfpgPopupCalendar } - TfpgPopupCalendar = class(TfpgPopupWindow) private FMonthOffset: integer; @@ -78,7 +76,7 @@ type function GetDateElement(Index: integer): Word; procedure PopulateDays; procedure CalculateMonthOffset; - function CalculateCellDay(const ACol, ARow: LongWord): Word; + function CalculateCellDay(const ACol, ARow: Integer): Integer; procedure SetDateElement(Index: integer; const AValue: Word); procedure SetDateValue(const AValue: TDateTime); procedure SetMaxDate(const AValue: TDateTime); @@ -115,8 +113,6 @@ type end; - { TfpgCalendarCombo } - TfpgCalendarCombo = class(TfpgAbstractComboBox) private FDate: TDateTime; @@ -166,18 +162,18 @@ uses procedure TfpgPopupCalendar.PopulateDays; var r, c: integer; - lCellDay: Word; + lCellDay: Integer; begin grdName1.BeginUpdate; - for r := 0 to 6 do - for c := 1 to 7 do + for r := -1 to 5 do + for c := 0 to 6 do begin - if r = 0 then - grdName1.ColumnTitle[c] := ShortDayNames[c] + if r = -1 then + grdName1.ColumnTitle[c] := ShortDayNames[c+1] // ShortDayNames is 1-based indexing else begin lCellDay := CalculateCellDay(c, r); - if lCellDay = 0 then + if lCellDay = -1 then grdName1.Cells[c, r] := '' else grdName1.Cells[c, r] := IntToStr(lCellDay); @@ -246,11 +242,11 @@ begin FMonthOffset := 2 - DayOfWeek(lTheFirst); end; -function TfpgPopupCalendar.CalculateCellDay(const ACol, ARow: LongWord): Word; +function TfpgPopupCalendar.CalculateCellDay(const ACol, ARow: Integer): Integer; begin - Result := FMonthOffset + (ACol-1) + (ARow-1) * 7; + Result := FMonthOffset + ACol + ARow * 7; if (Result < 1) or (Result > MonthDays[IsLeapYear(Year), Month]) then - Result := 0; + Result := -1; end; procedure TfpgPopupCalendar.SetDateElement(Index: integer; const AValue: Word); @@ -352,8 +348,8 @@ begin edtMonth.Text := LongMonthNames[Month]; DecodeDate(FDate, lY, lM, lD); - grdName1.FocusCol := (lD - FMonthOffset) mod 7 + 1; - grdName1.FocusRow := (lD - FMonthOffset) div 7 + 1; + grdName1.FocusCol := (lD - FMonthOffset) mod 7{ + 1}; + grdName1.FocusRow := (lD - FMonthOffset) div 7{ + 1}; end; end; @@ -634,16 +630,17 @@ begin end; {@VFD_BODY_END: fpgPopupCalendar} - +{ // Setup localization // UI Designer doesn't support resource strings yet! - grdName1.ColumnTitle[1] := rsShortSun; - grdName1.ColumnTitle[2] := rsShortMon; - grdName1.ColumnTitle[3] := rsShortTue; - grdName1.ColumnTitle[4] := rsShortWed; - grdName1.ColumnTitle[5] := rsShortThu; - grdName1.ColumnTitle[6] := rsShortFri; - grdName1.ColumnTitle[7] := rsShortSat; + grdName1.ColumnTitle[0] := rsShortSun; + grdName1.ColumnTitle[1] := rsShortMon; + grdName1.ColumnTitle[2] := rsShortTue; + grdName1.ColumnTitle[3] := rsShortWed; + grdName1.ColumnTitle[4] := rsShortThu; + grdName1.ColumnTitle[5] := rsShortFri; + grdName1.ColumnTitle[6] := rsShortSat; +} btnToday.Text := rsToday; end; @@ -771,7 +768,7 @@ begin FDropDown := TfpgPopupCalendar.Create(nil, FocusRootWidget); ddw := TfpgPopupCalendar(FDropDown); ddw.DontCloseWidget := self; - { Set to false CloseOnSelect to leave opened popup calendar menu} + { Set to false CloseOnSelect to leave opened popup calendar menu } ddw.CloseOnSelect := CloseOnSelect; ddw.CallerWidget := self; @@ -782,8 +779,8 @@ begin ddw.MaxDate := FMaxDate; ddw.DateValue := FDate; ddw.ShowAt(Parent, Left, Top+Height); -{ I added this call to UpdateCalendar because sometimes after btnTodayClicked event, - reopeing the dropdown menu gave an empty calendar} + { I added this call to UpdateCalendar because sometimes after + btnTodayClicked event, reopeing the dropdown menu gave an empty calendar } ddw.UpdateCalendar; //slapshot ddw.PopupFrame := True; ddw.OnValueSet := @InternalOnValueSet; diff --git a/src/gui/gui_progressbar.pas b/src/gui/gui_progressbar.pas index 8b9d4612..d6d25b60 100644 --- a/src/gui/gui_progressbar.pas +++ b/src/gui/gui_progressbar.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -49,7 +49,7 @@ type property Position: longint read FPosition write SetPBPosition default 0; property Step: longint read FStep write SetStep; // property FontName: string read GetFontName write SetFontName; - property ShowCaption: boolean read FShowCaption write SetShowCaption; + property ShowCaption: boolean read FShowCaption write SetShowCaption default False; public constructor Create(AOwner: TComponent); override; procedure StepIt; diff --git a/src/gui/gui_radiobutton.pas b/src/gui/gui_radiobutton.pas index 0ca1a11e..cf49365e 100644 --- a/src/gui/gui_radiobutton.pas +++ b/src/gui/gui_radiobutton.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_scrollbar.pas b/src/gui/gui_scrollbar.pas index 86f6a77f..2668f659 100644 --- a/src/gui/gui_scrollbar.pas +++ b/src/gui/gui_scrollbar.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_style.pas b/src/gui/gui_style.pas index bdc7979e..9cd32df2 100644 --- a/src/gui/gui_style.pas +++ b/src/gui/gui_style.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_tab.pas b/src/gui/gui_tab.pas index a405d349..52bd8885 100644 --- a/src/gui/gui_tab.pas +++ b/src/gui/gui_tab.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_trackbar.pas b/src/gui/gui_trackbar.pas index fdb7697d..a4a82d69 100644 --- a/src/gui/gui_trackbar.pas +++ b/src/gui/gui_trackbar.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/gui_tree.pas b/src/gui/gui_tree.pas index c52914bc..64bf6718 100644 --- a/src/gui/gui_tree.pas +++ b/src/gui/gui_tree.pas @@ -1,5 +1,5 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. diff --git a/src/gui/promptuserdialog.inc b/src/gui/promptuserdialog.inc index 9c5e5d0f..14124d54 100644 --- a/src/gui/promptuserdialog.inc +++ b/src/gui/promptuserdialog.inc @@ -3,8 +3,6 @@ {$IFDEF read_interface} -{ TfpgPromptUserDialog } - TfpgPromptUserDialog = class(TfpgBaseDialog) private lblTitle: TfpgLabel; |