home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / SBSETUP.PAS < prev    next >
Pascal/Delphi Source File  |  1999-10-12  |  11KB  |  379 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997 Master-Bank                }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit SbSetup;
  11.  
  12. interface
  13.  
  14. {$I RX.INC}
  15.  
  16. uses
  17. {$IFDEF WIN32}
  18.   Windows,
  19. {$ELSE}
  20.   WinTypes, WinProcs,
  21. {$ENDIF WIN32}
  22.   SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  23.   StdCtrls, Buttons, Grids, RxCtrls, SpeedBar, ExtCtrls, RxConst;
  24.  
  25. type
  26.   TSpeedbarSetupWindow = class(TForm)
  27.     ButtonsList: TDrawGrid;
  28.     ButtonsLabel: TLabel;
  29.     SectionList: TDrawGrid;
  30.     CategoriesLabel: TLabel;
  31.     Bevel1: TBevel;
  32.     HintLabel: TLabel;
  33.     CloseBtn: TButton;
  34.     HelpBtn: TButton;
  35.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  36.     procedure SectionListSelectCell(Sender: TObject; Col, Row: Longint;
  37.       var CanSelect: Boolean);
  38.     procedure SectionListDrawCell(Sender: TObject; Col, Row: Longint;
  39.       Rect: TRect; State: TGridDrawState);
  40.     procedure ButtonsListMouseDown(Sender: TObject; Button: TMouseButton;
  41.       Shift: TShiftState; X, Y: Integer);
  42.     procedure ButtonsListMouseMove(Sender: TObject; Shift: TShiftState; X,
  43.       Y: Integer);
  44.     procedure ButtonsListMouseUp(Sender: TObject; Button: TMouseButton;
  45.       Shift: TShiftState; X, Y: Integer);
  46.     procedure ButtonsListSelectCell(Sender: TObject; Col, Row: Longint;
  47.       var CanSelect: Boolean);
  48.     procedure FormCreate(Sender: TObject);
  49.     procedure FormDestroy(Sender: TObject);
  50.     procedure ButtonsListDrawCell(Sender: TObject; Col, Row: Longint;
  51.       Rect: TRect; State: TGridDrawState);
  52.     procedure CloseBtnClick(Sender: TObject);
  53.     procedure HelpBtnClick(Sender: TObject);
  54.     procedure FormShow(Sender: TObject);
  55.   private
  56.     { Private declarations }
  57.     FButton: TBtnControl;
  58.     FImage: TButtonImage;
  59.     FBar: TSpeedBar;
  60.     FDrag: Boolean;
  61.     FDragItem: TSpeedItem;
  62.     procedure UpdateHint(Section, Row: Integer);
  63.     function CheckSpeedBar: Boolean;
  64.     function CurrentSection: Integer;
  65.     procedure SetSection(Section: Integer);
  66.     procedure UpdateCurrentSection;
  67.     procedure UpdateData(Section: Integer);
  68.     procedure UpdateListHeight;
  69.     procedure SetSpeedBar(Value: TSpeedBar);
  70.     function ItemByRow(Row: Integer): TSpeedItem;
  71.     procedure CMSpeedBarChanged(var Message: TMessage); message CM_SPEEDBARCHANGED;
  72.   public
  73.     { Public declarations }
  74.     property SpeedBar: TSpeedBar read FBar write SetSpeedBar;
  75.   end;
  76.  
  77. procedure ShowSpeedbarSetupWindow(Speedbar: TSpeedbar; HelpCtx: THelpContext);
  78.  
  79. implementation
  80.  
  81. uses VCLUtils, MaxMin, Consts, RXTConst;
  82.  
  83. {$R *.DFM}
  84.  
  85. function FindEditor(Speedbar: TSpeedbar): TSpeedbarSetupWindow;
  86. var
  87.   I: Integer;
  88. begin
  89.   Result := nil;
  90.   for I := 0 to Screen.FormCount - 1 do begin
  91.     if Screen.Forms[I] is TSpeedbarSetupWindow then begin
  92.       if TSpeedbarSetupWindow(Screen.Forms[I]).SpeedBar = SpeedBar then
  93.       begin
  94.         Result := TSpeedbarSetupWindow(Screen.Forms[I]);
  95.         Break;
  96.       end;
  97.     end;
  98.   end;
  99. end;
  100.  
  101. procedure ShowSpeedbarSetupWindow(Speedbar: TSpeedbar; HelpCtx: THelpContext);
  102. var
  103.   Editor: TSpeedbarSetupWindow;
  104. begin
  105.   if Speedbar = nil then Exit;
  106.   Editor := FindEditor(Speedbar);
  107.   if Editor = nil then begin
  108.     Editor := TSpeedbarSetupWindow.Create(Application);
  109.     Editor.Speedbar := Speedbar;
  110.   end;
  111.   try
  112.     if HelpCtx > 0 then Editor.HelpContext := HelpCtx;
  113. {$IFDEF WIN32}
  114.     Editor.BorderIcons := [biSystemMenu];
  115. {$ENDIF}
  116.     Editor.HelpBtn.Visible := (HelpCtx > 0);
  117.     Editor.Show;
  118.     if Editor.WindowState = wsMinimized then Editor.WindowState := wsNormal;
  119.   except
  120.     Editor.Free;
  121.     raise;
  122.   end;
  123. end;
  124.  
  125. { TSpeedbarSetupWindow }
  126.  
  127. const
  128.   MaxBtnListHeight = 186;
  129.  
  130. function TSpeedbarSetupWindow.CheckSpeedBar: Boolean;
  131. begin
  132.   Result := (FBar <> nil) and (FBar.Owner <> nil) and
  133.     (FBar.Parent <> nil);
  134. end;
  135.  
  136. function TSpeedbarSetupWindow.CurrentSection: Integer;
  137. begin
  138.   if CheckSpeedBar and (FBar.SectionCount > 0) then
  139.     Result := SectionList.Row
  140.   else Result := -1;
  141. end;
  142.  
  143. procedure TSpeedbarSetupWindow.SetSection(Section: Integer);
  144. var
  145.   I: Integer;
  146. begin
  147.   if CheckSpeedBar then begin
  148.     I := Section;
  149.     if (I >= 0) and (FBar.SectionCount > 0) then
  150.       ButtonsList.RowCount := FBar.ItemsCount(I)
  151.     else ButtonsList.RowCount := 0;
  152.     SectionList.DefaultColWidth := SectionList.ClientWidth;
  153.     ButtonsList.DefaultColWidth := ButtonsList.ClientWidth;
  154.     UpdateHint(I, ButtonsList.Row);
  155.   end;
  156. end;
  157.  
  158. procedure TSpeedbarSetupWindow.UpdateCurrentSection;
  159. begin
  160.   SetSection(CurrentSection);
  161. end;
  162.  
  163. procedure TSpeedbarSetupWindow.UpdateData(Section: Integer);
  164. begin
  165.   if CheckSpeedBar then begin
  166.     SectionList.RowCount := FBar.SectionCount;
  167.     UpdateCurrentSection;
  168.     if (Section >= 0) and (Section < SectionList.RowCount) then
  169.       SectionList.Row := Section;
  170.   end
  171.   else begin
  172.     SectionList.RowCount := 0;
  173.     ButtonsList.RowCount := 0;
  174.   end;
  175. end;
  176.  
  177. procedure TSpeedbarSetupWindow.UpdateListHeight;
  178. var
  179.   Cnt: Integer;
  180.   MaxHeight: Integer;
  181. begin
  182.   Canvas.Font := Font;
  183.   MaxHeight := MulDiv(MaxBtnListHeight, Screen.PixelsPerInch, 96);
  184.   ButtonsList.DefaultRowHeight := FBar.BtnHeight + 2;
  185.   Cnt := Max(1, Max(ButtonsList.ClientHeight, MaxHeight) div
  186.     (FBar.BtnHeight + 2));
  187.   ButtonsList.ClientHeight := Min(MaxHeight,
  188.     ButtonsList.DefaultRowHeight * Cnt);
  189.   SectionList.ClientHeight := ButtonsList.ClientHeight;
  190.   SectionList.DefaultRowHeight := Canvas.TextHeight('Wg') + 2;
  191. end;
  192.  
  193. procedure TSpeedbarSetupWindow.SetSpeedBar(Value: TSpeedBar);
  194. begin
  195.   if FBar <> Value then begin
  196.     if FBar <> nil then FBar.SetEditing(0);
  197.     FBar := Value;
  198.     if FBar <> nil then begin
  199.       FBar.SetEditing(Handle);
  200.       UpdateListHeight;
  201.     end;
  202.     UpdateData(-1);
  203.   end;
  204. end;
  205.  
  206. procedure TSpeedbarSetupWindow.CMSpeedBarChanged(var Message: TMessage);
  207. begin
  208.   if Pointer(Message.LParam) = FBar then begin
  209.     case Message.WParam of
  210.       SBR_CHANGED: UpdateData(CurrentSection);
  211.       SBR_DESTROYED: Close;
  212.       SBR_BTNSIZECHANGED: if FBar <> nil then UpdateListHeight;
  213.     end;
  214.   end;
  215. end;
  216.  
  217. function TSpeedbarSetupWindow.ItemByRow(Row: Integer): TSpeedItem;
  218. begin
  219.   Result := FBar.Items(CurrentSection, Row);
  220. end;
  221.  
  222. procedure TSpeedbarSetupWindow.UpdateHint(Section, Row: Integer);
  223. var
  224.   Item: TSpeedItem;
  225. begin
  226.   Item := FBar.Items(Section, Row);
  227.   if Item <> nil then Hint := Item.Hint
  228.   else Hint := '';
  229. end;
  230.  
  231. procedure TSpeedbarSetupWindow.FormClose(Sender: TObject; var Action: TCloseAction);
  232. begin
  233.   Action := caFree;
  234.   FButton.Free;
  235.   FButton := nil;
  236.   if FBar <> nil then FBar.SetEditing(0);
  237.   FBar := nil;
  238. end;
  239.  
  240. procedure TSpeedbarSetupWindow.SectionListSelectCell(Sender: TObject; Col,
  241.   Row: Longint; var CanSelect: Boolean);
  242. begin
  243.   CanSelect := False;
  244.   SetSection(Row);
  245.   CanSelect := True;
  246. end;
  247.  
  248. procedure TSpeedbarSetupWindow.SectionListDrawCell(Sender: TObject; Col,
  249.   Row: Longint; Rect: TRect; State: TGridDrawState);
  250. begin
  251.   if CheckSpeedBar then begin
  252.     if Row < FBar.SectionCount then begin
  253.       DrawCellText(Sender as TDrawGrid, Col, Row,
  254.         FBar.Sections[Row].Caption, Rect, taLeftJustify, vaCenter
  255.         {$IFDEF RX_D4}, TDrawGrid(Sender).IsRightToLeft {$ENDIF});
  256.     end;
  257.   end;
  258. end;
  259.  
  260. procedure TSpeedbarSetupWindow.ButtonsListMouseDown(Sender: TObject;
  261.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  262. var
  263.   Item: TSpeedItem;
  264. begin
  265.   Item := ItemByRow(ButtonsList.Row);
  266.   if (Item <> nil) and (X < FBar.BtnWidth + 2) and (Button = mbLeft) then
  267.   begin
  268.     FDrag := True;
  269.     if Item.Visible then FDragItem := nil
  270.     else begin
  271.       FDragItem := Item;
  272.       if FButton = nil then begin
  273.         FButton := TBtnControl.Create(Self);
  274.         FButton.AssignSpeedItem(Item);
  275.       end;
  276.     end;
  277.   end;
  278. end;
  279.  
  280. procedure TSpeedbarSetupWindow.ButtonsListMouseMove(Sender: TObject;
  281.   Shift: TShiftState; X, Y: Integer);
  282. var
  283.   P: TPoint;
  284. begin
  285.   if FDrag and (FButton <> nil) and (FDragItem <> nil) then begin
  286.     P := (Sender as TControl).ClientToScreen(Point(X, Y));
  287.     X := P.X - (FButton.Width {div 2});
  288.     Y := P.Y - (FButton.Height {div 2});
  289.     FButton.Activate(Bounds(X, Y, FBar.BtnWidth, FBar.BtnHeight));
  290.   end
  291.   else if FDrag then SetCursor(Screen.Cursors[crNoDrop]);
  292. end;
  293.  
  294. procedure TSpeedbarSetupWindow.ButtonsListMouseUp(Sender: TObject;
  295.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  296. var
  297.   P: TPoint;
  298. begin
  299.   if FDrag and (Button = mbLeft) then
  300.   try
  301.     if (FDragItem <> nil) and (FButton <> nil) then begin
  302.       Dec(X, FButton.Width {div 2});
  303.       Dec(Y, FButton.Height {div 2});
  304.       P := (Sender as TControl).ClientToScreen(Point(X, Y));
  305.       FButton.Free;
  306.       FButton := nil;
  307.       if CheckSpeedBar and (FBar = FindSpeedBar(P)) then begin
  308.         P := FBar.ScreenToClient(P);
  309.         if FBar.AcceptDropItem(FDragItem, P.X, P.Y) then
  310.           UpdateCurrentSection;
  311.       end;
  312.     end
  313.     else SetCursor(Screen.Cursors[ButtonsList.Cursor]);
  314.   finally
  315.     FDrag := False;
  316.     FDragItem := nil;
  317.   end;
  318. end;
  319.  
  320. procedure TSpeedbarSetupWindow.ButtonsListSelectCell(Sender: TObject; Col,
  321.   Row: Longint; var CanSelect: Boolean);
  322. begin
  323.   CanSelect := not FDrag or (Row = ButtonsList.Row);
  324.   if CanSelect then UpdateHint(CurrentSection, Row)
  325.   else Hint := '';
  326. end;
  327.  
  328. procedure TSpeedbarSetupWindow.FormCreate(Sender: TObject);
  329. begin
  330.   FImage := TButtonImage.Create;
  331.   FButton := nil;
  332.   FBar := nil;
  333.   FDrag := False;
  334.   CloseBtn.Default := False;
  335.   if NewStyleControls then Font.Style := [];
  336.   { Load string resources }
  337.   CloseBtn.Caption := ResStr(SOKButton);
  338.   HelpBtn.Caption := ResStr(SHelpButton);
  339.   Caption := LoadStr(SCustomizeSpeedbar);
  340.   CategoriesLabel.Caption := LoadStr(SSpeedbarCategories);
  341.   ButtonsLabel.Caption := LoadStr(SAvailButtons);
  342.   HintLabel.Caption := LoadStr(SSpeedbarEditHint);
  343. end;
  344.  
  345. procedure TSpeedbarSetupWindow.FormDestroy(Sender: TObject);
  346. begin
  347.   FImage.Free;
  348. end;
  349.  
  350. procedure TSpeedbarSetupWindow.ButtonsListDrawCell(Sender: TObject; Col,
  351.   Row: Longint; Rect: TRect; State: TGridDrawState);
  352. var
  353.   I: Integer;
  354. begin
  355.   I := CurrentSection;
  356.   if (I >= 0) and (Row < FBar.ItemsCount(I)) then
  357.     DrawCellButton(Sender as TDrawGrid, Rect, ItemByRow(Row), FImage
  358.       {$IFDEF RX_D4}, TDrawGrid(Sender).IsRightToLeft {$ENDIF});
  359. end;
  360.  
  361. procedure TSpeedbarSetupWindow.CloseBtnClick(Sender: TObject);
  362. begin
  363.   Close;
  364. end;
  365.  
  366. procedure TSpeedbarSetupWindow.HelpBtnClick(Sender: TObject);
  367. begin
  368.   Application.HelpContext(HelpContext);
  369. end;
  370.  
  371. procedure TSpeedbarSetupWindow.FormShow(Sender: TObject);
  372. begin
  373.   if FBar <> nil then UpdateListHeight;
  374.   SectionList.DefaultColWidth := SectionList.ClientWidth;
  375.   ButtonsList.DefaultColWidth := ButtonsList.ClientWidth;
  376. end;
  377.  
  378. end.
  379.