home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9203 / smartico / tbwin.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1992-03-31  |  26.6 KB  |  800 lines
  1. (*$A+,B-,D+,F-,G+,I+,L+,N-,R+,S+,V+,W-,X+*)
  2. (*--------------------------------------------------------*)
  3. (*                       TBWIN.PAS                        *)
  4. (*    Copyright 1992 Mario M. Westphal & DMV-Verlag       *)
  5. (*      Unit fⁿr Symbolleisten und Floating Menus         *)
  6. (*        Compiler: Turbo Pascal f. Windows 1.0           *)
  7. (*--------------------------------------------------------*)
  8. UNIT TBWin;
  9.  
  10. INTERFACE
  11. USES
  12.   WinTypes, WObjects, WinProcs;
  13.  
  14. (* ******* ToolBar ******* *)
  15.  
  16. CONST
  17.   MaxBreaks = 9;           (* Anzahl der Trennstriche 0.. *)
  18.  
  19. TYPE
  20.   pToolBar  = ^tToolBar;
  21.   tToolBar  = OBJECT(tWindow)
  22.       color_TBFace  : tColorRef; (* Farben                *)
  23.       color_TBShadow: tColorRef;
  24.       color_TBHilite: tColorRef; (* Dialog-Basiseinheiten *)
  25.       cyDBU         : INTEGER;
  26.       cxDBU         : INTEGER;
  27.       bkBrush       : HBrush;    (* Struktur fⁿr die      *)
  28.                                  (* Trennbalken           *)
  29.     CONSTRUCTOR Init(aParent: pWindowsObject;
  30.                      Height: INTEGER);
  31.     DESTRUCTOR Done; VIRTUAL;
  32.     FUNCTION  GetClassName: PChar; VIRTUAL;
  33.     PROCEDURE GetWindowClass(VAR aWndClass: tWndClass);
  34.                                VIRTUAL;
  35.     PROCEDURE SetColors; VIRTUAL;
  36.     PROCEDURE Paint (PaintDC: HDC;
  37.                      VAR PaintInfo: tPaintStruct); VIRTUAL;
  38.     PROCEDURE SetSize;
  39.     PROCEDURE SetBarBreak(Pos: INTEGER; ShowBreak: BOOLEAN);
  40.     PRIVATE
  41.       Breaks  : ARRAY[0..MaxBreaks] OF INTEGER;
  42.       BreakCnt: BYTE;
  43.   END;
  44.  
  45.  
  46. (* ******* Toolbox-Windows ******* *)
  47. CONST
  48.   MaxPanels   = 20;    (* Max. Anzahl Panels pro Fenster  *)
  49.   SecPanelOfs = 2000;  (* ID-Offset der zweiten Bitmap    *)
  50.   LowResOfs   = 1000;  (* ID-Offs. der Bitmaps fⁿr LowRes *)
  51.  
  52.   (* Status-Flags *)
  53.   tb_Null     = 0;     (* Keine Bitmap                    *)
  54.   tb_Normal   = 1;     (* Normal                          *)
  55.   tb_Selected = 2;     (* Selektiert                      *)
  56.   tb_Toggle   = 4;     (* Panelzustand umschalten         *)
  57.   tb_Disabled = 8;     (* Panel inaktiv                   *)
  58.  
  59.   (* Style-Flags *)
  60.   tbs_Caption   = 1;   (* Mit Titelleiste (=> tbs_Border) *)
  61.   tbs_Border    = 2;   (* Mit Rahmen                      *)
  62.   tbs_MultiSel  = 4;   (* Mehrfachauswahl erlaubt         *)
  63.   tbs_MultiMsg  = 8;   (* Fⁿr jedes Panel eine eigene     *)
  64.                        (* Botschaft                       *)
  65.  
  66.   (* Toolbox-Botschaften *)
  67.   tbm_Select    = 1;   (* Msg: SchaltflΣche selektiert    *)
  68.   tbm_Unselect  = 2;   (* Msg: SchaltflΣche deselektiert  *)
  69.  
  70. TYPE
  71.   (* Struktur fⁿr ein Panel (5 Bytes) *)
  72.   tPanel   = RECORD
  73.     rID    : WORD;
  74.     hBM    : hBitmap;  (* normale Bitmap                  *)
  75.     hBMSel : hBitmap;  (* selektierte Bitmap              *)
  76.     Flags  : BYTE;     (* Zustands-Flag                   *)
  77.   END;
  78.  
  79. TYPE
  80.   (* Toolbox-Objekt *)
  81.   pToolBox  = ^tToolBox;
  82.   tToolBox  = OBJECT(tWindow)
  83.     CONSTRUCTOR Init (aParent       : pWindowsObject;
  84.                       aTitle        : PChar;
  85.                       AID           : INTEGER;
  86.                       x, y, cx, cy  : INTEGER;
  87.                       W1, H1, W2, H2: INTEGER;
  88.                       aStyle        : WORD);
  89.     DESTRUCTOR Done; VIRTUAL;
  90.     FUNCTION  GetClassName: PChar; VIRTUAL;
  91.     FUNCTION  UseLowRes: BOOLEAN; VIRTUAL;
  92.     PROCEDURE SetTBPos(x, y: INTEGER);
  93.     PROCEDURE tbAdjust;
  94.     PROCEDURE GetTBPos(VAR r: tRect);
  95.     FUNCTION  GetPanelState(id: INTEGER): INTEGER;
  96.     FUNCTION  GetFocus: INTEGER;
  97.     FUNCTION  SetPanelState(id: INTEGER;
  98.                             aStatus: INTEGER): INTEGER;
  99.     FUNCTION  SetPanel(id: INTEGER;
  100.                        ResID: INTEGER) : INTEGER;
  101.     FUNCTION  InsertPanel(id: INTEGER;
  102.                        ResID: INTEGER) : INTEGER;
  103.     PROCEDURE DrawEmptyPanel(VAR dc: HDC;
  104.                        x, y, w, h: INTEGER); VIRTUAL;
  105.  
  106.     PRIVATE
  107.       pId       : INTEGER;
  108.       pAs       : ARRAY[0..MaxPanels-1] OF tPanel;
  109.       pACount   : INTEGER;
  110.       bm_Width  : INTEGER; (* Breite der Bitmap           *)
  111.       bm_Height : INTEGER; (* H÷he der Bitmap             *)
  112.       xClient,
  113.       yClient   : INTEGER; (* Fensterbreite- und H÷he     *)
  114.       InWindow  : BOOLEAN; (* Maus war im TB-Client bei   *)
  115.                            (* LBtnDown                    *)
  116.       Rows,
  117.       Cols      : INTEGER; (* Anzahl Zeilen und Spalten   *)
  118.       tbStyle   : WORD;    (* Fenster-Stil                *)
  119.       Focus     : INTEGER; (* ID des momentan selektierten*)
  120.                            (* Panels                      *)
  121.       MsDnID    : INTEGER; (* ID des Panels bei LBtnDown  *)
  122.       ActState  : INTEGER; (* Zustand dieses Panels       *)
  123.  
  124.     PROCEDURE NotifyParent(PanelID: INTEGER; Msg: INTEGER);
  125.     PROCEDURE DrawPanel(dc: HDC; id: INTEGER;
  126.                         Mode: INTEGER);
  127.     PROCEDURE Paint(PaintDC: HDC;
  128.                     VAR PaintInfo: tPaintStruct); VIRTUAL;
  129.     PROCEDURE wmMove(VAR Msg: tMessage);
  130.       VIRTUAL wm_First + wm_Move;
  131.     PROCEDURE wmlButtonDown(VAR Msg: tMessage);
  132.       VIRTUAL wm_First + wm_LButtonDown;
  133.     PROCEDURE wmlButtonUp(VAR Msg: tMessage);
  134.       VIRTUAL wm_First + wm_LButtonUp;
  135.     PROCEDURE wmMouseMove(VAR Msg: tMessage);
  136.       VIRTUAL wm_First + wm_MouseMove;
  137.   END;
  138.  
  139.  
  140. IMPLEMENTATION
  141.  
  142.  
  143. (**********************************************************)
  144. (*                   tToolbar-Symbolleiste                *)
  145. (**********************************************************)
  146. (*------------------------------------------------------- *)
  147. (* Erzeugt eine Symbolleiste und zeigt sie an.            *)
  148. (* aParent : Zeiger auf das Eltern-Fenster                *)
  149. (* Height  : H÷he der Symbolleiste                        *)
  150.  
  151. CONSTRUCTOR tToolBar.Init (aParent: pWindowsObject;
  152.                            Height : INTEGER);
  153. VAR
  154.   i     : INTEGER;
  155.   lDlgBU: LONGINT;
  156. BEGIN
  157.   tWindow.Init(aParent, '');
  158.   Attr.Style := ws_Child OR ws_Visible OR ws_ClipSiblings;
  159.   Attr.x := 0;
  160.   Attr.y := 0;
  161.   Attr.w := 0;
  162.   Attr.h := Height;
  163.   (* Trenner initialisieren *)
  164.   BreakCnt := 0;
  165.   FOR i := 0 TO MaxBreaks DO Breaks[i] := 0;
  166.   (* Ermittelt die Dialog-Basiseinheiten *)
  167.   lDlgBU := GetDialogBaseUnits;
  168.   cyDBU := HiWord(lDlgBU);
  169.   cxDBU := LoWord(lDlgBU);
  170.   (* Farben festlegen *)
  171.   SetColors;
  172.   (* Pinsel fⁿr den Hintergrund der Symbolleiste *)
  173.   (* und der Kindfenster                         *)
  174.   bkBrush := CreateSolidBrush(color_TBFace);
  175. END;
  176.  
  177. DESTRUCTOR tToolBar.Done;
  178. BEGIN
  179.   tWindow.Done;
  180.   DeleteObject(bkBrush);
  181. END;
  182.  
  183. FUNCTION tToolBar.GetClassName: PChar;
  184. BEGIN
  185.   GetClassName := 'TOOLBAR';
  186. END;
  187.  
  188. PROCEDURE tToolBar.GetWindowClass(VAR aWndClass: tWndClass);
  189. (*--------------------------------------------------------*)
  190. (* Setzt den Hintergrundpinsel und Doppelklick-Erkennung  *)
  191. BEGIN
  192.   tWindow.GetWindowClass(aWndClass);
  193.   aWndClass.Style := aWndClass.Style OR cs_DblClks;
  194.   aWndClass.hBrBackground := bkBrush;
  195. END;
  196.  
  197. PROCEDURE tToolBar.SetColors;
  198. (*--------------------------------------------------------*)
  199. (* Legt die Farben fⁿr die Symbolleiste fest.             *)
  200. (* Wird bei Bedarf ⁿberschrieben.                         *)
  201.  
  202. VAR IC : HDC;
  203. BEGIN
  204.   IC := CreateIC('DISPLAY', NIL, NIL, NIL);
  205.   (* Hellgrau, EGA/Herc. wei▀ *)
  206.   color_TBFace  := GetNearestColor(IC, RGB(193, 193, 193));
  207.   (* Dunkelgrau, Herc. schwarz *)
  208.   color_TBShadow:= GetNearestColor(IC, RGB(85, 85, 85));
  209.   (* Immer wei▀ *)
  210.   color_TBHilite:= RGB(255, 255, 255);
  211.   DeleteDC(IC);
  212. END;
  213.  
  214.  
  215. PROCEDURE tToolBar.Paint(PaintDC: HDC;
  216.                          VAR PaintInfo: tPaintStruct);
  217. (*--------------------------------------------------------*)
  218. (* Baut die Symbolleiste komplett neu auf                 *)
  219. VAR
  220.   OPen: hPen;
  221.   Pen : hPen;
  222.   Pen2: hPen;
  223.   r   : tRect;
  224.   i   : INTEGER;
  225. BEGIN
  226.   tWindow.Paint(PaintDC, PaintInfo);
  227.   GetClientRect(hWindow, r);
  228.   Pen := CreatePen(ps_Solid, 1, color_TBHilite);
  229.   Pen2 := CreatePen(ps_Solid, 1, color_TBShadow);
  230.   OPen := SelectObject(PaintDC, Pen);
  231.   MoveTo(PaintDC,0,0);
  232.   LineTo(PaintDC, r.Right + 1, 0);
  233.   SelectObject(PaintDC, Pen2);
  234.   MoveTo(PaintDC, 0, r.Bottom - 2);
  235.   LineTo(PaintDC, r.Right + 1, r.Bottom - 2);
  236.   SelectObject(PaintDC, GetStockObject(Black_Pen));
  237.   MoveTo(PaintDC, 0, r.Bottom - 1);
  238.   LineTo(PaintDC, r.Right + 1, r.Bottom - 1);
  239.   (* Trennbalken zeichnen *)
  240.   FOR i := 0 TO MaxBreaks DO
  241.   IF Breaks[i] <> 0 THEN BEGIN
  242.     SelectObject(PaintDC,Pen);
  243.     MoveTo(PaintDC,Breaks[i], 0);
  244.     LineTo(PaintDC,Breaks[i], r.Bottom - 1);
  245.     SelectObject(PaintDC, GetStockObject(Black_Pen));
  246.     MoveTo(PaintDC, Breaks[i] + 1, 0);
  247.     LineTo(PaintDC, Breaks[i] + 1, r.Bottom - 1);
  248.   END;
  249.   SelectObject(PaintDC, OPen);
  250.   DeleteObject(Pen);
  251.   DeleteObject(Pen2);
  252. END;
  253.  
  254. PROCEDURE tToolBar.SetSize;
  255. (*--------------------------------------------------------*)
  256. (* Anpassen der Symbolleistenbreite. Aufruf durch die     *)
  257. (* wmSize-Methode des Eltern-Fensters!                    *)
  258. VAR
  259.   r,
  260.   r2: tRect;
  261. BEGIN
  262.   GetClientRect(Parent^.hWindow, r);
  263.   GetClientRect(hWindow, r2);
  264.   MoveWindow(hWindow, 0, 0, r.Right, r2.Bottom, TRUE);
  265. END;
  266.  
  267. PROCEDURE tToolBar.SetBarBreak(Pos: INTEGER;
  268.                                ShowBreak: BOOLEAN);
  269. (*--------------------------------------------------------*)
  270. (* Setzt oder l÷scht einen Trennstrich. Ist die maximale  *)
  271. (* Anzahl erreicht, wird der Aufruf ignoriert.            *)
  272. (*   Pos       : Horizontale Position                     *)
  273. (*   ShowBreak : true => setzen, sonst l÷schen            *)
  274. VAR
  275.   i: INTEGER;
  276. BEGIN
  277.   IF ShowBreak THEN BEGIN (* Einfⁿgen *)
  278.     IF BreakCnt <= MaxBreaks THEN BEGIN
  279.       Inc(BreakCnt);
  280.       (* Freien Platz suchen *)
  281.       FOR i := 0 TO MaxBreaks DO
  282.       IF Breaks[i] = 0 THEN BEGIN
  283.         Breaks[i] := Pos;
  284.         Exit;
  285.       END;
  286.     END;
  287.   END ELSE BEGIN (* L÷schen *)
  288.     FOR i := 0 TO MaxBreaks DO
  289.       IF Breaks[i] = Pos THEN BEGIN
  290.         (* Nur den ersten gefundenen entfernen *)
  291.         Breaks[i] := 0;
  292.         Dec(BreakCnt);
  293.         Exit;
  294.       END;
  295.   END;
  296. END;
  297.  
  298.  
  299. (**********************************************************)
  300. (*               tToolBox : toolbox-Windows               *)
  301. (**********************************************************)
  302. CONSTRUCTOR tToolBox.Init(aParent       : pWindowsObject;
  303.                           aTitle        : PChar;
  304.                           AID           : INTEGER;
  305.                           x, y, cx, cy  : INTEGER;
  306.                           W1, H1, W2, H2: INTEGER;
  307.                           aStyle        : WORD);
  308. (*--------------------------------------------------------*)
  309. (*Initialisiert ein Toolbox-Window.                       *)
  310. (*AParent     : Handle des Eltern-Fensters                *)
  311. (*ATitle      : Fenstertitel                              *)
  312. (*x, y        : Obere linke Ecke des Fensters, bezⁿglich  *)
  313. (*              des ⁿbergeordneten Fensters               *)
  314. (*cx, cy      : Anzahl der Panels horizontal und vertikal *)
  315. (*W1, H1      : Ma▀e der Bitmaps fⁿr HiRes                *)
  316. (*W2, H2      : Ma▀e der Bitmaps fⁿr LowRes               *)
  317. (*AStyle      : Fensterstil (tbs_xxxx - Konstanten )      *)
  318. VAR
  319.   i, COfs: INTEGER;
  320. BEGIN
  321.   tWindow.Init(aParent, aTitle);
  322.   Cols     := cx;
  323.   Rows     := cy;
  324.   InWindow := FALSE;
  325.   tbStyle  := aStyle;
  326.   Focus    := -1;
  327.   pId      := AID;
  328.   pACount  := 0;
  329.   IF UseLowRes THEN BEGIN
  330.     bm_Width  := W2;
  331.     bm_Height := H2;
  332.   END ELSE BEGIN
  333.     bm_Width  := W1;
  334.     bm_Height := H1;
  335.   END;
  336.   FOR i := 0 TO MaxPanels - 1 DO
  337.     WITH pAs[i] DO BEGIN
  338.       hBM    := 0;
  339.       hBMSel := 0;
  340.       Flags  := tb_Null;
  341.     END;
  342.   (* Fenstergr÷▀e an die Bitmaps anpassen *)
  343.   Attr.x := x;
  344.   Attr.y := y;
  345.   Attr.w := cx * bm_Width;
  346.   Attr.h := cy * bm_Height;
  347.   Attr.Style := ws_Child OR ws_Visible OR
  348.                 ws_ClipSiblings OR ws_Overlapped;
  349.  
  350.   (* Fⁿr Fenster mit Titel wird auch ein Rahmen ben÷tigt *)
  351.   IF tbStyle AND tbs_Caption <> 0 THEN BEGIN
  352.     tbStyle := tbStyle OR tbs_Border;
  353.     Attr.Style := Attr.Style OR ws_Caption;
  354.     Inc(Attr.h, GetSystemMetrics(sm_CYCaption));
  355.   END;
  356.  
  357.   (* Bei Rahmen mⁿssen Breite und H÷he angepa▀t werden *)
  358.   IF tbStyle AND tbs_Border <> 0 THEN BEGIN
  359.     Attr.Style := Attr.Style OR ws_Border;
  360.     Inc(Attr.w, 2 * GetSystemMetrics(sm_CXBorder));
  361.     Inc(Attr.h, GetSystemMetrics(sm_CYBorder));
  362.   END;
  363. END;
  364.  
  365. DESTRUCTOR tToolBox.Done;
  366. (*--------------------------------------------------------*)
  367. (*  Gibt den Speicher fⁿr die Bitmaps wieder frei und     *)
  368. (*  schlie▀t das Fenster.                                 *)
  369. VAR
  370.   i: INTEGER;
  371. BEGIN
  372.   FOR i := 0 TO MaxPanels - 1 DO BEGIN
  373.     IF pAs[i].hBMSel <> 0 THEN DeleteObject(pAs[i]. hBMSel);
  374.     IF pAs[i].hBM    <> 0 THEN DeleteObject(pAs[i]. hBM);
  375.   END;
  376.   tWindow.Done;
  377. END;
  378.  
  379. FUNCTION tToolBox.GetClassName: PChar;
  380. BEGIN
  381.   GetClassName := 'TOOLBOX';
  382. END;
  383.  
  384. FUNCTION tToolBox.UseLowRes: BOOLEAN;
  385. (*--------------------------------------------------------*)
  386. (* Liefert true, falls die Bitmaps mit der niedrigen      *)
  387. (* Aufl÷sung verwendet werden sollen.                     *)
  388. BEGIN
  389.   UseLowRes := GetSystemMetrics(sm_CYScreen) < 480;
  390. END;
  391.  
  392. PROCEDURE tToolBox.SetTBPos(x,y: INTEGER);
  393. (*--------------------------------------------------------*)
  394. (* Positioniert das Fenster auf die Position X, Y         *)
  395. (* bezⁿglich des ⁿbergeordneten Fensters.                 *)
  396. BEGIN
  397.   IF (tbStyle AND tbs_Caption <> 0) AND
  398.      (y > GetSystemMetrics(sm_CYCaption)) THEN
  399.     Dec(y,GetSystemMetrics(sm_CYCaption));
  400.   SetWindowPos(hWindow, 0, x, y, 0, 0, swp_NoSize);
  401. END;
  402.  
  403. PROCEDURE tToolBox.tbAdjust;
  404. (*--------------------------------------------------------*)
  405. (* Justiert das ToolBox-Fenster im Client-Bereich des     *)
  406. (* Eltern-Fensters. Mu▀ von der WMSize-Methode des        *)
  407. (* Eltern-Fensters aufgerufen werden.                     *)
  408. VAR
  409.   rp, rc: tRect;
  410.   y     : INTEGER;
  411. BEGIN
  412.   IF IsIconic(Parent^.hWindow) THEN Exit;
  413.   GetClientRect(Parent^.hWindow, rp);
  414.   GetTBPos(rc);
  415.   IF rc.Left + 20 > rp.Right THEN BEGIN
  416.     SetTBPos(rp.Right - 20, rc.Top);
  417.     GetTBPos(rc);
  418.   END;
  419.   IF rc.Top + 20 > rp.Bottom THEN BEGIN
  420.     y := rp.Bottom - 20;
  421.     IF y < 0 THEN y := 0;
  422.     SetTBPos(rc.Left, y);
  423.     GetTBPos(rc);
  424.   END;
  425. END;
  426.  
  427. PROCEDURE tToolBox.GetTBPos(VAR r: tRect);
  428. (*--------------------------------------------------------*)
  429. (* Liefert die Position und Ausdehnung des Client-        *)
  430. (* Fensters bezⁿglich des Parent-Windows.                 *)
  431.  
  432. VAR
  433.  tr: tRect;
  434. BEGIN
  435.   GetClientRect(hWindow, tr);
  436.   r.Left   := xClient;
  437.   r.Top    := yClient;
  438.   r.Right  := xClient + tr.Right;
  439.   r.Bottom := yClient + tr.Bottom;
  440. END;
  441.  
  442. FUNCTION tToolBox.GetPanelState(id: INTEGER): INTEGER;
  443. (*--------------------------------------------------------*)
  444. (* Liefert den Status des Elements mit der ⁿbergebenen ID *)
  445. (* Liefert -1, falls eine ungⁿltige ID ⁿbergeben wird.    *)
  446. BEGIN
  447.   IF (id >= 0) AND (id < pACount) THEN
  448.     GetPanelState := pAs[id].Flags
  449.   ELSE GetPanelState := -1;
  450. END;
  451.  
  452. FUNCTION tToolBox.GetFocus : INTEGER;
  453. (*--------------------------------------------------------*)
  454. (* Liefert die ID des Panels, das momentan den Focus hat. *)
  455. (* Gibt -1 zurⁿck, wenn die ID ungⁿltig ist oder das      *)
  456. (* Fenster den Stil tbs_MultiSel hat.                     *)
  457.  
  458. BEGIN
  459.   IF tbStyle AND tbs_MultiSel <> 0 THEN GetFocus := -1
  460.   ELSE GetFocus := Focus;
  461. END;
  462.  
  463. FUNCTION tToolBox.SetPanelState(id     : INTEGER;
  464.                                 aStatus: INTEGER) : INTEGER;
  465. (*--------------------------------------------------------*)
  466. (* Setzt den Status des ⁿbergebenen Elementes und zeichnet*)
  467. (* es neu. Liefert -1, falls eine ungⁿltige ID oder ein   *)
  468. (* ungⁿltiger Status ⁿbergeben wird oder das angegebene   *)
  469. (* Panel momentan den Focus hat.                          *)
  470. BEGIN
  471.   IF (id >= 0) AND (id < pACount) THEN BEGIN
  472.    (* Das Panel mit dem Fokus darf nicht geΣndert werden! *)
  473.     IF tbStyle AND tbs_MultiSel = 0 THEN
  474.       IF GetFocus = id THEN BEGIN
  475.         SetPanelState := -1;
  476.         Exit;
  477.       END;
  478.     SetPanelState := 0;
  479.     DrawPanel(0, id, aStatus);
  480.   END
  481.   ELSE SetPanelState := -1;
  482. END;
  483.  
  484. FUNCTION tToolBox.SetPanel(id   : INTEGER;
  485.                            ResID: INTEGER): INTEGER;
  486. (*--------------------------------------------------------*)
  487. (* ─ndert die Bitmap-Darstellung des Panels ID. Dazu wird *)
  488. (* die Bitmap mit der Ressource-ID ResID verwendet.       *)
  489. (* Liefert einen Wert < 0, wenn ID einen ungⁿltigen Wert  *)
  490. (* reprΣsentiert oder das Panel momentan des Focus hat.   *)
  491.  
  492. VAR
  493.   COfs : WORD;
  494. BEGIN
  495.   IF (id >= 0) AND (id < pACount) THEN BEGIN
  496.     (* Das Panel mit dem Fokus darf nicht geΣndert werden *)
  497.     IF tbStyle AND tbs_MultiSel = 0 THEN
  498.       IF GetFocus = id THEN BEGIN
  499.         SetPanel := -1;
  500.         Exit;
  501.       END;
  502.     SetPanel := 0;
  503.     WITH pAs[id] DO BEGIN
  504.       IF hBM <> 0 THEN DeleteObject(hBM);
  505.       IF hBMSel <> 0 THEN DeleteObject(hBMSel);
  506.       IF UseLowRes THEN COfs := LowResOfs ELSE COfs := 0;
  507.       rID := ResID;
  508.       hBM := LoadBitmap(hInstance,
  509.                         MakeIntResource(rID + COfs));
  510.       hBMSel := LoadBitmap(hInstance,
  511.                 MakeIntResource(SecPanelOfs + rID + COfs));
  512.       IF (hBM = 0) THEN Flags := tb_Null
  513.       ELSE Flags := tb_Normal;
  514.       DrawPanel(0, id, Flags);
  515.     END;
  516.   END
  517.   ELSE SetPanel := -1;
  518. END;
  519.  
  520. FUNCTION tToolBox.InsertPanel(id   : INTEGER;
  521.                               ResID: INTEGER): INTEGER;
  522. (*--------------------------------------------------------*)
  523. (* Fⁿgt ein neues Panel in das Fenster ein. ID bezeichnet *)
  524. (* die Position des neuen Panels, ResID ist der Name der  *)
  525. (* ersten Bitmap. Liefert -1 bei ungⁿltiger ID/ResID.     *)
  526. VAR
  527.   COfs : WORD;
  528. BEGIN
  529.   IF (id >= 0) AND (id < Rows*Cols)
  530.                AND (pAs[id].hBM = 0) THEN BEGIN
  531.     Inc(pACount);
  532.     InsertPanel := 0;
  533.     WITH pAs[id] DO BEGIN
  534.       IF UseLowRes THEN COfs := LowResOfs ELSE COfs := 0;
  535.       rID := ResID;
  536.       hBM := LoadBitmap(hInstance,
  537.                         MakeIntResource(rID + COfs));
  538.       hBMSel := LoadBitmap(hInstance,
  539.                 MakeIntResource(SecPanelOfs + rID + COfs));
  540.       (* Bitmap nicht gefunden *)
  541.       IF (hBM = 0) THEN BEGIN
  542.         Flags := tb_Null;
  543.         InsertPanel := -1;
  544.       END ELSE BEGIN
  545.         (* Focus setzen, wenn dieser noch ungⁿltig ist *)
  546.         IF (Focus = -1) AND
  547.            (tbStyle AND tbs_MultiSel = 0) THEN BEGIN
  548.           Focus := id;
  549.           Flags := tb_Selected;
  550.         END ELSE Flags := tb_Normal;
  551.       END;
  552.       DrawPanel(0, id, Flags);
  553.     END; (* WITH *)
  554.   END ELSE InsertPanel := -1;
  555. END;
  556.  
  557. PROCEDURE tToolBox.DrawEmptyPanel(VAR dc: HDC;
  558.                                   x, y, w, h: INTEGER);
  559. (*--------------------------------------------------------*)
  560. (* Wird aufgerufen, wenn ein ╗leeres½ Panel zu zeichnen   *)
  561. (* ist.                                                   *)
  562. (* DC   : Device-Kontext                                  *)
  563. (* x, y : Obere linke Ecke des Rechtecks                  *)
  564. (* w, h : Breite und H÷he des zu zeichnenden Bereiches    *)
  565. VAR
  566.   OPen  : hPen;
  567.   Pen   : hPen;
  568.   OBrush: HBrush;
  569.   Brush : HBrush;
  570. BEGIN
  571.   Brush := CreateSolidBrush(GetNearestColor
  572.                             (dc, RGB( 193, 193, 193)));
  573.   OBrush := SelectObject(dc, Brush);
  574.   Pen := CreatePen(ps_Solid, 1,
  575.                    GetNearestColor(dc, RGB(193, 193, 193)));
  576.   OPen := SelectObject(dc, Pen);
  577.   Rectangle(dc, x, y, x + w, y + h);
  578.   SelectObject(dc, OPen);
  579.   DeleteObject(Pen);
  580.   SelectObject(dc, OBrush);
  581.   DeleteObject(Brush);
  582. END;
  583.  
  584. PROCEDURE tToolBox.NotifyParent(PanelID, Msg: INTEGER);
  585. (*--------------------------------------------------------*)
  586. (* Sendet eine Nachricht an das Parent-Window. Basierend  *)
  587. (* auf der ID des TB-Windows und der ID des Paneles.      *)
  588.  
  589. BEGIN
  590.   IF tbStyle AND tbs_MultiMsg <> 0 THEN
  591.     (* Fⁿr jedes Panel eine eigene Botschaft *)
  592.     SendMessage(Parent^.hWindow, wm_First + wm_User +
  593.                 pId + PanelID, Msg, pAs[PanelID].rID)
  594.   ELSE
  595.     (* Sammelbotschaft *)
  596.     SendMessage(Parent^.hWindow, wm_First + wm_User + pId,
  597.           Msg, LONGINT(PanelID) SHL 16 OR pAs[PanelID].rID);
  598. END;
  599.  
  600.  
  601. PROCEDURE tToolBox.DrawPanel(dc: HDC; id, Mode: INTEGER);
  602. (*--------------------------------------------------------*)
  603. (* Zeichnet das Element ID und setzt das Statusfeld des   *)
  604. (* Elementes auf Mode. Wird in DC 0 ⁿbergeben, holt sich  *)
  605. (* die Funktion einen eigenen Device Context.             *)
  606. CONST
  607.   (* Brush-Pattern fⁿr Disabled-Items *)
  608.   Pattern : ARRAY[0..7] OF WORD =
  609.                    ($AA, $55, $AA, $55, $AA, $55, $AA, $55);
  610. VAR
  611.   MemDC  : HDC;
  612.   x, y   : INTEGER;
  613.   State  : INTEGER;
  614.   MadeDC : BOOLEAN;
  615.   hBM    : hBitmap;
  616.   hOBrush: HBrush;
  617.   hHBrush: HBrush;
  618. BEGIN
  619.   x := (id MOD Cols) * bm_Width;
  620.   y := id DIV Cols * bm_Height;
  621.   IF dc = 0 THEN BEGIN
  622.     dc := GetDC(hWindow);
  623.     MadeDC := TRUE
  624.   END ELSE MadeDC := FALSE;
  625.  
  626.   (* Leeres Panel *)
  627.   IF pAs[id].Flags = tb_Null THEN BEGIN
  628.     DrawEmptyPanel(dc, x, y, bm_Width, bm_Height);
  629.     IF MadeDC THEN ReleaseDC(hWindow, dc);
  630.     Exit;
  631.   END;
  632.  
  633.   MemDC := CreateCompatibleDC(dc);
  634.   IF (Mode = tb_Normal) OR (Mode = tb_Disabled) THEN
  635.     SelectObject(MemDC, pAs[id].hBM)
  636.   ELSE IF Mode = tb_Selected THEN
  637.      SelectObject(MemDC, pAs[id].hBMSel)
  638.   ELSE IF Mode = tb_Toggle THEN BEGIN
  639.     State := GetPanelState(id);
  640.     IF State = tb_Selected THEN BEGIN
  641.       Mode := tb_Normal;
  642.       SelectObject(MemDC, pAs[id].hBM)
  643.     END ELSE IF State = tb_Normal THEN BEGIN
  644.       Mode := tb_Selected;
  645.       SelectObject(MemDC, pAs[id].hBMSel)
  646.     END ELSE Mode := tb_Disabled;
  647.   END ELSE IF Mode = tb_Null THEN BEGIN
  648.     DrawEmptyPanel(dc, x, y, bm_Width, bm_Height);
  649.   END;
  650.  
  651.   pAs[id].Flags := Mode;
  652.   BitBlt(dc, x, y,bm_Width, bm_Height,
  653.          MemDC, 0, 0, SrcCopy);
  654.   IF Mode = tb_Disabled THEN BEGIN
  655.     (* Dithered-Darstellung *)
  656.     hBM     := CreateBitmap(8, 8, 1, 1, @Pattern);
  657.     hHBrush := CreatePatternBrush(hBM);
  658.     hOBrush := SelectObject(dc,hHBrush);
  659.     BitBlt(dc, x, y, bm_Width, bm_Height,
  660.            MemDC, 0, 0, MergeCopy);
  661.     SelectObject(dc, hOBrush);
  662.     DeleteObject(hHBrush);
  663.     DeleteObject(hBM);
  664.   END;
  665.   DeleteDC(MemDC);
  666.   IF MadeDC THEN ReleaseDC(hWindow,dc);
  667. END;
  668.  
  669. PROCEDURE tToolBox.Paint(PaintDC: HDC;
  670.                          VAR PaintInfo: tPaintStruct);
  671. (*--------------------------------------------------------*)
  672. (* Zeichnet den Hintergrund und alle Panels neu.          *)
  673. VAR i : INTEGER;
  674. BEGIN
  675.   tWindow.Paint(PaintDC,PaintInfo);
  676.   FOR i := 0 TO Rows * Cols - 1 DO
  677.     DrawPanel(PaintDC, i,pAs[i]. Flags)
  678. END;
  679.  
  680. PROCEDURE tToolBox.wmMove (VAR Msg: tMessage);
  681. (*--------------------------------------------------------*)
  682. (* Speichert beim Bewegen des Fensters die neuen          *)
  683. (* Koordinaten in xClient und yClient.                    *)
  684. BEGIN
  685.   xClient := INTEGER(Msg.lParamLo);
  686.   yClient := INTEGER(Msg.lParamHi);
  687.   tWindow.wmMove(Msg);
  688. END;
  689.  
  690. PROCEDURE tToolBox.wmMouseMove(VAR Msg: tMessage);
  691. (*--------------------------------------------------------*)
  692. (* Verfolgt die Mausbewegungen bei gedrⁿckter link. Taste *)
  693. VAR
  694.   r  : tRect;
  695.   pt : tPoint;
  696. BEGIN
  697.   (* Linke Taste mu▀ innerhalb des TB-Windows gedrⁿckt *)
  698.   (* worden sein!                                      *)
  699.   IF NOT InWindow OR (Msg.wParam AND mk_LButton = 0) OR
  700.      IsIconic(hWindow) THEN Exit;
  701.   GetClientRect(hWindow,r);
  702.   pt.x := INTEGER(Msg.lParamLo);
  703.   pt.y := INTEGER(Msg.lParamHi);
  704.   IF NOT PtInRect(r,pt) THEN
  705.     (* Au▀erhalb des Fensters *)
  706.     DrawPanel(0, MsDnID, ActState)
  707.   ELSE BEGIN
  708.     (* Innerhalb => Panel-ID berechnen *)
  709.     IF (Msg.lParamLo DIV bm_Width) +
  710.        (Cols*(Msg.lParamHi DIV bm_Height)) <> MsDnID THEN
  711.       (* Nicht dasselbe Panel wie bei MsDown *)
  712.       DrawPanel(0,MsDnID,ActState)
  713.     ELSE BEGIN
  714.       (* Im neuen Zustand zeichen *)
  715.       IF ActState AND tb_Selected <> 0 THEN
  716.         DrawPanel(0, MsDnID, tb_Normal)
  717.       ELSE
  718.         DrawPanel(0, MsDnID, tb_Selected);
  719.     END;
  720.   END;
  721. END;
  722.  
  723. PROCEDURE tToolBox.wmlButtonDown(VAR Msg: tMessage);
  724. (*--------------------------------------------------------*)
  725. (* Speichert die Maus-Koordinaten beim Drⁿcken der Taste  *)
  726. (* und zeichnet das Panel neu.                            *)
  727. BEGIN
  728.   IF IsIconic(hWindow) THEN Exit;
  729.   (* Linke Taste innerhalb des FM-Windows gedrⁿckt *)
  730.   InWindow := TRUE;
  731.   BringWindowToTop(hWindow);
  732.   MsDnID := (Msg.lParamLo DIV bm_Width) +
  733.             (Cols * (Msg.lParamHi DIV bm_Height));
  734.   (* Status des Panels beim Drⁿcken merken *)
  735.   ActState := pAs[MsDnID].Flags;
  736.   IF (ActState = tb_Disabled) OR
  737.      (ActState = tb_Null) THEN BEGIN
  738.     (* Ungⁿltige Position/Panelzustand *)
  739.     MessageBeep(0);
  740.     InWindow := FALSE;
  741.   END;
  742.   DrawPanel(0, MsDnID, tb_Toggle);
  743.  (* Alle Mausnachrichten gehen ab jetzt an das FM-Fenster *)
  744.   SetCapture(hWindow);
  745.   tWindow.wmlButtonDown(Msg);
  746. END;
  747.  
  748. PROCEDURE tToolBox.wmlButtonUp(VAR Msg: tMessage);
  749. (*--------------------------------------------------------*)
  750. (* Verarbeitet das Loslassen der Taste. Stellt den Status *)
  751. (* fest und sendet einen Nachricht an das Eltern-Fenster. *)
  752. VAR
  753.   i, j : INTEGER;
  754.   r    : tRect;
  755.   pt   : tPoint;
  756. BEGIN
  757.   IF IsIconic(hWindow) THEN Exit;
  758.   InWindow := FALSE;
  759.   ReleaseCapture;
  760.   GetClientRect(hWindow,r);
  761.   pt.x := INTEGER(Msg.lParamLo);
  762.   pt.y := INTEGER(Msg.lParamHi);
  763.   (* Nur wenn Maus im Fenster *)
  764.   IF PtInRect(r,pt) THEN BEGIN
  765.     i := (Msg.lParamLo DIV bm_Width) +
  766.          (Cols * (Msg.lParamHi DIV bm_Height));
  767.     IF i = MsDnID THEN BEGIN
  768.       (* Gleiche Position wie bei MsDown *)
  769.       pAs[i].Flags := ActState;
  770.       IF tbStyle AND tbs_MultiSel <> 0 THEN BEGIN
  771.         (* MultiSel *)
  772.         IF pAs[i].Flags = tb_Selected THEN BEGIN
  773.           DrawPanel(0, i, tb_Normal);
  774.           NotifyParent(i, tbm_Unselect);
  775.         END ELSE IF pAs[i].Flags = tb_Normal THEN BEGIN
  776.           DrawPanel(0, i, tb_Selected);
  777.           NotifyParent(i, tbm_Select);
  778.         END;
  779.       END ELSE BEGIN                                      (* Single *)
  780.         (* Fokus Σndern *)
  781.         IF (pAs[i].Flags <> tb_Disabled) AND
  782.            (pAs[i].Flags <> tb_Null) THEN BEGIN
  783.           DrawPanel(0, Focus, tb_Normal);
  784.           DrawPanel(0, i, tb_Selected);
  785.           IF i <> Focus THEN BEGIN
  786.             NotifyParent(Focus, tbm_Unselect);
  787.             NotifyParent(i, tbm_Select);
  788.           END;
  789.         END ELSE i := Focus;
  790.       END;
  791.       Focus := i;
  792.     END; (* i = MsDnID *)
  793.   END; (* PtInRect *)
  794. END;
  795.  
  796. END.
  797.  
  798. (**********************************************************)
  799. (*                  Ende von TBWIN.PAS                    *)
  800.