unit Utils; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Graphics, Controls, StdCtrls, ComCtrls, Dialogs, Forms, Globals; type TToolbarPosition = (tpTop, tpLeft, tpRight); procedure InitForm(AForm: TForm); procedure AddButtonToToolbar(AToolButton: TToolButton; AToolBar: TToolBar); procedure InitToolbar(AToolbar: TToolbar; APosition: TToolbarPosition); function AnySelected(AListbox: TListBox): Boolean; procedure ErrorMsg(const AMsg: String); procedure ErrorMsg(const AMsg: String; const AParams: array of const); procedure Exchange(var a, b: Double); overload; procedure Exchange(var a, b: Integer); overload; procedure Exchange(var a, b: String); overload; procedure SortOnX(X: DblDyneVec; Y: DblDyneVec = nil; Z: DblDyneVec = nil); procedure SortOnX(X: DblDyneVec; Y: DblDyneMat); procedure QuickSortOnX(X: DblDyneVec; Y: DblDyneVec = nil; Z: DblDyneVec = nil); // not 100% tested... function CenterString(S: String; Width: Integer): String; function IndexOfString(L: StrDyneVec; s: String): Integer; implementation uses StrUtils, Math, ToolWin; // https://stackoverflow.com/questions/4093595/create-ttoolbutton-runtime procedure AddButtonToToolbar(AToolButton: TToolButton; AToolBar: TToolBar); var lastBtnIdx: integer; begin lastBtnIdx := AToolBar.ButtonCount - 1; if lastBtnIdx > -1 then AToolButton.Left := AToolBar.Buttons[lastBtnIdx].Left + AToolBar.Buttons[lastBtnIdx].Width else AToolButton.Left := 0; AToolButton.Parent := AToolBar; end; procedure InitForm(AForm: TForm); begin AForm.Width := AForm.Scale96ToFont(DEFAULT_WIDTH); AForm.Height := AForm.Scale96ToFont(DEFAULT_HEIGHT); end; procedure InitToolbar(AToolbar: TToolbar; APosition: TToolbarPosition); begin // AToolbar.Transparent := false; // AToolbar.Color := clForm; case APosition of tpTop: begin AToolbar.Align := alTop; AToolbar.EdgeBorders := [ebBottom]; end; tpLeft: begin AToolbar.Align := alLeft; AToolbar.EdgeBorders := [ebRight]; end; tpRight: begin AToolbar.Align := alRight; AToolbar.EdgeBorders := [ebLeft]; end; end; end; function AnySelected(AListBox: TListBox): Boolean; var i: Integer; begin Result := false; for i := 0 to AListbox.Items.Count-1 do if AListbox.Selected[i] then begin Result := true; exit; end; end; procedure ErrorMsg(const AMsg: String); begin MessageDlg(AMsg, mtError, [mbOK], 0); end; procedure ErrorMsg(const AMsg: String; const AParams: array of const); begin ErrorMsg(Format(AMsg, AParams)); end; procedure Exchange(var a, b: Double); var tmp: Double; begin tmp := a; a := b; b := tmp; end; procedure Exchange(var a, b: Integer); var tmp: Integer; begin tmp := a; a := b; b := tmp; end; procedure Exchange(var a, b: String); var tmp: String; begin tmp := a; a := b; b := tmp; end; procedure SortOnX(X: DblDyneVec; Y: DblDyneVec = nil; Z: DblDyneVec = nil); var i, j, N: Integer; begin N := Length(X); if (Y <> nil) and (N <> Length(Y)) then raise Exception.Create('[SortOnX] Arrays must have the same length.'); if (Z <> nil) and (N <> Length(Z)) then raise Exception.Create('[SortOnX] Arrays must have the same length.'); for i := 0 to N - 2 do begin for j := i + 1 to N - 1 do begin if X[i] > X[j] then //swap begin Exchange(X[i], X[j]); if Y <> nil then Exchange(Y[i], Y[j]); if Z <> nil then Exchange(Z[i], Z[j]); end; end; end; end; // NOTE: The matrix Y is transposed relative to the typical usage in LazStats procedure SortOnX(X: DblDyneVec; Y: DblDyneMat); var i, j, k, N, Ny: Integer; begin N := Length(X); if N <> Length(Y[0]) then raise Exception.Create('[SortOnX] Arrays X and Y (2nd index) must have the same length'); Ny := Length(Y); for i := 0 to N-2 do begin for j := i+1 to N-1 do if X[i] > X[j] then begin Exchange(X[i], X[j]); for k := 0 to Ny-1 do Exchange(Y[k, i], Y[k, j]); end; end; end; procedure QuickSortOnX(X: DblDyneVec; Y: DblDyneVec = nil; Z: DblDyneVec = nil); procedure DoQuickSort(L, R: Integer); var I,J: Integer; P: Integer; begin repeat I := L; J := R; P := (L+R) div 2; repeat while CompareValue(X[P], X[I]) > 0 do inc(I); while CompareValue(X[P], X[J]) < 0 do dec(J); if I <= J then begin if I <> J then begin Exchange(X[I], X[J]); if Y <> nil then Exchange(Y[I], Y[J]); if Z <> nil then Exchange(Z[I], Z[J]); end; if P = I then P := J else if P = J then P := I; inc(I); dec(J); end; until I > J; if L < J then DoQuickSort(L, J); L := I; until I >= R; end; begin DoQuickSort(0, High(X)); end; function CenterString(S: String; Width: Integer): String; var n1, n2: Integer; begin n1 := Width - Length(S); if n1 <= 0 then begin Result := S; exit; end; n1 := n1 div 2; if Length(S) + 2*n1 < Width then n2 := n1+1 else n2 := n1; Result := DupeString(' ', n1) + S + DupeString(' ', n2); end; function IndexOfString(L: StrDyneVec; s: String): Integer; var i: Integer; begin Result := -1; for i := 0 to High(L) do if L[i] = s then begin Result := i; exit; end; end; end.