Marco Web Center |
Home: Code Repository: Mastering Delphi 5Project TABONLY
Project StructureTABONLY.DPRprogram Tabonly; uses Forms, Viewer in 'VIEWER.PAS' {Form1}; {$R *.RES} begin Application.CreateForm(TForm1, Form1); Application.Run; end. VIEWER.PASunit Viewer; interface uses SysUtils, Windows, Classes, Graphics, Forms, Controls, StdCtrls, Tabs, Menus, Dialogs, ExtCtrls, ComCtrls, FileCtrl; type TForm1 = class(TForm) OpenDialog1: TOpenDialog; MainMenu1: TMainMenu; File1: TMenuItem; Open1: TMenuItem; N1: TMenuItem; Exit1: TMenuItem; Help1: TMenuItem; AboutImageViewer1: TMenuItem; TabControl1: TTabControl; Image1: TImage; procedure Open1Click(Sender: TObject); procedure Exit1Click(Sender: TObject); procedure About1Click(Sender: TObject); procedure TabControl1Change(Sender: TObject); procedure TabControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private TabBmp: TBitmap; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} const BmpSide = 20; procedure TForm1.Open1Click(Sender: TObject); begin if OpenDialog1.Execute then begin TabControl1.Tabs := OpenDialog1.Files; TabControl1.TabIndex := 0; TabControl1Change (TabControl1); end; end; procedure TForm1.Exit1Click(Sender: TObject); begin Close; end; procedure TForm1.About1Click(Sender: TObject); begin MessageDlg ('Bitmap Viewer with Tabs, from "Mastering Delphi"', mtInformation, [mbOk], 0); end; procedure TForm1.TabControl1Change(Sender: TObject); begin Image1.Picture.LoadFromFile ( TabControl1.Tabs [TabControl1.TabIndex]); end; procedure TForm1.TabControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); var TabText: string; OutRect: TRect; begin TabText := TabControl1.Tabs [TabIndex]; OutRect := Rect; InflateRect (OutRect, -3, -3); OutRect.Left := OutRect.Left + BmpSide + 3; DrawText (Control.Canvas.Handle, PChar (ExtractFileName (TabText)), Length (ExtractFileName (TabText)), OutRect, dt_Left or dt_SingleLine or dt_VCenter); if TabText <> 'None' then begin TabBmp.LoadFromFile (TabText); OutRect.Left := OutRect.Left - BmpSide - 3; OutRect.Right := OutRect.Left + BmpSide; Control.Canvas.StretchDraw (OutRect, TabBmp); end; end; procedure TForm1.FormCreate(Sender: TObject); begin TabControl1.TabHeight := BmpSide + 6; TabBmp := TBitmap.Create; end; procedure TForm1.FormDestroy(Sender: TObject); begin TabBmp.Free; end; end. VIEWER.DFMobject Form1: TForm1 Left = 95 Top = 149 Width = 680 Height = 409 Caption = 'Bitmap Viewer' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] Menu = MainMenu1 OldCreateOrder = True OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object TabControl1: TTabControl Left = 0 Top = 0 Width = 672 Height = 363 Align = alClient MultiLine = True OwnerDraw = True TabHeight = 20 TabOrder = 0 Tabs.Strings = ( 'None') TabIndex = 0 TabWidth = 120 OnChange = TabControl1Change OnDrawTab = TabControl1DrawTab object Image1: TImage Left = 4 Top = 26 Width = 664 Height = 333 Align = alClient end end object OpenDialog1: TOpenDialog DefaultExt = '*.bmp' Filter = 'Bitmap files (*.bmp)|*.bmp|Other files (*.*)|*.*' Options = [ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofShareAware] Title = 'Select one or more images' Left = 40 Top = 32 end object MainMenu1: TMainMenu Left = 40 Top = 80 object File1: TMenuItem Caption = '&File' object Open1: TMenuItem Caption = '&Open...' OnClick = Open1Click end object N1: TMenuItem Caption = '-' end object Exit1: TMenuItem Caption = '&Exit' OnClick = Exit1Click end end object Help1: TMenuItem Caption = '&Help' object AboutImageViewer1: TMenuItem Caption = '&About Image Viewer...' OnClick = About1Click end end end end
|
||
© Copyright Marco Cantù, 1995-2020, All rights reserved |