mirror of
https://github.com/keymanapp/keyman.git
synced 2026-08-05 16:35:33 +00:00
406 lines
12 KiB
ObjectPascal
406 lines
12 KiB
ObjectPascal
(*
|
|
Name: keybtn
|
|
Copyright: Copyright (C) SIL International.
|
|
Documentation:
|
|
Description:
|
|
Create Date: 23 Aug 2006
|
|
|
|
Modified Date: 24 Jul 2015
|
|
Authors: mcdurdin
|
|
Related Files:
|
|
Dependencies:
|
|
|
|
Bugs:
|
|
Todo:
|
|
Notes:
|
|
History: 23 Aug 2006 - mcdurdin - Rework as custom control with new style button painting
|
|
28 Sep 2006 - mcdurdin - Tweak properties etc to match TOnScreenKeyboard
|
|
04 Dec 2006 - mcdurdin - Fix display of bitmaps
|
|
19 Nov 2007 - mcdurdin - I1157 - const string parameters
|
|
24 Jul 2015 - mcdurdin - I4799 - Preview keys are wrong colour in Developer
|
|
*)
|
|
unit KeyBtn;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, Buttons, VisualKeyboardParameters;
|
|
|
|
type
|
|
TKeyBtnType = (kbtNormal, kbtControl);
|
|
|
|
TKeyBtn = class(TCustomControl)
|
|
private
|
|
FIsHover: Boolean;
|
|
FScale: Extended;
|
|
|
|
FKeyData: WideString;
|
|
FKeyText: WideString;
|
|
FDataFont: TFont;
|
|
FKeyType: TKeyBtnType;
|
|
FIsSelected: Boolean;
|
|
FKeyGlyph: TBitmap;
|
|
FOnKeyBitmapChanged: TNotifyEvent;
|
|
FStdLeft: Integer;
|
|
FStdRow: Integer;
|
|
FParameters: TKeyBtnParameters;
|
|
FDisplayUnderlyingChar: Boolean;
|
|
FIsDown: Boolean;
|
|
FBackgroundBitmap: TBitmap;
|
|
FDefaultPos: TRect;
|
|
FDrawDisabled: Boolean;
|
|
|
|
procedure SetKeyData(Value: WideString);
|
|
procedure SetKeyText(Value: WideString);
|
|
procedure SetDataFont(const Value: TFont);
|
|
procedure SetKeyType(const Value: TKeyBtnType);
|
|
procedure SetSelected(const Value: Boolean);
|
|
procedure SetKeyGlyph(const Value: TBitmap);
|
|
function GetParameters: WideString;
|
|
procedure SetParameters(Value: WideString);
|
|
procedure SetDisplayUnderlyingChar(const Value: Boolean);
|
|
procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
|
|
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
|
|
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
|
|
protected
|
|
procedure CreateParams(var params: TCreateParams); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure DrawKey;
|
|
procedure Paint; override;
|
|
procedure Resize; override;
|
|
|
|
property Parameters: WideString read GetParameters write SetParameters;
|
|
property ParametersRec: TKeyBtnParameters read FParameters write FParameters;
|
|
|
|
destructor Destroy; override;
|
|
published
|
|
property DefaultPos: TRect read FDefaultPos write FDefaultPos;
|
|
property Caption;
|
|
property OnClick;
|
|
property KeyText: WideString read FKeyText write SetKeyText;
|
|
property KeyData: WideString read FKeyData write SetKeyData;
|
|
property KeyType: TKeyBtnType read FKeyType write SetKeyType;
|
|
property DataFont: TFont read FDataFont write SetDataFont;
|
|
property StdRow: Integer read FStdRow write FStdRow;
|
|
property StdLeft: Integer read FStdLeft write FStdLeft;
|
|
property Selected: Boolean read FIsSelected write SetSelected;
|
|
|
|
property DrawDisabled: Boolean read FDrawDisabled write FDrawDisabled default true;
|
|
|
|
property KeyGlyph: TBitmap read FKeyGlyph write SetKeyGlyph;
|
|
|
|
property DisplayUnderlyingChar: Boolean read FDisplayUnderlyingChar write SetDisplayUnderlyingChar;
|
|
|
|
property OnKeyBitmapChanged: TNotifyEvent read FOnKeyBitmapChanged write FOnKeyBitmapChanged;
|
|
|
|
property OnDragOver;
|
|
property OnDragDrop;
|
|
property Enabled;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Font;
|
|
property ParentFont;
|
|
property Visible;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
uses
|
|
CleartypeDrawCharacter,
|
|
OnScreenKeyboard;
|
|
|
|
{$R keybtn.res}
|
|
|
|
var
|
|
FDrawChar: TClearTypeDrawCharacter = nil;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Keyman', [TKeyBtn]);
|
|
end;
|
|
|
|
{ TKeyBtn }
|
|
|
|
procedure TKeyBtn.SetKeyData(Value: WideString);
|
|
begin
|
|
FKeyData := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TKeyBtn.SetKeyText(Value: WideString);
|
|
begin
|
|
FKeyText := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TKeyBtn.WMEraseBkGnd(var msg: TWMEraseBkGnd);
|
|
begin
|
|
BitBlt(FBackgroundBitmap.Canvas.Handle, 0, 0, Width, Height, msg.DC, 0, 0, SRCCOPY);
|
|
SetBkMode(msg.DC, TRANSPARENT);
|
|
msg.result := 1;
|
|
end;
|
|
|
|
procedure TKeyBtn.DrawKey;
|
|
|
|
var
|
|
ARect, R: TRect;
|
|
|
|
procedure DrawKeyBitmap(Canvas: TCanvas);
|
|
function CompareRect(r1, r2: TRect): Boolean;
|
|
begin
|
|
Result := (r1.Left = r2.Left) and (r1.Top = r2.Top) and (r1.Right = r2.Right) and (r1.Bottom = r2.Bottom);
|
|
end;
|
|
|
|
var
|
|
bIndex, n: Integer;
|
|
RGlyph: TRect;
|
|
Save: THandle;
|
|
MaskDC: THandle;
|
|
begin
|
|
if Enabled then
|
|
begin
|
|
bIndex := 0;
|
|
if FIsDown and FIsHover then bIndex := bIndex or 1;
|
|
if FIsSelected then bIndex := bIndex or 2;
|
|
if FIsHover and not FIsDown then bIndex := bIndex or 4;
|
|
if FKeyType <> kbtNormal then bIndex := bIndex or 8;
|
|
end
|
|
else if DrawDisabled then
|
|
bIndex := 16
|
|
else if FKeyType <> kbtNormal then
|
|
bIndex := 8
|
|
else
|
|
bIndex := 0;
|
|
|
|
if FIsDown and FIsHover then n := 1 else n := 0;
|
|
|
|
DrawKeyParam(Canvas, OnScreen_KeyBitmap.Parameters.Border[n], R.Left, R.Top, Width, Height, bIndex, OnScreen_KeyBitmap.Bitmap);
|
|
|
|
with Canvas, OnScreen_KeyBitmap.Parameters do
|
|
begin
|
|
SetBkMode(Handle, TRANSPARENT);
|
|
|
|
Font := Self.Font;
|
|
Font.Name := CapFont;
|
|
|
|
{if FLargeCapFont and (FKeyType = kktNormal)
|
|
then Font.Size := Trunc((TextRect[n].Top - TextRect[n].Bottom) * FKeyboard.FScale)
|
|
else}
|
|
Font.Size := Trunc(CapFontSize*FScale);
|
|
|
|
if not Enabled and DrawDisabled then Font.Color := KeyFontColor_Disabled // I4799
|
|
else if (FKeyType = kbtNormal) and not FIsSelected then Font.Color := KeyFontColor_Base // I4799
|
|
else if FKeyType = kbtNormal then Font.Color := KeyFontColor_BaseSelected // I4799
|
|
else Font.Color := KeyFontColor_Cap; // I4799
|
|
|
|
ARect := Rect(R.Left+Trunc(TextRect[n].Left*FScale), R.Top+Trunc(1*FScale),
|
|
R.Left+Trunc(TextRect[n].Right*FScale), R.Top+Height); // I4799
|
|
|
|
if FDisplayUnderlyingChar or (FKeyType <> kbtNormal) then
|
|
begin
|
|
FDrawChar.DisplayQuality := ctCleartype;
|
|
FDrawChar.Color := Font.Color;
|
|
FDrawChar.SetFontDetails(Font.Name, Font.Height);
|
|
|
|
FDrawChar.DrawText(Handle, TA_LEFT or TA_TOP, R.Left+Trunc(CapPos[n].X*FScale),
|
|
R.Top+Trunc(CapPos[n].Y*FScale), ARect, FKeyText);
|
|
//ExtTextOutW(Handle, R.Left+Trunc(CapPos[n].X*FKeyboard.FScale), R.Top+Trunc(CapPos[n].Y*FKeyboard.FScale), 0, @ARect, PWideChar(FKeyCap), Length(FKeyCap), nil);
|
|
end;
|
|
|
|
if Assigned(FKeyGlyph) and not FKeyGlyph.Empty then
|
|
begin
|
|
// image is anchored to
|
|
RGlyph := Rect(
|
|
R.Left+Trunc(TextRect[n].Right*FScale) - Trunc(FKeyGlyph.Width*FScale),
|
|
R.Top+Trunc(TextRect[n].Bottom*FScale) - Trunc(FKeyGlyph.Height*FScale),
|
|
R.Left+Trunc(TextRect[n].Right*FScale),
|
|
R.Top+Trunc(TextRect[n].Bottom*FScale));
|
|
|
|
if RGlyph.Right - RGlyph.Left > (TextRect[n].Right - TextRect[n].Left) * FScale then
|
|
begin
|
|
RGlyph.Top := RGlyph.Bottom - Trunc((RGlyph.Bottom - RGlyph.Top) * ((TextRect[n].Right-TextRect[n].Left)*FScale) / (RGlyph.Right - RGlyph.Left));
|
|
RGlyph.Left := R.Left + Trunc(TextRect[n].Left * FScale);
|
|
end;
|
|
|
|
if RGlyph.Bottom - RGlyph.Top > (TextRect[n].Bottom - TextRect[n].Top) * FScale then
|
|
begin
|
|
RGlyph.Left := RGlyph.Right - Trunc((RGlyph.Right - RGlyph.Left) * ((TextRect[n].Bottom-TextRect[n].Top)*FScale) / (RGlyph.Bottom - RGlyph.Top));
|
|
RGlyph.Top := R.Top + Trunc(TextRect[n].Top * FScale);
|
|
end;
|
|
|
|
SetStretchBltMode(Handle, HALFTONE);
|
|
SetBrushOrgEx(Handle, 0, 0, nil);
|
|
FKeyGlyph.TransparentMode := tmAuto;
|
|
FKeyGlyph.Transparent := True;
|
|
FKeyGlyph.PixelFormat := pf24Bit;
|
|
|
|
|
|
Save := 0;
|
|
MaskDC := 0;
|
|
try
|
|
MaskDC := CreateCompatibleDC(0);
|
|
Save := SelectObject(MaskDC, FKeyGlyph.MaskHandle);
|
|
TransparentStretchBlt(Handle, RGlyph.Left, RGlyph.Top, RGlyph.Right - RGlyph.Left,
|
|
RGlyph.Bottom - RGlyph.Top, FKeyGlyph.Canvas.Handle, 0, 0, FKeyGlyph.Width,
|
|
FKeyGlyph.Height, MaskDC, 0, 0);
|
|
finally
|
|
if Save <> 0 then SelectObject(MaskDC, Save);
|
|
if MaskDC <> 0 then DeleteDC(MaskDC);
|
|
end;
|
|
//StretchDraw(RGlyph, FKeyGlyph);
|
|
//Draw(R.Left+CapPos[n].X-FKeyGlyph.Width, R.Top+CapPos[n].Y-FKeyGlyph.Height, FKeyGlyph);
|
|
end
|
|
else
|
|
begin
|
|
Font := FDataFont;
|
|
Font.Height := Trunc((TextRect[n].Top - TextRect[n].Bottom) * FScale);
|
|
|
|
if not Enabled and DrawDisabled then Font.Color := $808080
|
|
else Font.Color := clWindowText;
|
|
|
|
FDrawChar.DisplayQuality := ctCleartype;
|
|
FDrawChar.Color := Font.Color;
|
|
FDrawChar.SetFontDetails(Font.Name, Font.Height);
|
|
|
|
FDrawChar.DrawText(Handle, TA_RIGHT or TA_BOTTOM, R.Left+Trunc(TextRect[n].Right*FScale),
|
|
R.Top+Trunc(TextRect[n].Bottom*FScale), ARect, FKeyData);
|
|
|
|
//GetTextExtentPoint32W(Handle, PWideChar(FKeyValue), Length(FKeyValue), sz);
|
|
//ExtTextOutW(Handle, ETO_CLIPPED, @ARect, PWideChar(FKeyValue), Length(FKeyValue), nil);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
R := Rect(0, 0, Width, Height);
|
|
BitBlt(Canvas.Handle, 0, 0, Width, Height, FBackgroundBitmap.Canvas.Handle, 0, 0, SRCCOPY);
|
|
DrawKeyBitmap(Canvas);
|
|
end;
|
|
|
|
procedure TKeyBtn.CMMouseEnter(var Message: TMessage);
|
|
begin
|
|
FIsHover := True;
|
|
DrawKey;
|
|
end;
|
|
|
|
procedure TKeyBtn.CMMouseLeave(var Message: TMessage);
|
|
begin
|
|
FIsHover := False;
|
|
DrawKey;
|
|
end;
|
|
|
|
constructor TKeyBtn.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDrawDisabled := True;
|
|
FBackgroundBitmap := TBitmap.Create;
|
|
ControlStyle := ControlStyle - [csOpaque];
|
|
ParentBackground := True;
|
|
FDataFont := TFont.Create;
|
|
FKeyGlyph := nil; //TBitmap.Create;
|
|
end;
|
|
|
|
procedure TKeyBtn.CreateParams(var params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(params);
|
|
params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT;
|
|
end;
|
|
|
|
destructor TKeyBtn.Destroy;
|
|
begin
|
|
FDataFont.Free;
|
|
FreeAndNil(FKeyGlyph);
|
|
FreeAndNil(FBackgroundBitmap);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TKeyBtn.SetDataFont(const Value: TFont);
|
|
begin
|
|
FDataFont.Assign(Value);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TKeyBtn.SetKeyType(const Value: TKeyBtnType);
|
|
begin
|
|
FKeyType := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TKeyBtn.SetSelected(const Value: Boolean);
|
|
begin
|
|
FIsSelected := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TKeyBtn.SetKeyGlyph(const Value: TBitmap);
|
|
begin
|
|
if not Assigned(Value) then
|
|
FreeAndNil(FKeyGlyph)
|
|
else
|
|
begin
|
|
if not Assigned(FKeyGlyph) then FKeyGlyph := TBitmap.Create;
|
|
FKeyGlyph.Assign(Value);
|
|
end;
|
|
Invalidate;
|
|
end;
|
|
|
|
function TKeyBtn.GetParameters: WideString;
|
|
begin
|
|
Result := KeyBtnParametersToXML(FParameters);
|
|
end;
|
|
|
|
procedure TKeyBtn.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if Button = mbLeft then
|
|
begin
|
|
FIsDown := True;
|
|
DrawKey;
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyBtn.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
FIsDown := False;
|
|
DrawKey;
|
|
end;
|
|
|
|
procedure TKeyBtn.SetParameters(Value: WideString);
|
|
begin
|
|
try
|
|
FParameters := KeyBtnParametersFromXML(Value);
|
|
except
|
|
;
|
|
end;
|
|
end;
|
|
|
|
procedure TKeyBtn.SetDisplayUnderlyingChar(const Value: Boolean);
|
|
begin
|
|
FDisplayUnderlyingChar := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TKeyBtn.Paint;
|
|
begin
|
|
DrawKey;
|
|
end;
|
|
|
|
procedure TKeyBtn.Resize;
|
|
begin
|
|
inherited;
|
|
FBackgroundBitmap.Width := Width;
|
|
FBackgroundBitmap.Height := Height;
|
|
FScale := Height/33;
|
|
end;
|
|
|
|
initialization
|
|
FDrawChar := TCleartypeDrawCharacter.Create;
|
|
finalization
|
|
FreeAndNil(FDrawChar);
|
|
end.
|