unit GDIObject;

interface

uses
  windows,
  messages,
  UtilFunc,
  UtilClass;

//------------------ TGDIObject ------------------------------
type
TGDIObject = class(TSubClass)
private
  FDimension: TRect;
  FRect: TRect;
  FVisible: Boolean;
  FEnable: Boolean;
  procedure SetDimension(value:TRect);
  procedure SetVisible(value: Boolean);
  procedure SetEnable(value: Boolean);
protected
public
  constructor Create(hParent:HWND);override;
  destructor Destroy; override;
  procedure Update;
  procedure UpdateAll;
  property Dimension: TRect read FDimension write SetDimension;
  property Visible: Boolean read FVisible write SetVisible;
  property Enable: Boolean read FEnable write SetEnable;
end;

//-------------------- TAPISpeedBtn -------------------------------------
TAPISpeedBtn = class(TGDIObject)
private
  FEdge: UINT;
  FCaption: string;
  FDown: Boolean;
  FOnClick: TNotifyMessage;
  procedure SetCaption(value:string);
public
  constructor Create(hParent:HWND); override;
  procedure DefaultHandler(var Message);override;
  property Caption: string read FCaption write SetCaption;
  property OnClick: TNotifyMessage read FOnClick write FOnClick;
end;

//-------------  TAPIColorBtn ---------------------------------------------
TAPIColorBtn = class(TAPISpeedBtn)
private
  FColor: COLORREF;
  FTextColor: COLORREF;
  procedure SetColor(value:COLORREF);
  procedure SetTextColor(value:COLORREF);
public
  constructor Create(hParent:HWND); override;
  procedure DefaultHandler(var Message);override;
  property Color: COLORREF read FColor write SetColor;
  property TextColor: COLORREF read FTextColor write SetTextColor;
end;

//-------------  TAPILabel ---------------------------------------------
TAPILabel = class(TGDIObject)
private
  FColor: COLORREF;
  FText: string;
  FTextAlign: UINT;
  FTextColor: COLORREF;
  FMargin: integer;
  FBkMode: integer;
  FDrawFrame: Boolean;
  FFrameColor: COLORREF;
  procedure SetColor(value: COLORREF);
  procedure SetText(value:string);
  procedure SetTextAlign(value:UINT);
  procedure SetTextColor(value:COLORREF);
  procedure SetMargin(value:integer);
  procedure SetBkMode(value:integer);
  procedure SetDrawFrame(value:Boolean);
  procedure SetFrameColor(value:COLORREF);
public
  constructor Create(hParent:HWND); override;
  procedure DefaultHandler(var Message);override;
  property Color: COLORREF read FColor write SetColor;
  property Text: string read FText write SetText;
  property TextAlign: UINT read FTextAlign write SetTextAlign;
  property TextColor: COLORREF read FTextColor write SetTextColor;
  property Margin: integer read FMargin write SetMargin;
  property BkMode: integer read FBkMode write SetBkMode;
  property DrawFrame: Boolean read FDrawFrame write SetDrawFrame;
  property FrameColor: COLORREF read FFrameColor write SetFrameCOlor;
end;

//-------------  TClrMindBtn ----------------------------------------------
TColorKind = (crkWhite,crkRed,crkGreen,crkBlue,crkYellow);

TClrMindBtn = class(TAPISpeedBtn)
private
  FColorKind : TColorKind;
  procedure SetColorKind(value:TColorKind);
public
  constructor Create(hParent:HWND); override;
  procedure DefaultHandler(var Message);override;
  property Edge: UINT read FEdge;
  property ColorKind: TColorKind read FColorKind write SetColorKind;
end;


//
//--------------- Create Functions -------------------------------
//
function CreateSpeedBtn(hParent:HWND;x,y,cx,cy: integer;
           sCaption: string; sOnClick: TNotifyMessage): TAPISpeedBtn;
function CreateColorBtn(hParent:HWND;x,y,cx,cy: integer;
            sCaption: string; sOnClick: TNotifyMessage): TAPIColorBtn;
function CreateLabel(hParent:HWND;x,y,cx,cy: integer;
                                        sText: string): TAPILabel;



implementation

//------------------ TGDIObject ------------------------------
constructor TGDIObject.Create(hParent:HWND);
begin
  inherited Create(hParent);

  FVisible := true;
  FEnable := true;
  Dimension := SetDim(0,0,0,0);
end;

destructor TGDIObject.Destroy;
begin
  UpdateAll;
  inherited Destroy;
