* * *

Author Topic: Using BGRABitmap over a PageControl tab  (Read 273 times)

tvargasn

  • Newbie
  • Posts: 1
Using BGRABitmap over a PageControl tab
« on: June 10, 2017, 03:51:23 am »
Hi, how I can draw something (2d canvas i.e.) over a tab in a PageContol. I've already seen all the tutorials on the wiki, but all tutorials are made over a form.

TPageContol do not have an OnPaint event.

Excuse my English and thanks.

Pascal

  • Sr. Member
  • ****
  • Posts: 388
Re: Using BGRABitmap over a PageControl tab
« Reply #1 on: June 10, 2017, 08:17:49 am »
You can use a decendant of TPageControl:

Code: Pascal  [Select]
  1. unit primePageControl;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, ComCtrls, Graphics, SysUtils, LCLIntf, LCLType, Controls;
  9.  
  10. type
  11.  
  12.   { TprimePageControl }
  13.  
  14.   TprimePageControl = class(TPageControl)
  15.   protected
  16.     procedure PaintWindow(DC: HDC); override;
  17.   end;
  18.  
  19. procedure Register;
  20.  
  21. implementation
  22.  
  23. uses
  24.   primeGlobalData, primeFile, primeSourceFile, primeXRefFile,
  25.   primeKISFile;
  26.  
  27. { TprimePageControl }
  28.  
  29. procedure TprimePageControl.PaintWindow(DC: HDC);
  30. var r, r2, r3, r4:TRect;
  31.     i: Integer;
  32.   f: TprimeFile;
  33. begin
  34.   inherited PaintWindow(DC);
  35.   //DebugLn('TrimePageControl.Paint()');
  36.   for i:=0 to PageCount-1 do begin
  37.     r:= TabRect(i);
  38.     f := TprimeFile(Pages[i].Tag);
  39.     if not Assigned(f) then exit;
  40.     //DebugLn('  %d - %s (%s)', [i, f.Name, f.ClassName]);
  41.     if (TabPosition in [tpLeft, tpRight]) then begin
  42.       r2.TopLeft.x:=r.Left;
  43.       r2.TopLeft.y:=r.Top;
  44.       r2.BottomRight.x:=r2.TopLeft.x + 2;
  45.       r2.BottomRight.y:=r.Bottom - 3;
  46.     end else begin
  47.       r2.TopLeft.x:=r.Left + 3;
  48.       r2.TopLeft.y:=r.Bottom - 2;
  49.       r2.BottomRight.x:=r.Right - 4;
  50.       r2.BottomRight.y:=r2.TopLeft.y + 2;
  51.       r3.TopLeft.x := r.Left + 5;
  52.       r3.TopLeft.y := r.Top + 7;
  53.       if i <> ActivePageIndex then inc(r3.TopLeft.y, 2);
  54.       r3.BottomRight.x := r3.TopLeft.x + 4;
  55.       r3.BottomRight.y := r3.TopLeft.y + 4;
  56.       r4.TopLeft.x := r3.TopLeft.x - 2;
  57.       r4.TopLeft.y := r3.TopLeft.y - 2;
  58.       r4.BottomRight.x := r3.BottomRight.x + 2;
  59.       r4.BottomRight.y := r3.BottomRight.y + 2;
  60.     end;
  61.     if f.Modified then begin
  62.       Brush.Color := clRed;
  63.       FillRect(DC, r4, HBRUSH(Brush.Reference.Handle));
  64.     end else if (f is TprimeKISFile) and TprimeKISFile(f).NeedsCheckIn then begin
  65.       Brush.Color := TColor($80C0FF);
  66.       FillRect(DC, r3, HBRUSH(Brush.Reference.Handle));
  67.     end;
  68.  
  69.     if (f is TprimeSourceFile) and TprimeSourceFile(f).IsActiveProgram then begin
  70.       //DebugLn('    -> ActiveProgam');
  71.       Brush.Color := TColor($00BB00);
  72.       FillRect(DC, r2, HBRUSH(Brush.Reference.Handle));
  73.     end else if (f is TprimeXRefFile) and TprimeXRefFile(f).IsActiveXRef then begin
  74.       //DebugLn('    -> ActiveXRef');
  75.       Brush.Color := TColor($0080FF);
  76.       FillRect(DC, r2, HBRUSH(Brush.Reference.Handle));
  77.     end;
  78.   end;
  79. end;
  80.  
  81. end.
  82.  

But you can't use it in the from designer (when it's not registered) just at runtime.
laz trunk - fpc trunk 32bit - Windows 10 Pro x64

lainz

  • Hero Member
  • *****
  • Posts: 1861
  • Nace una flor, todos los días sale el sol...
    • BGRABitmap
Re: Using BGRABitmap over a PageControl tab
« Reply #2 on: June 14, 2017, 11:56:57 pm »
Drop a BGRAVirtualScreen on the PageControl tab?

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus