transEBERiano - Programa monolítico

unit Principal; interface const cGDI32 = 'gdi32.dll'; cUser32= 'user32.dll'; type PMW_Int = PInteger; PMW_LPCTStr = PAnsiChar; PMW_LPVoid = Pointer; TMW_Atom = Word; TMW_Bool = LongBool; TMW_Byte = Byte; TMW_DWord = LongWord; TMW_ColorRef = TMW_DWord; TMW_HBrush = type LongWord; TMW_HCursor = type LongWord; TMW_HDC = type LongWord; TMW_HIcon = type LongWord; TMW_HInstance= THandle; TMW_HMenu = type LongWord; TMW_HWnd = type LongWord; TMW_Int = Integer; TMW_Long = LongInt; TMW_LParam = LongInt; TMW_LResult = LongInt; TMW_UInt = LongWord; TMW_WndProc = Pointer; TMW_WParam = LongInt; type TMW_Point = packed record X: TMW_Long; Y: TMW_Long; end; TMW_Msg = packed record HWnd : TMW_HWnd; Message: TMW_UInt; WParam : TMW_WParam; LParam : TMW_LParam; Time : TMW_DWord; Pt : TMW_Point; end; PMW_Rect = ^TMW_Rect; TMW_Rect = packed record XEsquerda, YEncima, XDireita, YEmbaixo: LongInt; end; TMW_PaintStruct= packed record HDC : TMW_HDC; FErase : TMW_Bool; RcPaint : TMW_Rect; FRestore : TMW_Bool; FIncUpdate : TMW_Bool; RGBReserved: array[0..31] of TMW_Byte; end; TMW_WndClass = packed record Style : TMW_UInt; LPFnWndProc : TMW_WndProc; CBClsExtra : TMW_Int; CBWndExtra : TMW_Int; HInstance : TMW_HInstance; HIcon : TMW_HIcon; HCursor : TMW_HCursor; HBrBackground: TMW_HBrush; LPSZMenuName : PAnsiChar; LPSZClassName: PAnsiChar; end; procedure RodarPrograma; procedure MW_PostQuitMessage (NExitCode: TMW_Int); stdcall; external cUser32 name 'PostQuitMessage'; function MW08_CreateWindowEx (DWExStyle: TMW_DWord; LPClassName, LPWindowName: PMW_LPCTStr; DWStyle: TMW_DWord; X, Y, NWidth, NHeight: TMW_Int; HWndParent: TMW_HWnd; HMenu: TMW_HMenu; HInstance: TMW_HInstance; LPParam: PMW_LPVoid): TMW_HWnd; stdcall; external cUser32 name 'CreateWindowExA'; function MW08_DefWindowProc (HWnd: TMW_HWnd; Msg: TMW_UInt; WParam: TMW_WParam; LParam: TMW_LParam) : TMW_LResult; stdcall; external cUser32 name 'DefWindowProcA'; function MW08_DispatchMessage (const LPMsg: TMW_Msg) : TMW_LResult; stdcall; external cUser32 name 'DispatchMessageA'; function MW08_ExtTextOut (HDC: TMW_HDC; X, Y: TMW_Int; FUOptions: TMW_UInt; Rect: PMW_Rect; LPString: PMW_LPCTStr; CBCount: TMW_UInt; LPDX: PMW_Int) : TMW_Bool; stdcall; external cGDI32 name 'ExtTextOutA'; function MW08_GetClassInfo (HInstance: TMW_HInstance; LPClassName: PMW_LPCTStr; var LPWndClass: TMW_WndClass) : TMW_Bool; stdcall; external cUser32 name 'GetClassInfoA'; function MW08_GetMessage (var LPMsg: TMW_Msg; HWnd: TMW_HWnd; WMsgFilterMin, WMsgFilterMax: TMW_UInt) : TMW_Bool; stdcall; external cUser32 name 'GetMessageA'; function MW08_LoadCursor (HInstance: TMW_HInstance; LPCursorName: PMW_LPCTStr) : TMW_HCursor; stdcall; external cUser32 name 'LoadCursorA'; function MW08_RegisterClass (const LPWndClass: TMW_WndClass) : TMW_Atom; stdcall; external cUser32 name 'RegisterClassA'; function MW_BeginPaint (HWnd: TMW_HWnd; var LPPaint: TMW_PaintStruct) : TMW_HDC; stdcall; external cUser32 name 'BeginPaint'; function MW_EndPaint (HWnd: TMW_HWnd; const LPPaint: TMW_PaintStruct) : TMW_Bool; stdcall; external cUser32 name 'EndPaint'; function MW_SetBkColor (HDC: TMW_HDC; CRColor: TMW_ColorRef) : TMW_ColorRef; stdcall; external cGDI32 name 'SetBkColor'; function MW_SetTextColor (HDC: TMW_HDC; CRColor: TMW_ColorRef) : TMW_ColorRef; stdcall; external cGDI32 name 'SetTextColor'; function MW_ShowWindow (HWnd: TMW_HWnd; NCmdShow: TMW_Int) : TMW_Bool; stdcall; external cUser32 name 'ShowWindow'; function MW_TranslateMessage (const LPMsg: TMW_Msg) : TMW_Bool; stdcall; external cUser32 name 'TranslateMessage'; function MW_UpdateWindow (HWnd: TMW_HWnd) : TMW_Bool; stdcall; external cUser32 name 'UpdateWindow'; implementation const cMW_Color_BtnFace = 15; cMW_CS_DblClks = $08; cMW_CS_OwnDC = $20; cMW_ETO_Clipped = 4; cMW_ETO_Opaque = 2; cMW_IDC_Arrow = PMW_LPCTStr (32512); cMW_SW_Show = 5; cMW_WM_Destroy = $0002; cMW_WM_Paint = $000F; cMW_WS_ClipChildren = $02000000; cMW_WS_ClipSiblings = $04000000; cMW_WS_OverlappedWindow= $00CF0000;

