文档章节

绘制一个钢琴键盘

涂孟超
 涂孟超
发布于 2014/09/26 15:35
字数 347
阅读 16
收藏 1

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

本例效果图:



代码文件:
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

 
 
 
 
 

 

 

  

本文转载自:http://www.cnblogs.com/del/archive/2009/01/09/1372254.html

共有 人打赏支持
涂孟超
粉丝 12
博文 2011
码字总数 14107
作品 0
深圳
程序员
私信 提问
钢琴的原理

过去的一周,我在厦门。 原来的打算,就是去海边放松一下。但是没有料到,这次旅行的一个重大收获,却是我想通了一个问题: ----为什么钢琴会发出声音? 1. 那天在鼓浪屿上面,太阳暴晒,我就...

阮一峰
2010/07/25
0
0
厉害了我的琴!钢琴教育竟然用上了AI+云计算?

随着AI技术越来越成熟,许多传统行业也逐渐向互联网+的方向发展。如果学钢琴能加入AI新科技,是不是就能将学琴者从枯燥无味的学习过程中解脱出来,钢琴老师也将happy教学呢? 近日,广东琴趣...

zabenbrdit36243qnjx1
2017/12/14
0
0
陪你的不仅有键盘还有音乐-献给深夜撸代码的你!

每个夜晚陪你度过的不仅是 敲的pa pa 响的键盘 还有那些让我们在深夜敲代码不在孤单的 音乐,今天给大家推荐的一些音乐,也是我经常听de,希望大家喜欢... 1. 君が好きだと叫びたい 《好想大声...

不空大的Timo
2017/09/10
0
0
钢琴曲演奏软件--FreePiano

FreePiano是一款使用电脑键盘演奏钢琴音曲的开源软件。 FreePiano的特点: 完全免费的,您不需要购买就可以使用全部的功能。 直接调用VSTi音源,不需要安装虚拟MIDI设备。 支持多种音频输出方...

匿名
2013/05/27
2.4K
1
WPF 利用键盘钩子来捕获键盘,做一些不为人知的事情...完整实例

原文:WPF 利用键盘钩子来捕获键盘,做一些不为人知的事情...完整实例 键盘钩子是一种可以监控键盘操作的指令。 看到这句话是不是觉得其实键盘钩子可以做很多事情. 场景 当你的程序需要一个全局...

杰克.陈
2018/10/22
0
0

没有更多内容

加载失败,请刷新页面

加载更多

20个使用 Java CompletableFuture的例子

https://colobu.com/2018/03/12/20-Examples-of-Using-Java%E2%80%99s-CompletableFuture/

lemos
9分钟前
0
0
Apache 流框架 Flink,Spark Streaming,Storm对比分析

1.Flink架构及特性分析 Flink是个相当早的项目,开始于2008年,但只在最近才得到注意。Flink是原生的流处理系统,提供high level的API。Flink也提供 API来像Spark一样进行批处理,但两者处理...

hblt-j
13分钟前
0
0
什么是公网IP、内网IP和NAT转换?

搞网络通信应用开发的程序员,可能会经常听到外网IP(即互联网IP地址)和内网IP(即局域网IP地址),但他们的区别是什么? 1、引言 搞网络通信应用开发的程序员,可能会经常听到外网IP(即互联网I...

linuxprobe16
19分钟前
0
0
Spring Cloud搭建微服务架构----流量回放

前言 系统微服务化后,传统的自测/测试方式都变得比较困难: 依赖的服务可能不稳定。 服务无法提供期望的响应数据。 缺少场景构造标准。 随着整体业务越来越复杂,微服务依赖的越来越多,测试...

春哥大魔王的博客
41分钟前
3
0
记一次springboot模块配置问题导致读取Apollo配置中心配置文件始终错误的问题

现在正在做的一个项目采用的是微服务,主框架是spring cloud,配置中心用的是携程的Apollo。 项目下有多个服务,在测试服务器上启动用户服务的时候发现在eureka中心另一个服务被启动了,尝试...

zcqshine
41分钟前
7
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部