MiTec/Common/MiTeC_Helpers.pas

{*******************************************************}
{               MiTeC TStrings helper                   }
{                                                       }
{          Copyright (c) 1997-2016 Michal Mutl          }
{                                                       }
{*******************************************************}

{$INCLUDE Compilers.inc}

unit MiTeC_Helpers;

interface

uses {$IFDEF RAD9PLUS}
     System.Variants, System.SysUtils, System.Classes, WinAPI.Windows, System.Win.Registry,
     System.Generics.Collections, Vcl.Controls, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.CheckLst, Vcl.Forms, Vcl.ExtCtrls,
     WinApi.Messages;
     {$ELSE}
     Variants, SysUtils, Classes, Windows, Registry, Controls, ComCtrls, StdCtrls, CheckLst, Forms, ExtCtrls,
     Messages;
     {$ENDIF}

{$IFDEF RAD5PLUS}
type
  TStringsHelper = class helper for TStrings
  public
    function IndexOfNameEx(const Name: string; Idx: Integer): Integer; inline;
    function IndexOfEx(const S: string; Idx: Integer): Integer; inline;

    function TrimIndexOf(const AString: string): Integer; overload; inline;
    function TrimIndexOf(const AString: string; Idx: Integer): Integer; overload; inline;
    {case sensitive version of indexof}
    function CaseIndexOf(const AString: string): Integer; overload; inline;
    function CaseIndexOf(const AString: string; Idx: Integer): Integer; overload; inline;
    {like as caseindexof but can search substring}
    function IndexOfSubString(const SubString: string): Integer; overload; inline;
    {like as caseindexof but can search substring on next occurence}
    function IndexOfSubString(const SubString: string; Idx: Integer): Integer; overload; inline;
    function IndexOfValue(const ValueString: string): Integer; overload; inline;

    procedure CopyLines(ASource: TStrings; ACount: integer); overload; inline;
    procedure DeleteLines(ACount: integer); overload; inline;

    function LastItem: string; overload; inline;
  end;

  TRegistryHelper = class helper for TRegistry
  public
    function ReadDWORD(const Name: string): Cardinal;
  end;

  TListViewHelper = class helper for TListView
  public
    function GetCheckedCount: Integer;
    procedure CheckAll(AState: boolean);
    procedure ToggleCheckAll;
  end;

  TWinControlHelper = class helper for TWinControl
  public
    procedure EnableControls(AEnable: Boolean);
    procedure ShowControls(AVisible: Boolean);
  end;

  TFormHelper = class helper for TForm
  private
    function GetCaptionVisible: Boolean;
    procedure SetCaptionVisible(const Value: Boolean);
  public
    property CaptionVisible: Boolean read GetCaptionVisible write SetCaptionVisible;
  end;

  TCustomEditHelper = class helper for TCustomEdit
  private
    function GetTrimText: string;
    function GetHasText: Boolean;
    function GetIsEmpty: Boolean;
  public
    property TrimmedText: string read GetTrimText;
    property HasText: Boolean read GetHasText;
    property IsEmpty: Boolean read GetIsEmpty;
  end;

  TComboBoxHelper = class helper for TComboBox
  public
    procedure AddMRU(AText: string);
  end;

  TCheckListBoxHelper = class helper for TCheckListBox
  private
    function GetCheckedCount: Integer;
  public
    procedure SetAll(AChecked: Boolean);
    procedure ExclusiveCheck(AIndex: Integer);
    function GetCheckedIndex(AStartIndex: Integer = 0): Integer;
    property CheckedCount: Integer read GetCheckedCount;
  end;

  TRadioGroupHelper = class helper for TRadioGroup
  public
    procedure SetSilentItemIndex(AIndex: integer);
  end;

  TMemoHelper = class helper for TMemo
  public
    procedure GetPosition(out ACaret: TPoint);
    procedure SetPosition(ALine: integer; AColumn: integer = 0);
  end;


{$ENDIF}

function RectHeight(ARect: TRect): Integer;
function RectWidth(ARect: TRect): Integer;

implementation

uses {$IFDEF RAD9PLUS}
     System.RTLConsts,
     {$ELSE}
     RTLConsts,
     {$ENDIF}
     MiTeC_StrUtils;

function RectHeight;
begin
  Result:=ARect.Bottom-ARect.Top;
end;

function RectWidth;
begin
  Result:=ARect.Right-ARect.Left;
end;


{$IFDEF RAD5PLUS}

{ TStringsHelper }

