home *** CD-ROM | disk | FTP | other *** search
- {************************************************}
- { }
- { Turbo Pascal for Windows }
- { Tips & Techniques Demo Program }
- { Copyright (c) 1991 by Borland International }
- { }
- {************************************************}
-
- program OwnerDrawDemo;
-
- uses WinTypes, WinProcs, WObjects, Strings;
-
- const
- id_Button = 100;
-
- type
- POwnerDrawButton = ^TOwnerDrawButton;
- TOwnerDrawButton = object(TButton)
- constructor Init(AParent: PWindowsObject; AnId: Integer; AText: PChar;
- X, Y, W, H: Integer; IsDefault: Boolean);
- procedure DrawButton(DC: HDC; R: TRect); virtual;
- procedure DrawFocused(DC: HDC; R: TRect); virtual;
- procedure DrawPushed(DC: HDC; R: TRect); virtual;
- procedure DrawSelf(DrawItemStruct: PDrawItemStruct);
- end;
-
- PDemoWindow = ^TDemoWindow;
- TDemoWindow = object(TWindow)
- Button: POwnerDrawButton;
- constructor Init(AParent: PWindowsObject; ATitle: PChar);
- procedure ButtonPushed(var Message: TMessage);
- virtual id_First + id_Button;
- procedure WMDrawItem(var Message: TMessage);
- virtual WM_DrawItem;
- end;
-
- TApp = object(TApplication)
- procedure InitMainWindow; virtual;
- end;
-
-
- {TOwnerDrawButton}
- constructor TOwnerDrawButton.Init(AParent: PWindowsObject; AnId: Integer;
- AText: PChar; X, Y, W, H: Integer; IsDefault: Boolean);
- begin
- TButton.Init(AParent, AnId, AText, X, Y, W, H, IsDefault);
- Attr.Style := Attr.Style or bs_OwnerDraw;
- end;
-
- procedure TOwnerDrawButton.DrawButton(DC: HDC; R: TRect);
- var
- Brush: HBrush;
- begin
- Brush := SelectObject(DC, CreateSolidBrush(RGB($ff,0,0)));
- Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom);
- SetBkMode(DC, Transparent);
- DrawText(DC, 'Push', 4, R, dt_Center or dt_VCenter or dt_SingleLine);
- DeleteObject(SelectObject(DC, Brush));
- end;
-
- procedure TOwnerDrawButton.DrawFocused(DC: HDC; R: TRect);
- begin
- Rectangle(DC, R.Left + 1, R.Top + 1, R.Right - 1, R.Bottom - 1);
- end;
-
- procedure TOwnerDrawButton.DrawPushed(DC: HDC; R: TRect);
- var
- Brush: HBrush;
- begin
- Brush := SelectObject(DC, CreateSolidBrush(RGB($80,0,0)));
- Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom);
- SetBkMode(DC, Transparent);
- DrawText(DC, 'Pushed', 6, R, dt_Center or dt_VCenter or dt_SingleLine);
- DeleteObject(SelectObject(DC, Brush));
- end;
-
- procedure TOwnerDrawButton.DrawSelf(DrawItemStruct: PDrawItemStruct);
- begin
- with DrawItemStruct^ do
- begin
- if (itemState and ods_Selected) = 0 then
- DrawButton(HDC, rcItem)
- else
- DrawPushed(HDC, rcItem);
- if itemAction and oda_Focus <> 0 then
- DrawFocused(HDC, rcItem);
- end;
- end;
-
- {TDemoWindow}
- constructor TDemoWindow.Init(AParent: PWindowsObject; ATitle: PChar);
- begin
- TWindow.Init(AParent, ATitle);
- Button := New(POwnerDrawButton, Init(@Self, id_Button, 'Draw',
- 10, 10, 80, 30, True));
- end;
-
- procedure TDemoWindow.ButtonPushed(var Message: TMessage);
- begin
- MessageBox(HWindow, 'Button Pushed', 'Message', mb_Ok);
- end;
-
- procedure TDemoWindow.WMDrawItem(var Message: TMessage);
- begin
- if PDrawItemStruct(Message.lParam)^.CtlId = id_Button then
- Button^.DrawSelf(PDrawItemStruct(Message.lParam));
- end;
-
- {TApp}
- procedure TApp.InitMainWindow;
- begin
- MainWindow := New(PDemoWindow, Init(Nil, 'Owner Draw Button Demo'));
- end;
-
- var
- App: TApp;
-
- begin
- App.Init('Demo');
- App.Run;
- App.Done;
- end.