end;

procedure TGDIObject.Update;
var
  AMsg: TMessage;
begin
  AMsg.Msg := WM_PAINT;
  Dispatch(AMsg);
end;

procedure TGDIObject.UpdateAll;
begin
  InvalidateRect(Parent,@FRect,true);
end;

procedure TGDIObject.SetDimension(value:TRect);
begin
  FDimension := value;
  UpdateAll;
  FRect := value;
  FRect.Right := FDimension.Left+FDimension.Right; // right from width
  FRect.Bottom := FDimension.Top+FDimension.Bottom; // Bottom from height
  Update;
end;

procedure TGDIObject.SetVisible(value: Boolean);
begin
  FVisible := value;
  if value then Update else UpdateAll;
end;

procedure TGDIObject.SetEnable(value: Boolean);
begin
  FEnable := value;
  Update;
end;

//-------------------- TAPISpeedBtn -------------------------------------
constructor TAPISpeedBtn.Create(hParent:HWND);
begin
  inherited Create(hParent);
  Dispatcher.TrapMessage(WM_PAINT,self);
  Dispatcher.TrapMessage(WM_LBUTTONDOWN,self);
  Dispatcher.TrapMessage(WM_LBUTTONUP,self);
  Dispatcher.TrapMessage(WM_MOUSEMOVE,self);

  FEdge := EDGE_RAISED;
  FCaption := '';
  FDown := false;
end;

procedure TAPISpeedBtn.DefaultHandler(var Message);
var
  AMsg:TMessage;
  DC:HDC;
  hBr: hBrush;
  dr: TRect;
  pt: TPoint;
begin
  if not FVisible then Exit;

  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_PAINT : begin
      DC := GetDC(Parent);
        hBr := CreateSolidBrush(clrBtnFace);
        FillRect(DC, FRect, hBr);
        DeleteObject(hBr);
        DrawEdge(DC, FRect, FEdge, BF_RECT);
        if Length(FCaption)>0 then begin
          if not Enable then SetTextColor(DC,clrGrayText);
          SetBkMode(DC,TRANSPARENT);
          dr := FRect;
          if FEdge = EDGE_RAISED then
            OffsetRect(dr,1,1)
          else
            OffsetRect(dr,-1,-1);
          DrawText(DC,PChar(FCaption),Length(FCaption),
                   dr,DT_CENTER or DT_SINGLELINE or DT_VCENTER);
        end;
      ReleaseDC(Parent,DC);
    end;

    WM_LBUTTONDOWN: begin
      if not FEnable then Exit;
      pt.x := AMsg.LParamLo;
      pt.y := AMsg.LParamHi;
      if PtInRect(FRect,pt) then begin
        FEdge := EDGE_SUNKEN;
        FDown := true;
        UpDate;
      end;
    end;

    WM_LBUTTONUP: begin
      if not FEnable then Exit;
       if not FDown then Exit;
      pt.x := AMsg.LParamLo;
      pt.y := AMsg.LParamHi;
      if PtInRect(FRect,pt) then begin
        FEdge := EDGE_RAISED;
        FDown := false;
        UpDate;
        AMsg.Msg := UINT(self);  // sender
        if Assigned(FOnClick) then OnClick(AMsg);
      end;
    end;

    WM_MOUSEMOVE: begin
      if not FEnable then Exit;
      if not FDown then Exit;
      pt.x := AMsg.LParamLo;
      pt.y := AMsg.LParamHi;
      if not PtInRect(FRect,pt) then begin
        FEdge := EDGE_RAISED;
        FDown := false;
        UpDate;
      end;
    end;

  end; // case
end;

procedure TAPISpeedBtn.SetCaption(value:string);
begin
  FCaption := value;
  UpDate;
end;

//-------------  TAPIColorBtn ---------------------------------------------
constructor TAPIColorBtn.Create(hParent:HWND);
begin
  inherited Create(hParent);

  FColor := clrBtnFace;
  FTextColor := clrBlack;
end;

procedure TAPIColorBtn.DefaultHandler(var Message);
var
  DC:HDC;
  AMsg: TMessage;
  hBr: hBrush;
  dr: TRect;
  pt: TPoint;
