TB2Merge, Version 1.1 (alt)

Hinweis: dies ist nicht die neueste Version!

Zurück zur Übersicht

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 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.
Flocke's Garage
Valid HTML 4.01 Transitional Valid CSS!
(C) 2005-2018 Volker Siebert.
Creative Commons-LizenzvertragDer gesamte Inhalt dieser Webseite steht unter einer Creative Commons-Lizenz (sofern nicht anders angegeben).