绘制一个钢琴键盘


刚帮朋友解决了一个小问题, 这是其中的小片段:

本例效果图:

o_09191.gif

代码文件:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
  end;

  TMyShape = class(TShape)
  private
    FColorTmp: TColor;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  {黑白键组合顺序}
  Keys = '0100101001010100101001010100101001010100101001010100101001010100101001010100101001010100';
  KeyWhiteWidth = 15;   {白键宽}
  KeyBlackWidth = 10;   {黑键宽}
  KeyWhiteHeight = 88;  {白键高}
  KeyBlackHeight = 56;  {黑键高}

var
  KeyArr: array[0..87] of TMyShape; {键数组}

procedure TForm1.FormCreate(Sender: TObject);
var
  i,L: Integer;
begin
  {控件布局}
  Panel1.Align := alTop;
  Panel1.Height := KeyWhiteHeight;
  ClientWidth := (KeyWhiteWidth-1) * 52 - 1; {共 52 个白键, 这是键盘宽度}
  ClientHeight := KeyWhiteHeight;

  {画键盘}
  L := 0;
  for i := 0 to Length(Keys) - 1 do
  begin
    KeyArr[i] := TMyShape.Create(Self);
    KeyArr[i].Pen.Color := clGray;
    KeyArr[i].Parent := Panel1;
    KeyArr[i].Top := 0;

    case Keys[i+1] of
      '0': begin
        KeyArr[i].Width := KeyWhiteWidth;
        KeyArr[i].Height := KeyWhiteHeight;
        KeyArr[i].Brush.Color := clWhite;
        KeyArr[i].Left := L;
        Inc(L, KeyWhiteWidth-1);
        KeyArr[i].SendToBack;
      end;
      '1': begin
        KeyArr[i].Width := KeyBlackWidth;
        KeyArr[i].Height := KeyBlackHeight;
        KeyArr[i].Brush.Color := clBlack;
        KeyArr[i].Left := L - KeyBlackWidth div 2;
      end;
    end;
  end;
end;


{ TMyShape }

procedure TMyShape.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  FColorTmp := Brush.Color;
  Brush.Color := clWebGold;
end;

procedure TMyShape.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  Brush.Color := FColorTmp;
end;

end.

窗体文件:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 163
  ClientWidth = 290
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 56
    Top = 48
    Width = 185
    Height = 41
    Caption = 'Panel1'
    TabOrder = 0
  end
end
  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值