[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]

program Color;

{$R color.res }

uses
  WinProcs,
  WinTypes,
  WObjects;

const
  White        = $00FFFFFF;
  Black        = $00000000;
  LightGray    = $00C0C0C0;
  DarkGray     = $00808080;
  Cyan         = $00FFFF00;
  Magenta      = $00FF00FF;
  Yellow       = $0000FFFF;
  Red          = $000000FF;
  Green        = $0000FF00;
  Blue         = $00FF0000;
  LightBlue    = $00800000;
  LightCyan    = $00808000;
  LightMagenta = $00800080;
  Brown        = $00008080;
  LightRed     = $00000080;
  LightGreen   = $00008000;

const
  id_Color = 101;

type
  PColorDialog = ^TColorDialog;
  TColorDialog = object(TDialog)
    ColorPtr : ^longint;
    constructor Init(AParent : PWindowsObject; var AColor : longint);
    procedure SetupWindow; virtual;
    function CanClose : boolean; virtual;
    procedure wmDrawItem(var Msg : TMessage); virtual wm_First+wm_DrawItem;
    procedure wmMeasureItem(var Msg : TMessage); virtual wm_First+wm_MeasureItem;
  end;

constructor TColorDialog.Init(AParent : PWindowsObject; var AColor : longint);
begin
  TDialog.Init(AParent,'ColorDlg');
  ColorPtr := @AColor;
end; { Init }

procedure TColorDialog.SetupWindow;
const
  NColors = 16;
  StdColors : array[1..NColors] of longint =
   (White, Black, LightGray, DarkGray, Cyan, Magenta, Yellow, Red, Green,
    Blue, LightBlue, LightCyan, LightMagenta, Brown, LightRed, LightGreen);

  procedure SetupColors(ID : integer; Color : longint);
  var
    i,Sel : integer;
  begin
    Sel := -1;
    for i := 1 to NColors do begin
      SendDlgItemMsg(ID,cb_AddString,0,StdColors[i]);
      if StdColors[i] = Color then Sel := pred(i);
    end;
    if Sel = -1 then begin
      SendDlgItemMsg(ID,cb_AddString,0,Color);
      Sel := NColors;
    end;
    SendDlgItemMsg(ID,cb_SetCurSel,Sel,0);
  end; { SetupColors }

begin { SetupWindow }
  TDialog.SetupWindow;
  SetupColors(id_Color,ColorPtr^);
end; { SetupWindow }

function TColorDialog.CanClose : boolean;

  procedure GetCol(ID : integer; var Color : longint);
  var
    Sel : integer;
  begin
    Sel := SendDlgItemMsg(ID,cb_GetCurSel,0,0);
    if Sel > -1 then
      SendDlgItemMsg(ID,cb_GetLBText,Sel,longint(@Color));
  end; { GetCol }

begin { CanClose }
  GetCol(id_Color,ColorPtr^);
  CanClose := true;
end; { CanClose }


procedure TColorDialog.wmDrawItem(var Msg : TMessage);
var
  Brush : HBrush;
begin
  with PDrawItemStruct(Msg.lParam)^ do begin
    if CtlType = odt_ComboBox then begin
      if ((ItemAction and oda_DrawEntire) <> 0) or
         ((ItemAction and oda_Select) <> 0) then begin
        Brush := CreateSolidBrush(ItemData);
        FillRect(hDC,rcItem,Brush);
        DeleteObject(Brush);
      end;
      if ((ItemState and ods_Focus) <> 0) or
         ((ItemState and ods_Selected) <> 0) then begin
        InflateRect(rcItem,-2,-2);
        DrawFocusRect(hDC,rcItem);
      end;
    end;
  end;
end; { wmDrawItem }

procedure TColorDialog.wmMeasureItem(var Msg : TMessage);
begin
  PMeasureItemStruct(Msg.lParam)^.ItemHeight := 16;
end; { wmMeasureItem }

const
  cm_Color = 100;

type
  PColorWindow = ^TColorWindow;
  TColorWindow = object(TWindow)
    Color : longint;
    constructor Init;
    procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
    procedure CMColor(var Msg: TMessage);
      virtual cm_First + cm_Color;
  end;

constructor TColorWindow.Init;
begin
  Color := White;
  TWindow.Init(nil, 'Color Combo Demo');
  Attr.Menu := LoadMenu(HInstance, 'Menu');
end; { Init }

procedure TColorWindow.cmColor(var Msg: TMessage);
begin
  if Application^.ExecDialog(
       New(PColorDialog,Init(@Self,Color))) = id_Ok then
    InvalidateRect(HWindow,nil,true);
end; { cmColor }

procedure TColorWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
var
  Brush : HBrush;
begin
  Brush := CreateSolidBrush(Color);
  FillRect(PaintDC,PaintInfo.rcPaint,Brush);
  DeleteObject(Brush);
end; { Paint }

type
  TColorApp = object(TApplication)
    procedure InitMainWindow; virtual;
  end;

procedure TColorApp.InitMainWindow;
begin
  MainWindow := New(PColorWindow,Init);
end; { InitMainWindow }

var
  ColorApp: TColorApp;

begin
  ColorApp.Init('Menu');
  ColorApp.Run;
  ColorApp.Done;
end.

{ -------------------------  COLOR.RES ----------------------- }

{ USE XX3402 to decode the following block                              }
{ Cut out and name COLOR.XX.  Use XX3402 d COLOR.XX to create COLOR.RES }

{ ------------------------    CUT -----------------------------}

*XX3402-000206-140792--72--85-25021-------COLOR.RES--1-OF--1
zkE+HIJCJE+k2+w+++++++++U+-Y+0N1PqljQU1z-E-1HolDIYFAFk+k25I+++1++AW+-3Q+
7U-l+2s+++-1O4xjQqIUMqxgPr6+0+-6NKlq++Q+0E+M++c+zzw+++-EUYBjP4xmCU++6++4
+-s+D+-Z+-A+6J03++-4++M+6k+A++2++E+-I6-DOk++FU+N+0A+1++0+++++J0+Eq3iMqJg
++1z1k1z+E+k2-s++++A++E++M++HIJCJE+E++I++c++EoxAHp72H2Q+++++
***** END OF BLOCK 1 *****

[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]