刚帮朋友解决了一个小问题, 这是其中的小片段:
本例效果图:
代码文件:
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