home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / D12 / PAINT.ZIP / PALETTE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-01  |  4.3 KB  |  136 lines
  1. {************************************************}
  2. {                                                }
  3. {   ObjectWindows Paint demo                     }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. unit Palette;
  9.  
  10. { This unit defines a color palette window for the Paint program. The color
  11.   palette is responsible for displaying the available colors, maintaining
  12.   and displaying the current pen and brush colors and provides the interface
  13.   for color selection.
  14. }
  15.  
  16. interface
  17.  
  18. uses PaintDef, WinTypes, WinProcs, OWindows;
  19.  
  20. type
  21.  
  22.   PPalette = ^TPalette;
  23.   TPalette = object(TWindow)
  24.     State: PState;
  25.  
  26.     { Creation }
  27.     constructor Init(AParent: PWindowsObject; AState: PState);
  28.  
  29.     { Utility }
  30.     procedure SelectColor(var Msg: TMessage; var Color: TColorRef);
  31.  
  32.     { Display }
  33.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  34.  
  35.     { Window manager responses }
  36.     procedure WMLButtonDown(var Msg: TMessage);
  37.       virtual wm_First + wm_LButtonDown;
  38.     procedure WMRButtonDown(var Msg: TMessage);
  39.       virtual wm_First + wm_RButtonDown;
  40.   end;
  41.  
  42. implementation
  43.  
  44. const
  45.  
  46.   { The available colors in RGB format }
  47.   Colors: array[0..2, 0..15] of TColorRef = (
  48.     ($FFFFFF,$E0E0E0,$C0C0FF,$C0E0FF,$E0FFFF,$C0FFC0,$FFFFC0,$FFC0C0,
  49.      $FFC0FF,$0000C0,$0040C0,$00C0C0,$00C000,$C0C000,$C00000,$C000C0),
  50.     ($C0C0C0,$404040,$8080FF,$80C0FF,$80FFFF,$80FF80,$FFFF80,$FF8080,
  51.      $FF80FF,$000080,$004080,$008080,$008000,$808000,$800000,$800080),
  52.     ($808080,$000000,$0000FF,$0080FF,$00FFFF,$00FF00,$FFFF00,$FF0000,
  53.      $FF00FF,$000040,$404080,$004040,$004000,$404000,$400000,$400040));
  54.  
  55.  
  56. { Create the palette.
  57. }
  58. constructor TPalette.Init(AParent: PWindowsObject; AState: PState);
  59. begin
  60.   TWindow.Init(AParent, nil);
  61.   Attr.Style := ws_Child or ws_Visible;
  62.   State := AState;
  63. end;
  64.  
  65. { Set the Color variable to the color pressed on in the palette window.
  66.   (Mouse click information contained in Msg.)
  67.   Cause the display to be updated.
  68. }
  69. procedure TPalette.SelectColor(var Msg: TMessage; var Color: TColorRef);
  70. var
  71.   X, Y, S: Integer;    { Column, Row clicked on; Height of color squares }
  72.   R: TRect;        { Window client area }
  73. begin
  74.   GetClientRect(HWindow, R);
  75.   S := R.bottom div 17;
  76.   X := Msg.LParamLo div S;
  77.   Y := Msg.LParamHi div S;
  78.   if (X < 3) and (Y < 16) then
  79.   begin
  80.     Color := Colors[X, Y];
  81.     InvalidateRect(HWindow, nil, False);
  82.   end;
  83. end;
  84.  
  85. { Paint the palette window by painting the available colors in 3 columns of
  86.   16 rows. The 17th row spans all three columns and is used to display the
  87.   currently selected pen and brush colors.
  88. }
  89. procedure TPalette.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  90. var
  91.   X, Y, S: Integer;    { Column, Row; Height of row }
  92.   OldPen: HPen;        { Original pen in drawing context }
  93.   OldBrush: HBrush;    { Original brush in drawing context }
  94.   R: TRect;        { Window client area }
  95. begin
  96.   GetClientRect(HWindow, R);
  97.  
  98.   { Draw the color panes using a solid brush of the appropriate color }
  99.   S := R.bottom div 17;
  100.   for Y := 0 to 15 do
  101.     for X := 0 to 2 do
  102.     begin
  103.       OldBrush := SelectObject(PaintDC,
  104.         CreateSolidBrush(Colors[X, Y]));
  105.       Rectangle(PaintDC, X * S, Y * S, (X + 1) * S + 1, (Y + 1) * S + 1);
  106.       DeleteObject(SelectObject(PaintDC, OldBrush));
  107.     end;
  108.  
  109.   { Paint the frame around the current color pane }
  110.   SelectObject(PaintDC, GetStockObject(null_brush));
  111.   Rectangle(PaintDC, 0, S * 16, R.right, R.bottom);
  112.   
  113.   { Paint the current colors square with the current colors }
  114.   OldPen := SelectObject(PaintDC, CreatePen(ps_Solid, 5, State^.PenColor));
  115.   OldBrush := SelectObject(PaintDC, CreateSolidBrush(State^.BrushColor));
  116.   Rectangle(PaintDC, 3, S * 16 + 3, R.right - 3, R.bottom - 3);
  117.  
  118.   { Restore the DC to its original state }
  119.   DeleteObject(SelectObject(PaintDC, OldBrush));
  120.   DeleteObject(SelectObject(PaintDC, OldPen));
  121. end;
  122.  
  123. { Select the current pen and brush colors in response to mouse clicks.
  124. }
  125. procedure TPalette.WMLButtonDown(var Msg: TMessage);
  126. begin
  127.   SelectColor(Msg, State^.PenColor);
  128. end;
  129.  
  130. procedure TPalette.WMRButtonDown(var Msg: TMessage);
  131. begin
  132.   SelectColor(Msg, State^.BrushColor);
  133. end;
  134.  
  135. end.
  136.