begin
  if not FVisible then Exit;

  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_PAINT : begin
      DC := GetDC(Parent);
        if FEnable then
          hBr := CreateSolidBrush(FColor)
        else
          hBr := CreateSolidBrush(clrBtnFace);
        FillRect(DC, FRect, hBr);
        DeleteObject(hBr);
        DrawEdge(DC, FRect, FEdge, BF_RECT);
        if Length(FCaption)>0 then begin
          SetBkMode(DC,TRANSPARENT);
          if not Enable then
            Windows.SetTextColor(DC,clrGrayText)
          else
            Windows.SetTextColor(DC,FTextColor);
          dr := FRect;
          if FEdge = EDGE_RAISED then
            OffsetRect(dr,1,1)
          else
            OffsetRect(dr,-1,-1);
          DrawText(DC,PChar(FCaption),Length(FCaption),
                   dr,DT_CENTER or DT_SINGLELINE or DT_VCENTER);
        end;
      ReleaseDC(Parent,DC);
    end;

    WM_LBUTTONDOWN: begin
      if not FEnable then Exit;
      pt.x := AMsg.LParamLo;
      pt.y := AMsg.LParamHi;
      if PtInRect(FRect,pt) then begin
        FEdge := EDGE_SUNKEN;
        FDown := true;
        UpDate;
      end;
    end;

    WM_LBUTTONUP: begin
      if not FEnable then Exit;
       if not FDown then Exit;
      pt.x := AMsg.LParamLo;
      pt.y := AMsg.LParamHi;
      if PtInRect(FRect,pt) then begin
        FEdge := EDGE_RAISED;
        FDown := false;
        UpDate;
        AMsg.Msg := UINT(self);  // sender
        if Assigned(FOnClick) then OnClick(AMsg);
      end;
    end;

    WM_MOUSEMOVE: begin
      if not FEnable then Exit;
      if not FDown then Exit;
      pt.x := AMsg.LParamLo;
      pt.y := AMsg.LParamHi;
      if not PtInRect(FRect,pt) then begin
        FEdge := EDGE_RAISED;
        FDown := false;
        UpDate;
      end;
    end;

  end; // case
end;

procedure TAPIColorBtn.SetColor(value:COLORREF);
begin
  FColor := value;
  Update;
end;

procedure TAPIColorBtn.SetTextColor(value:COLORREF);
begin
  FTextColor := value;
  Update;
end;

//-------------  TAPILabel ---------------------------------------------
constructor TAPILabel.Create(hParent:HWND);
begin
  inherited Create(hParent);
  Dispatcher.TrapMessage(WM_PAINT,self);

  FColor := clrWhite;
  FTextColor := clrBlack;
  FTextAlign := DT_LEFT;
  FText := ClassName;
  FMargin := 4;
  FBkMode := OPAQUE;
  FDrawFrame := false;
  FFrameColor := clrBlack;
  Update;
end;

procedure TAPILabel.DefaultHandler(var Message);
var
  DC:HDC;
  AMsg: TMessage;
  hBr: hBrush;
  iR: TRect;
  uFlags: UINT;
begin
  if not FVisible then Exit;
  AMsg := TMessage(Message);
  if AMsg.Msg = WM_PAINT then begin
   DC := GetDC(Parent);
    if FBkMode = OPAQUE then begin
      hBr := CreateSolidBrush(FColor);
      FillRect(DC,FRect,hBr);
      DeleteObject(hBr);
    end;
    if FDrawFrame then begin
      hBr := CreateSolidBrush(FFrameColor);
      FrameRect(DC,FRect,hBr);
      DeleteObject(hBr);
    end;
    Windows.SetBkMode(DC,TRANSPARENT);
    Windows.SetTextColor(DC,FTextColor);
    iR := FRect;
    InflateRect(iR,-FMargin,-FMargin);
    uFlags := DT_WORDBREAK or DT_EXTERNALLEADING or
                DT_EXPANDTABS or FTextAlign;
    DrawText(DC,PChar(FText),Length(FText),iR,uFlags);
   ReleaseDC(Parent,DC);
  end;
end;

procedure TAPILabel.SetColor(value: COLORREF);
begin
  FColor := value;
  Update;
end;

procedure TAPILabel.SetText(value:string);
begin
  FText := value;
  Update;
end;

procedure TAPILabel.SetTextAlign(value:UINT);
begin
  FTextAlign := value;
  Update;
end;

procedure TAPILabel.SetTextColor(value:COLORREF);
begin
  FTextColor := value;
  Update;
end;

procedure TAPILabel.SetMargin(value:integer);
begin
  FMargin := value;
  Update;
end;

procedure TAPILabel.SetBkMode(value:integer);
begin
  FBkMode := value;
  Update;
end;