function TStringsHelper.IndexOfEx(const S: string; Idx: Integer): Integer;
begin
  for Result := Idx to GetCount - 1 do
    if CompareStrings(Get(Result), S) = 0 then Exit;
  Result := -1;
end;

function TStringsHelper.IndexOfNameEx(const Name: string;
  Idx: Integer): Integer;
var
  P: Integer;
  S: string;
begin
  for Result := Idx to GetCount - 1 do
  begin
    S := Get(Result);
    P := AnsiPos(NameValueSeparator, S);
    if (P <> 0) and (CompareStrings(Copy(S, 1, P - 1), Name) = 0) then Exit;
  end;
  Result := -1;
end;

function TStringsHelper.TrimIndexOf(const AString: string;
 Idx: Integer): Integer;
var
  i: Integer;
begin
  if (Count > 0) and (Idx <= (Count - 1)) then
    for i:=Idx to Count - 1 do
      if SameText(AString, TrimAll(Strings[i])) then
        begin
          Result:=i;
          Exit;
        end;
  Result:=-1;
end;

function TStringsHelper.TrimIndexOf(const AString: string): Integer;
begin
  Result:=TrimIndexOf(AString, 0);
end;

function TStringsHelper.CaseIndexOf(const AString: string): Integer;
begin
  Result:=CaseIndexOf(AString, 0);
end;

function TStringsHelper.CaseIndexOf(const AString: string;
 Idx: Integer): Integer;
var
  i: Integer;
begin
  if (Count > 0) and (Idx <= (Count - 1)) then
    for i:=Idx to Count - 1 do
      if AnsiCompareStr(AString, Strings[i]) = 0 then
        begin
          Result:=i;
          Exit;
        end;
  Result:=-1;
end;

function TStringsHelper.IndexOfSubString(const SubString: string): Integer;
begin
  Result:=IndexOfSubString(SubString, 0);
end;

function TStringsHelper.IndexOfSubString(const SubString: string;
   Idx: Integer): Integer;
var
  i: integer;
begin
  if (Count > 0) and (Idx <= (Count - 1)) then
    for i:=Idx to Count - 1 do
      if Pos(Uppercase(SubString), Uppercase(Strings[i])) > 0 then
        begin
          Result:=i;
          Exit;
        end;
  Result:=-1;
end;

function TStringsHelper.IndexOfValue(const ValueString: string): Integer;
var
  i: Integer;
begin
  Result:=-1;
  for i:=0 to Count-1 do
    if SameText(ValueString,ValueFromIndex[i]) then begin
      Result:=i;
      Break;
    end;
end;

procedure TStringsHelper.CopyLines(ASource: TStrings; ACount: integer);
var
  i: integer;
begin
  if ACount>ASource.Count then
    ACount:=ASource.Count;
  for i:=0 to ACount-1 do
    Add(ASource[i]);
end;

procedure TStringsHelper.DeleteLines(ACount: integer);
var
  i: Integer;
begin
  if ACount>=Count then
    Clear
  else begin
    i:=0;
    while i<ACount do begin
      Delete(0);
      Inc(i);
    end;
  end;
end;

function TStringsHelper.LastItem: string;
begin
  if Count>0 then
    Result:=Strings[Count-1]
  else
    Result:='';
end;

{ TRegistryHelper }

function TRegistryHelper.ReadDWORD(const Name: string): Cardinal;
var
  RegData: TRegDataType;
  DataType: Integer;
  BufSize: Integer;
begin
  DataType:=REG_NONE;
  BufSize:=SizeOf(Result);
  if RegQueryValueEx(CurrentKey,PChar(Name),nil,@DataType,PByte(@Result),@BufSize)<>ERROR_SUCCESS then
    raise ERegistryException.CreateResFmt(@SRegGetDataFailed,[Name]);
  if DataType=REG_SZ then
    RegData:=rdString
  else if DataType=REG_EXPAND_SZ then
    RegData:=rdExpandString
  else if DataType=REG_DWORD then
    RegData:=rdInteger
  else if DataType=REG_BINARY then
    RegData:=rdBinary
  else
    RegData:=rdUnknown;
  if RegData<>rdInteger then
    raise ERegistryException.CreateResFmt(@SInvalidRegType,[Name]);
end;

{ TListViewHelper }

procedure TListViewHelper.CheckAll(AState: boolean);
var
  i: integer;
begin
  with Self, Items do
    for i:=0 to Count-1 do
      Items[i].Checked:=AState;
end;

