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.