TB2Merge, Version 1.1a (alt)
Hinweis: dies ist nicht die neueste Version!
Datei: Sample/main.pas
{ main.pas This file is part of the TB2Merge.pas sample application. Info at http://flocke.vssd.de/prog/code/pascal/tb2merge/ Copyright (C) 2005, 2006 Volker Siebert <flocke@vssd.de> All rights reserved. } unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdActns, ActnList, TB2MDI, ImgList, TB2Item, TB2Dock, TB2Toolbar, ComCtrls, StdCtrls, ExtCtrls; type TfrmMDIParent = class(TForm) TBDock1: TTBDock; TBDock2: TTBDock; tbMainMenuBar: TTBToolbar; TBSubmenuItem1: TTBSubmenuItem; TBItem1: TTBItem; TBItem2: TTBItem; TBItem3: TTBItem; TBItem4: TTBItem; TBSeparatorItem1: TTBSeparatorItem; TBItem5: TTBItem; TBSubmenuItem2: TTBSubmenuItem; TBItem6: TTBItem; TBSeparatorItem2: TTBSeparatorItem; TBItem7: TTBItem; TBItem8: TTBItem; TBItem9: TTBItem; TBSubmenuItem3: TTBSubmenuItem; TBSubmenuItem4: TTBSubmenuItem; TBItem10: TTBItem; TBImageList1: TTBImageList; TBMDIHandler1: TTBMDIHandler; TBMDIWindowItem1: TTBMDIWindowItem; TBItem11: TTBItem; TBSeparatorItem3: TTBSeparatorItem; StatusBar1: TStatusBar; Timer1: TTimer; procedure Timer1Timer(Sender: TObject); procedure FormCreate(Sender: TObject); procedure TBItem1Click(Sender: TObject); procedure TBItemClick(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } end; var frmMDIParent: TfrmMDIParent; function BlendColor(c1, c2: TColor; Percent: Integer): TColor; implementation {$R *.dfm} uses Menus, child1, child2; const Msg = 'Choose File>New to open windows and watch the menu change while you cycle through them'; var Counter: Integer = 0; function BlendColor(c1, c2: TColor; Percent: Integer): TColor; begin c1 := ColorToRGB(c1); c2 := ColorToRGB(c2); Result := RGB((GetRValue(c1) * (100 - Percent) + GetRValue(c2) * Percent) div 100, (GetGValue(c1) * (100 - Percent) + GetGValue(c2) * Percent) div 100, (GetBValue(c1) * (100 - Percent) + GetBValue(c2) * Percent) div 100); end; procedure TfrmMDIParent.FormCreate(Sender: TObject); begin TBImageList1.BkColor := BlendColor(tbMainMenuBar.Color, clGreen, 20); end; procedure TfrmMDIParent.TBItemClick(Sender: TObject); begin if Sender is TTBItem then MessageDlg(Caption + ': ' + StripHotkey(TTBItem(Sender).Caption), mtInformation, [mbOk], 0); end; procedure TfrmMDIParent.TBItem1Click(Sender: TObject); begin case Counter mod 2 of 0: begin frmMDIChild1 := nil; Application.CreateForm(TfrmMDIChild1, frmMDIChild1); end; 1: begin frmMDIChild2 := nil; Application.CreateForm(TfrmMDIChild2, frmMDIChild2); end; end; inc(Counter); Timer1.Enabled := false; StatusBar1.Panels[0].Text := Msg; end; procedure TfrmMDIParent.Timer1Timer(Sender: TObject); begin if StatusBar1.Panels[0].Text = '' then StatusBar1.Panels[0].Text := Msg else StatusBar1.Panels[0].Text := ''; end; end. |