function TListViewHelper.GetCheckedCount: Integer;
var
  i: integer;
begin
  Result:=0;
  with Self, Items do
    for i:=0 to Count-1 do
      if Items[i].Checked then
        Inc(Result);
end;

procedure TListViewHelper.ToggleCheckAll;
var
  i: integer;
begin
  with Self, Items do
    for i:=0 to Count-1 do
      Items[i].Checked:=not Items[i].Checked;
end;

{ TCheckListBoxHelper }

procedure TCheckListBoxHelper.SetAll(AChecked: Boolean);
var
  i: Integer;
begin
  for i:=0 to Self.Items.Count-1 do
    Self.Checked[i]:=AChecked;
end;

procedure TCheckListBoxHelper.ExclusiveCheck(AIndex: Integer);
begin
  SetAll(False);
  if AIndex>-1 then
    Self.Checked[AIndex]:=True;
end;

function TCheckListBoxHelper.GetCheckedCount: Integer;
var
  i: Integer;
begin
  Result:=0;
  for i:=0 to Self.Count-1 do
    if Self.Checked[i] then
      Inc(Result);
end;

function TCheckListBoxHelper.GetCheckedIndex(AStartIndex: Integer): Integer;
var
  i: Integer;
begin
  Result:=-1;
  for i:=AStartIndex to Count-1 do
    if Checked[i] then begin
      Result:=i;
      Break;
    end;
end;

{ TCustomEditHelper }

function TCustomEditHelper.GetHasText: Boolean;
begin
  Result:=Self.TrimmedText<>'';
end;

function TCustomEditHelper.GetIsEmpty: Boolean;
begin
  Result:=Self.Text<>'';
end;

function TCustomEditHelper.GetTrimText: string;
begin
  Result:=Trim(Self.Text);
end;

{ TComboBoxHelper }

procedure TComboBoxHelper.AddMRU(AText: string);
begin
  if AText='' then
    AText:=Self.Text;
  if AText='' then
    Exit;
  if Self.Items.IndexOf(AText)=-1 then
    Self.Items.Add(AText);
end;

{ TWinControlHelper }

procedure TWinControlHelper.EnableControls(AEnable: Boolean);
var
  i: Integer;
begin
  for i:=0 to Self.ControlCount-1 do
    Self.Controls[i].Enabled:=AEnable;
end;

procedure TWinControlHelper.ShowControls(AVisible: Boolean);
var
  i: Integer;
begin
  for i:=0 to Self.ControlCount-1 do
    Self.Controls[i].Visible:=AVisible;
end;

{ TFormHelper }

function TFormHelper.GetCaptionVisible: Boolean;
begin
  Result:=GetWindowLong(Handle,GWL_STYLE) and WS_CAPTION>0;
end;

procedure TFormHelper.SetCaptionVisible(const Value: Boolean);
var
  FDiff: Integer;
begin
  if (Value and CaptionVisible) or (not Value and not CaptionVisible) then
    Exit;
  if BorderStyle in [bsDialog, bsSingle, bsSizeable] then
    FDiff:=GetSystemMetrics(SM_CYCAPTION)
  else if BorderStyle in [bsToolWindow, bsSizeToolWin] then
    FDiff:=GetSystemMetrics(SM_CYSMCAPTION)
  else
    FDiff:=0;
  if not Value then begin
    SetWindowLong(Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) and not WS_CAPTION);
    Height:=Height-FDiff;
  end else begin
    SetWindowLong(Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) or WS_CAPTION);
    Height:=Height+FDiff;
  end;
end;

{ TRadioGroupHelper }

procedure TRadioGroupHelper.SetSilentItemIndex(AIndex: integer);
var
  oc: TNotifyEvent;
begin
  oc:=Self.OnClick;
  try
    Self.OnClick:=nil;
    Self.ItemIndex:=AIndex;
  finally
    Self.OnClick:=oc;
  end;
end;

{ TMemoHelper }

procedure TMemoHelper.GetPosition(out ACaret: TPoint);
begin
  ACaret.Y:=SendMessage(Handle,EM_LINEFROMCHAR,SelStart,0);
  ACaret.X:=SelStart-SendMessage(Handle,EM_LINEINDEX,ACaret.X,0);
end;

procedure TMemoHelper.SetPosition(ALine, AColumn: integer);
begin
  SelStart:=Perform(EM_LINEINDEX,ALine,0)+AColumn;
  SelLength:=0;
  Perform(EM_SCROLLCARET,0,0);
end;



{$ENDIF}

end.