procedure Desenhar (AHWnd: TMW_HWnd);
const
  cArea: TMW_Rect= (XEsquerda: 10; YEncima: 20; XDireita: 300; YEmbaixo: 60);
  cTitulo        = 'Título desenhado em resposta ao WM_Paint';

var
  DC: TMW_HDC;
  PS: TMW_PaintStruct;

begin
  DC:= MW_BeginPaint (AHWnd, PS);
  MW_SetBkColor (DC, cMW_Color_BtnFace);
  MW_SetTextColor (DC, $00FF00);
  MW08_ExtTextOut (DC, cArea.XEsquerda, cArea.YEncima, cMW_ETO_Clipped or cMW_ETO_Opaque, @cArea, PMW_LPCTStr (cTitulo), Length (cTitulo), nil);
  MW_EndPaint (AHWnd, PS);
end;

function Espetar (AHWnd: TMW_HWnd; AMsg: TMW_UInt; AWParam: TMW_WParam; ALParam: TMW_LParam): TMW_LResult; stdcall;

begin
  Result:= 0;
  case AMsg of
    cMW_WM_Destroy: MW_PostQuitMessage (0);
    cMW_WM_Paint  : Desenhar (AHWnd);
  else
    Result:= MW08_DefWindowProc (AHWnd, AMsg, AWParam, ALParam);
  end;
end;

procedure RodarPrograma;
var
  Id: TMW_HWnd;
  WC: TMW_WndClass;

 procedure Inicializar;

 begin
   WC.Style        := cMW_CS_DblClks or cMW_CS_OwnDC;
   WC.LPFnWndProc  := @Espetar;
   WC.CBClsExtra   := 0;
   WC.CBWndExtra   := 0;
   WC.HInstance    := HInstance;
   WC.HIcon        := 0;
   WC.HCursor      := MW08_LoadCursor (0, cMW_IDC_Arrow);
   WC.HBrBackground:= cMW_Color_BtnFace + 1;
   WC.LPSzMenuName := nil;
   WC.LPSzClassName:= 'MonoliticoBasico';
 end;

 procedure IdentificadorCriar;
 var
   Tmp: TMW_WndClass;

 begin
   if (not MW08_GetClassInfo (HInstance, WC.LPSzClassName, Tmp)) and (MW08_RegisterClass (WC) = 0) then
     Id:= 0
   else
     Id:= MW08_CreateWindowEx (0, WC.LPSzClassName, 'Monolítico básico', cMW_WS_OverlappedWindow or cMW_WS_ClipChildren or cMW_WS_ClipSiblings, 150, 150, 350, 300, 0, 0, HInstance, nil);
 end;

 procedure Rodar;
 var
   R: TMW_Int;
   M: TMW_Msg;

 begin
   if Id <> 0 then begin
     MW_ShowWindow (Id, cMW_SW_Show);
     MW_UpdateWindow (Id);
     R:= TMW_Int (MW08_GetMessage (M, 0, 0, 0));
     while (R <> 0) and (R <> -1) do begin
       MW_TranslateMessage (M);
       MW08_DispatchMessage (M);
       R:= TMW_Int (MW08_GetMessage (M, 0, 0, 0));
     end;
   end;
 end;

begin
  Inicializar;
  IdentificadorCriar;
  Rodar;
end;