home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / om / buttons.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-08  |  9.0 KB  |  313 lines
  1. {Buttons - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
  2. unit Buttons;
  3. {************************  Interface    ***********************}
  4. interface
  5. uses WinTypes, WinProcs, WinDos, Strings, WObjects,WIN31,ShellAPI;
  6. type
  7.     hDrop=THandle;
  8. type
  9. PODButton = ^TODButton;
  10. TODButton = object(TButton)
  11.     HBmp :HBitmap;
  12.   State:Integer;
  13.   X,Y,W,H:Integer;
  14.   constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  15.       X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar);
  16.   destructor    Done;virtual;
  17.   procedure    DrawItem(var Msg:TMessage);virtual;
  18.   procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  19. end;
  20.  
  21. PDDButton = ^TDDButton;
  22. TDDButton = object(TODButton)
  23.     BMPName:Array[0..79] of Char;
  24.     constructor Init(AParent:PwindowsObject;AnID:Integer;ATitle:PChar;
  25.       X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar);
  26.     procedure SetupWindow;virtual;
  27.   function CanClose:Boolean;virtual;
  28.   procedure ChangeBMP(BMPFile:PChar);
  29.   procedure IconToBMP;virtual;
  30.   procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  31. end;
  32.  
  33. PIcon = ^TIcon;
  34. TIcon = object(TRadioButton)
  35.     HBmp :HBitmap;
  36.   State:Integer;
  37.   constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  38.       X,Y,W,H:Integer;AGroup:PGroupBox;BMP:PChar);
  39.   destructor    Done;virtual;
  40.   procedure    DrawItem(var Msg:TMessage);virtual;
  41. end;
  42.  
  43. PIconGroup = ^TIconGroup;
  44. TIconGroup = object(TGroupBox)
  45.     OldIcon:PIcon;
  46.   OldIconID:Integer;
  47.   constructor Init(AParent:PWindowsObject;AnID:Integer;AText:PChar;
  48.       X,Y,W,H:Integer);
  49.     procedure SelectionChanged(NewIconID:Integer);virtual;
  50. end;
  51.  
  52. {************************  Implementation      **********************}
  53. implementation
  54. const
  55.     sr_Recessed = 1;
  56.   sr_Raised   = 0;
  57. {************************  DrawHiLites   ****************************}
  58. function DrawHilites(PaintDC:hDC;X1,Y1,X2,Y2,LW,State:Integer):Boolean;
  59. var
  60.   LPts,RPts:Array[0..2] of TPoint;
  61.   Pen1,Pen2,OldPen:HPen;
  62.   Ofs,W,H:Integer;
  63.   OldBrush:HBrush ;
  64. begin
  65.      Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  66.   OldPen := SelectObject(PaintDC,Pen1);
  67.   OldBrush := SelectObject(PaintDC,GetStockObject(null_Brush));
  68.   Rectangle(PaintDC,X1,Y1,X2,Y2);
  69.   SelectObject(PaintDC,OldPen);
  70.   SelectObject(PaintDC,OldBrush);
  71.   DeleteObject(Pen1);
  72.   Ofs := Byte(State = sr_Recessed) * lw;
  73.  
  74.     LPts[0].x := X1+Ofs;   LPts[0].y := Y2-Ofs;
  75.     LPts[1].x := X1+Ofs;   LPts[1].y := Y1+Ofs;
  76.   LPts[2].x := X2-Ofs;   LPts[2].y := Y1+Ofs;
  77.   RPts[0].x := X1+Ofs;   RPts[0].y := Y2-Ofs;
  78.     RPts[1].x := X2-Ofs;   RPts[1].y := Y2-Ofs;
  79.     RPts[2].x := X2-Ofs;   RPts[2].y := Y1+Ofs;
  80.   if State = sr_Raised then
  81.       begin
  82.         Pen1 := CreatePen(ps_Solid,LW,$00FFFFFF);
  83.     Pen2 := CreatePen(ps_Solid,LW,$00000000);
  84.     end
  85.   else
  86.       begin
  87.       Pen1 := CreatePen(ps_Solid,LW,$00000000);
  88.         Pen2 := CreatePen(ps_Solid,LW,$00FFFFFF);
  89.     end;
  90.  
  91.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  92.   PolyLine(PaintDC,LPts,3);
  93.   SelectObject(PaintDC,Pen2);
  94.   DeleteObject(Pen1);
  95.   PolyLine(PaintDC,RPts,3);
  96.   SelectObject(PaintDC,OldPen);
  97.   DeleteObject(Pen2);
  98. end;
  99.  
  100. constructor    TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  101.        X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar);
  102. begin
  103.     TButton.Init(AParent,AnID,ATitle,X1,Y1,W1,H1,IsDefault);
  104.   Attr.Style := Attr.Style or bs_OwnerDraw;
  105.   HBmp := LoadBitmap(HInstance,BMP);
  106.   X:= X1;Y:= Y1;H:=H1;W:= W1;
  107. end;
  108.  
  109. destructor    TODButton.Done;
  110. begin
  111.     DeleteObject(HBmp);
  112.     TButton.Done;
  113. end;
  114.  
  115. procedure    TODButton.DrawItem(var Msg:TMessage);
  116. var
  117.     TheDC,MemDC:HDc;
  118.     ThePen,Pen1,Pen2,OldPen:HPen;
  119.   TheBrush,OldBrush:HBrush;
  120.   OldBitMap:HBitMap;
  121.   LPts,RPts:Array[0..2] of TPoint;
  122.   PDIS :^TDrawItemStruct;
  123.   PenWidth,OffSet:Integer;
  124.   DBU:LongRec;
  125. begin
  126.     LongInt(DBU) := GetDialogBaseUnits;
  127.     PDIS := Pointer(Msg.lParam);
  128.   if PDIS^.itemAction = oda_Focus then Exit;
  129.     if ((PDIS^.itemAction and oda_Select ) > 0) and
  130.       ((PDIS^.itemState and ods_Selected) > 0) then
  131.     State := sr_Recessed else State := sr_Raised;    {1 = depressed}
  132.   OffSet := Round((H) / (DBU.lo * 4));               {scale highlites based on size}
  133.   PenWidth := OffSet;
  134.   MemDC := CreateCompatibleDC(PDIS^.HDC);
  135.   OldBitMap := SelectObject(MemDC,HBMP);
  136.   if State = sr_Raised then BitBlt(PDIS^.HDC,0,0,W,H, MemDC,0,0,SrcCopy)
  137.       else BitBlt(PDIS^.HDC,OffSet,OffSet,W,H, MemDC,0,0,SrcCopy);
  138.   SelectObject(MemDC,OldBitMap);
  139.   DeleteDC(MemDC);
  140.   DrawHiLites(PDIS^.hDC,0,0,Pred(W),Pred(H),OffSet,State)
  141. end;
  142.  
  143. procedure TODButton.WMRButtonDown(var Msg:TMessage);
  144. begin
  145.     SendMessage(Parent^.HWindow,wm_User+wm_RButtonDown,Integer(GetID),0);
  146. end;
  147. {********************* TDDButton  *****************************}
  148. constructor TDDButton.Init(AParent:PwindowsObject;AnID:Integer;ATitle:PChar;
  149.       X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar);
  150. begin
  151.     TODButton.Init(AParent,AnId,ATitle,X1,Y1,W1,H1,IsDefault,'');
  152.   if BMP <> NiL then
  153.       StrCopy(BMPName,BMP)
  154.     else StrCopy(BMPName,'');
  155. end;
  156.  
  157. procedure TDDButton.SetupWindow;
  158. var
  159.   FileNameBuf:Array[0..79] of Char;
  160.   Icon:hIcon;
  161.   MemDC,DC:HDC;
  162.   OldBmp,NewBmp:HBitmap;
  163.   OldBrush:HBrush;
  164. begin
  165.     TODButton.SetupWindow;
  166.   DragAcceptFiles(HWindow,TRUE);
  167.     IconToBmp;
  168. end;
  169.  
  170. function TDDButton.CanClose:Boolean;
  171. begin
  172.     DragAcceptFiles(HWindow,FALSE);
  173.     CanClose := TODButton.CanClose;
  174. end;
  175.  
  176. procedure TDDButton.WMDropFiles(var Msg:TMessage);
  177. var
  178.     DropItem:hDrop;
  179.   FileNameBuf:Array[0..fsPathName] of Char;
  180.   NewIcon:hIcon;
  181.   GFileName:PChar;
  182.   CtrlID:Integer;
  183. begin
  184.     DropItem := Msg.wParam;
  185.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  186.   GFileName :=StrNew(FileNameBuf);
  187.   StrCopy(BMPName,FileNameBuf);
  188.   IconToBmp;
  189.   DragFinish(DropItem);
  190.   CtrlID := GetID;
  191.   SendMessage(Parent^.HWindow,wm_User+wm_DropFiles,CtrlID,LongInt(GFileName));
  192.   StrDispose(GFileName);
  193. end;
  194.  
  195. procedure TDDButton.ChangeBMP(BMPFile:PChar);
  196. begin
  197.     if HBmp = 0 then
  198.       Exit;
  199.   StrCopy(BMPName,BMPFile);
  200.   IconToBMP;
  201. end;
  202.  
  203. procedure TDDButton.IconToBMP;
  204. var
  205.   Icon:hIcon;
  206.   MemDC,DC:HDC;
  207.   OldBmp:HBitmap;
  208.   OldBrush:HBrush;
  209. begin
  210.   Icon := ExtractIcon(HInstance,BMPName,0);
  211.     DeleteObject(HBmp);
  212.   DC := GetDC(HWindow);
  213.   hBmp := CreateCompatibleBitmap(DC,W,H);
  214.   MemDC := CreateCompatibleDC(DC);
  215.   OldBmp := SelectObject(MemDC,hBmp);
  216.   OldBrush := SelectObject(MemDC,GetStockObject(ltGray_Brush));
  217.   PatBlt(MemDC,0,0,Pred(W),Pred(H),PatCopy);
  218.   if Icon <> 0 then
  219.       DrawIcon(MemDC,1,1,Icon)
  220.   else
  221.       Rectangle(MemDC,0,0,W,H);
  222.   SelectObject(MemDC,OldBmp);
  223.   SelectObject(MemDC,OldBrush);
  224.   DeleteDC(MemDC);
  225.   ReleaseDC(hWindow,DC);
  226.   InvalidateRect(HWindow,nil,True);
  227.   UpdateWindow(HWindow);
  228. end;
  229.  
  230. {********************* TIcon  *****************************}
  231. constructor    TIcon.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  232.        X,Y,W,H:Integer;AGroup:PGroupBox;BMP:PChar);
  233. begin
  234.     TRadioButton.Init(AParent,AnID,ATitle,X,Y,W,H,AGroup);
  235.   Attr.Style := Attr.Style or bs_OwnerDraw;
  236.   HBmp := LoadBitmap(HInstance,BMP);
  237.   State := sr_Raised;
  238. end;
  239.  
  240. destructor    TIcon.Done;
  241. begin
  242.     DeleteObject(HBmp);
  243.     TRadioButton.Done;
  244. end;
  245.  
  246. procedure    TIcon.DrawItem(var Msg:TMessage);
  247. var
  248.     TheDC,MemDC:HDc;
  249.   OldBitMap:HBitMap;
  250.   Offset:Integer;
  251.   PDIS :^TDrawItemStruct;
  252.   X,Y,W,H:Integer;
  253.   DBU:LongRec;
  254.   GKS:Integer;
  255. begin
  256.     LongInt(DBU) := GetDialogBaseUnits;
  257.     PDIS := Pointer(Msg.lParam);
  258.   GKS := GetKeyState(vk_LButton);
  259.   If IsIconic(hWindow) then Exit;
  260.   if (PDIS^.itemAction = oda_DrawEntire)     then
  261.      State := State
  262.   else if (PDIS^.itemAction = oda_Select) and
  263.   (PDIS^.ItemState = ods_Selected + ods_Focus)
  264.       then State := sr_Recessed
  265.   else if (PDIS^.itemAction = 2) and
  266.   (PDIS^.ItemState = ods_Focus) and (GKS < 0)
  267.       then State := sr_Raised
  268.   else Exit;
  269.   X := PDIS^.rcItem.left;    Y := PDIS^.rcItem.top;
  270.   W := PDIS^.rcItem.right-PDIS^.rcItem.left;
  271.   H := PDIS^.rcItem.bottom-PDIS^.rcItem.top;
  272.   OffSet := Round((H) / (DBU.lo * 4));
  273.   MemDC := CreateCompatibleDC(PDIS^.HDC);
  274.   OldBitMap := SelectObject(MemDC,HBMP);
  275.   if State = 0 then BitBlt(PDIS^.HDC,X,Y,W,H, MemDC,0,0,SrcCopy)
  276.       else BitBlt(PDIS^.HDC,X+OffSet,Y+OffSet,W,H, MemDC,0,0,SrcCopy);
  277.   SelectObject(MemDC,OldBitMap);
  278.   DeleteDC(MemDC);
  279.   DrawHiLites(PDIS^.hDC,X,Y,PDIS^.rcItem.Right,PDIS^.rcitem.Bottom,OffSet,State)
  280. end;
  281. {******************  TIconGroup   ******************************}
  282. constructor TIconGroup.Init(AParent:PWindowsObject;AnID:Integer;AText:PChar;
  283.       X,Y,W,H:Integer);
  284. begin
  285.     TGroupBox.Init(AParent,AnId,AText,X,Y,W,H);
  286.   Attr.Style := Attr.Style and not ws_Visible;
  287.   OldIcon := nil;
  288.   OldIconID := 0;
  289. end;
  290.  
  291. procedure TIconGroup.SelectionChanged(NewIconID:Integer);
  292. begin
  293.     TGroupBox.SelectionChanged(NewIconID);
  294.   if NewIconID = OldIconID then
  295.       Exit;
  296.     If OldIcon = nil then
  297.       begin
  298.       OldIcon := PIcon(Parent^.ChildWithID(NewIconID));
  299.     OldIconID := NewIconID;
  300.     end
  301.   else
  302.       begin
  303.     OldIcon^.State := sr_Raised;
  304.     InvalidateRect(OldIcon^.HWindow,nil,True);
  305.     OldIcon := PIcon(Parent^.ChildWithID(NewIconID));
  306.     OldIconID := NewIconID;
  307.     end;
  308. end;
  309.  
  310.  
  311.  
  312. end.
  313.