home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 February / Chip_2003-02_cd1.bin / zkuste / delphi / kompon / d457 / ABAB_S.ZIP / Source / abMisc.pas < prev   
Pascal/Delphi Source File  |  2002-09-30  |  5KB  |  178 lines
  1. unit abMisc;
  2.  
  3. interface
  4.  
  5. uses classes, abActnLst;
  6.  
  7. function GetStringItem(Expression: string; Count: integer; Separator: Char): string;
  8. function DeleteStringItem(Expression: string; Count: integer; Separator: Char): string;
  9.  
  10. type
  11.   //AB
  12.   TabActionComponent = class(TComponent)
  13.   private
  14.     function GetAction: TabAction;
  15.     procedure SetAction(anAction: TabAction);
  16.     function GetText: string;
  17.     procedure SetText(sText: string);
  18.  
  19.     function GetOnClick: TNotifyEvent;
  20.     procedure SetOnClick(aNotifyEvent: TNotifyEvent);
  21.  
  22.     function GetHint: string;
  23.     procedure SetHint(aHint: string);
  24.   public
  25.     class function IsActionComponent(aComponent: TComponent): boolean;
  26.     property Action: TabAction read GetAction write SetAction;
  27.     property Text: string read GetText write SetText;
  28.     property OnClick: TNotifyEvent read GetOnClick write SetOnClick;
  29.     property Hint: string read GetHint write SetHint;
  30.   end;
  31.  
  32. implementation
  33.  
  34. uses
  35.   Sysutils, menus, controls;
  36.  
  37. function GetStringItem(Expression: string; Count: integer; Separator: Char): string;
  38. var
  39.   i: integer;
  40.   position: byte;
  41. begin
  42.   Result:= '';
  43.   try
  44.     for i:= 1 to Count  do
  45.     begin
  46.       position:= Pos(Separator, Expression);
  47.       if position <> 0 then
  48.       begin
  49.         Result:= Copy(Expression, 1, Position - 1);
  50.         Expression:= Copy(Expression, Position + 1, length(Expression) - Position);
  51.       end
  52.       else
  53.       begin
  54.         if i = Count then
  55.           Result:= Expression
  56.         else
  57.           Result:= '';
  58.         exit;
  59.       end;
  60.     end;
  61.   finally
  62.     Result:= Trim(Result);
  63.   end;
  64. end;
  65.  
  66. function DeleteStringItem(Expression: string; Count: integer; Separator: Char): string;
  67. var
  68.   i: integer;
  69.   iSepCount, iSepPos1, iSepPos2: integer;
  70. begin
  71.   iSepCount := 0;
  72.   iSepPos1 := 1;
  73.   iSepPos2 := Length(Expression);
  74.   for i:= 1 to Length(Expression) do
  75.   begin
  76.     if Expression[i] = Separator then
  77.     begin
  78.       inc(iSepCount);
  79.  
  80.     if iSepCount = Pred(Count) then
  81.       iSepPos1 := i
  82.     else if iSepCount = Count then
  83.     begin
  84.       iSepPos2 := i;
  85.       break;
  86.     end;
  87.     end;
  88.   end;
  89.   if (iSepPos1 = 1) or (iSepPos2 = Length(Expression)) then
  90.     Result := Copy(Expression, 1, Pred(iSepPos1)) + Copy(Expression, Succ(iSepPos2), length(Expression) - Pred(iSepPos2))
  91.   else
  92.     Result := Copy(Expression, 1, Pred(iSepPos1)) + Separator + Copy(Expression, Succ(iSepPos2), length(Expression) - Pred(iSepPos2))
  93. end;
  94.  
  95.  
  96. { TabActionComponent }
  97.  
  98. //AB
  99. class function TabActionComponent.IsActionComponent(aComponent: TComponent): boolean;
  100. begin
  101.   Result := ((aComponent is TMenuItem) and Assigned(TMenuItem(aComponent).Parent)) or (aComponent is TControl);
  102. end;
  103.  
  104. function TabActionComponent.GetAction: TabAction;
  105. begin
  106.   if TComponent(Self) is TMenuItem then
  107.     Result := TabAction(TMenuItem(Self).Action)
  108.   else if TComponent(Self) is TControl then
  109.     Result := TabAction(TControl(Self).Action)
  110.   else
  111.     Result := nil;
  112. end;
  113.  
  114. procedure TabActionComponent.SetAction(anAction: TabAction);
  115. begin
  116.   if TComponent(Self) is TMenuItem then
  117.     TMenuItem(Self).Action := anAction
  118.   else if TComponent(Self) is TControl then
  119.     TControl(Self).Action := anAction;
  120. end;
  121.  
  122. function TabActionComponent.GetText: string;
  123. begin
  124.   if TComponent(Self) is TMenuItem then
  125.     Result := TMenuItem(Self).Caption
  126.   else if TComponent(Self) is TControl then
  127.     Result := TabControl(Self).Text
  128.   else
  129.     Result := '';
  130. end;
  131.  
  132. procedure TabActionComponent.SetText(sText: string);
  133. begin
  134.   if TComponent(Self) is TMenuItem then
  135.     TMenuItem(Self).Caption := sText
  136.   else if TComponent(Self) is TControl then
  137.     TabControl(Self).Text := sText;
  138. end;
  139.  
  140. function TabActionComponent.GetOnClick: TNotifyEvent;
  141. begin
  142.   if TComponent(Self) is TMenuItem then
  143.     Result := TMenuItem(Self).OnClick
  144.   else if TComponent(Self) is TControl then
  145.     Result := TabControl(Self).OnClick
  146.   else
  147.     Result := nil;
  148. end;
  149.  
  150. procedure TabActionComponent.SetOnClick(aNotifyEvent: TNotifyEvent);
  151. begin
  152.   if TComponent(Self) is TMenuItem then
  153.     TMenuItem(Self).OnClick := aNotifyEvent
  154.   else if TComponent(Self) is TControl then
  155.     TabControl(Self).OnClick := aNotifyEvent;
  156. end;
  157.  
  158. function TabActionComponent.GetHint: string;
  159. begin
  160.   if TComponent(Self) is TMenuItem then
  161.     Result := TMenuItem(Self).Hint
  162.   else if TComponent(Self) is TControl then
  163.     Result := TabControl(Self).Hint
  164.   else
  165.     Result := '';
  166. end;
  167.  
  168. procedure TabActionComponent.SetHint(aHint: string);
  169. begin
  170.   if TComponent(Self) is TMenuItem then
  171.     TMenuItem(Self).Hint := aHint
  172.   else if TComponent(Self) is TControl then
  173.     TabControl(Self).Hint := aHint;
  174. end;
  175.  
  176. end.
  177.  
  178.