procedure TAPILabel.SetDrawFrame(value:Boolean);
begin
  FDrawFrame := value;
  Update;
end;

procedure TAPILabel.SetFrameColor(value:COLORREF);
begin
  FFrameColor := value;
  Update;
end;

//-------------  TClrMindBtn ----------------------------------------------
constructor TClrMindBtn.Create(hParent:HWND);
begin
  inherited Create(hParent);

  ColorKind := crkRed;
end;

procedure TClrMindBtn.DefaultHandler(var Message);
var
  DC:HDC;
  hBr: hBrush;
  dr: TRect;
  AMsg:TMessage;
  clr: COLORREF;
  pt: TPoint;
begin
  if not FVisible then Exit;

  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_PAINT : begin
      DC := GetDC(Parent);
        if FEnable then
          hBr := CreateSolidBrush(GetSysColor(COLOR_BTNFACE))
        else
          hBr := CreateSolidBrush(clrDkGray);
        FillRect(DC, FRect, hBr);
        DeleteObject(hBr);
        DrawEdge(DC, FRect, FEdge, BF_RECT);
        dr := FRect;
        InflateRect(dr,-8,-8);
        clr:= clrWhite;
        if FEdge = EDGE_RAISED then begin
          OffsetRect(dr,-1,-1);
          case FColorKind of
            crkWhite: clr := clrDkGray;
            crkRed   : clr := clrMaroon;
            crkGreen : clr := clrGreen;
            crkBlue  : clr := clrBlue;
            crkYellow: clr := clrOlive;
          end;
        end else begin
          OffsetRect(dr,1,1);
          case FColorKind of
            crkWhite: clr := clrWhite;
            crkRed   : clr := RGB(255,50,50);
            crkGreen : clr := clrLime;
            crkBlue  : clr := clrAqua;
            crkYellow: clr := clrYellow;
          end;
        end;
        DrawEdge(DC,dr,EDGE_ETCHED,BF_RECT);
        InflateRect(dr,-4,-4);
        hBr := CreateSolidBrush(clr);
        FillRect(DC, dr, hBr);
        DeleteObject(hBr);
      ReleaseDC(Parent,DC);
    end;

    WM_LBUTTONDOWN: begin
      if not FEnable then Exit;
      pt.x := AMsg.LParamLo;
      pt.y := AMsg.LParamHi;
      if PtInRect(FRect,pt) then begin
        FEdge := EDGE_SUNKEN;
        MessageBeep($FFFFFFFF);
        FDown := true;
        UpDate;
      end;
    end;

    WM_LBUTTONUP: begin
      if not FEnable then Exit;
       if not FDown then Exit;
      pt.x := AMsg.LParamLo;
      pt.y := AMsg.LParamHi;
      if PtInRect(FRect,pt) then begin
        FEdge := EDGE_RAISED;
        FDown := false;
        UpDate;
        AMsg.Msg := UINT(self);  // sender
        if Assigned(FOnClick) then OnClick(AMsg);
      end;
    end;

    WM_MOUSEMOVE: begin
      if not FEnable then Exit;
      if not FDown then Exit;
      pt.x := AMsg.LParamLo;
      pt.y := AMsg.LParamHi;
      if not PtInRect(FRect,pt) then begin
        FEdge := EDGE_RAISED;
        FDown := false;
        UpDate;
      end;
    end;

    WM_USER: begin
      FEdge := EDGE_RAISED;
      Update;
    end;

    WM_USER+1: begin
      FEdge := EDGE_SUNKEN;
      Update;
    end;

  end; // case
end;

procedure TClrMindBtn.SetColorKind(value:TColorKind);
begin
  FColorKind := value;
  Update;
end;


//
//--------------- Create Functions -------------------------------
//
function CreateSpeedBtn(hParent:HWND;x,y,cx,cy: integer;
           sCaption: string; sOnClick: TNotifyMessage): TAPISpeedBtn;
begin
  result := TAPISpeedBtn.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Caption := sCaption;
    OnClick := sOnClick;
  end;
end;

function CreateColorBtn(hParent:HWND;x,y,cx,cy: integer;
            sCaption: string; sOnClick: TNotifyMessage): TAPIColorBtn;
begin
  result := TAPIColorBtn.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Caption := sCaption;
    OnClick := sOnClick;
  end;
end;

function CreateLabel(hParent:HWND;x,y,cx,cy: integer;
                                        sText: string): TAPILabel;
begin
  result := TAPILabel.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Text := sText;
  end;
end;

end.