Recent

Author Topic: May be useful to somebody  (Read 1942 times)

Ten_Mile_Hike

  • Jr. Member
  • **
  • Posts: 87
May be useful to somebody
« on: April 13, 2024, 06:17:49 am »
Code: Text  [Select][+][-]
  1. The attached picture uses only Tlabels to depict an exponent as though
  2. it was a superscript. I did this by placing a tiny label on top of the base label as well
  3. as adjusting the text layout properties and font sizes of both. The tiny TLabel only
  4. displays the exponent as its caption.
  5. I am only posting this in the chance that it might help someone who wants a rich text
  6. effect but doesn't want to use a richtext component

« Last Edit: April 13, 2024, 06:20:16 am by Ten_Mile_Hike »
When any government, or any church for that matter, undertakes to say to its subjects, This you may not read, this you
must not see, this you are forbidden to know, the end result is tyranny and oppression no matter how holy the motives.

Robert A. Heinlein

Handoko

  • Hero Member
  • *****
  • Posts: 5376
  • My goal: build my own game engine using Lazarus
Re: May be useful to somebody
« Reply #1 on: April 23, 2024, 07:35:48 am »

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: May be useful to somebody
« Reply #2 on: April 23, 2024, 12:38:22 pm »
Good one Handoko, I was not aware about yours and started my own, basics are same I think.
My thingy aint perfect nor ready, just some basics prepared to make it better.
Button1 initiate the action on Panel2.
2 checkboxes and a TEdit is used.
As of right now my way does write only to the width, height/wordwrap is not teached yet but you can call method seperate with proper coordinate.

TODO:
better color managment, currently it is fixed to black background and white text.
boundschecking if written text is inside rect, wordwrap etc

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  9.   Spin;
  10.  
  11. type
  12.   TTextStyle = (tsNone, tsSuper, tsSub);
  13.   TOneLine = packed record
  14.     X, Y: Integer;
  15.     TextStyle: TTextStyle;
  16.     Line: string;
  17.   end;
  18.   TAllLines = array of TOneLine;
  19.  
  20. type
  21.  
  22.   { TForm1 }
  23.  
  24.   TForm1 = class(TForm)
  25.     Button1: TButton;
  26.     cbSub: TCheckBox;
  27.     cbSuper: TCheckBox;
  28.     Edit1: TEdit;
  29.     Label1: TLabel;
  30.     Panel1: TPanel;
  31.     Panel2: TPanel;
  32.     SpinEdit1: TSpinEdit;
  33.     procedure Button1Click(Sender: TObject);
  34.     procedure cbSuperChange(Sender: TObject);
  35.     procedure cbSubChange(Sender: TObject);
  36.     procedure FormCreate(Sender: TObject);
  37.   strict private
  38.     FBMP: TBitmap;
  39.     Lines: TAllLines;
  40.   strict private
  41.     procedure AddLine(const ABitmap: TBitmap; const AFont: TFont;
  42.       const AText: string; const AStyle: TTextStyle = tsNone;
  43.       const X: Integer = -1; const Y: Integer = -1);
  44.   private
  45.  
  46.   public
  47.  
  48.   end;
  49.  
  50. var
  51.   Form1: TForm1;
  52.  
  53. implementation
  54.  
  55. {$R *.lfm}
  56.  
  57. { TForm1 }
  58.  
  59. procedure TForm1.FormCreate(Sender: TObject);
  60. begin
  61.   FBMP := TBitmap.Create;
  62.   FBMP.SetSize(Panel2.ClientRect.Width, Panel2.ClientRect.Height);
  63. end;
  64.  
  65. procedure TForm1.AddLine(const ABitmap: TBitmap; const AFont: TFont;
  66.   const AText: string; const AStyle: TTextStyle = tsNone;
  67.   const X: Integer = -1; const Y: Integer = -1);
  68. var
  69.   LX, LY: Integer;
  70.   i: Integer;
  71.   FontSize: Integer;
  72. begin
  73.   // sanity check
  74.   if AText = '' then
  75.     Exit;
  76.   ABitmap.Canvas.Brush.Style := bsClear;
  77.   ABitmap.Canvas.Font := AFont;
  78.   ABitmap.Canvas.Font.Color := clWhite;
  79.   // precheck X/Y
  80.   if (X = -1) and (Length(Lines) = 0) then
  81.     LX := 0;
  82.   if (Y = -1) and (Length(Lines) = 0) then
  83.     LY := 0;
  84.   if (X = -1) and (Length(Lines) > 0) then
  85.     LX := Lines[High(Lines)].X + ABitmap.Canvas.TextWidth(Lines[High(Lines)].Line);
  86.   if (Y = -1) and (Length(Lines) > 0) then
  87.     LY := Lines[High(Lines)].Y;
  88.   i := Length(Lines);
  89.   SetLength(Lines, Succ(i));
  90.   Lines[i].Line := AText;
  91.   Lines[i].X := LX;
  92.   Lines[i].Y := LY;
  93.   Lines[i].TextStyle := AStyle;
  94.   case AStyle of
  95.     tsNone:  ABitmap.Canvas.TextOut(Lines[i].X, Lines[i].Y, Lines[i].Line);
  96.     tsSuper: begin
  97.                if ABitmap.Canvas.Font.Size = 0 then
  98.                  FontSize := (9 * 2) div 3
  99.                else
  100.                  FontSize := (ABitmap.Canvas.Font.Size * 2) div 3
  101.                ABitmap.Canvas.Font.Size := FontSize;
  102.                ABitmap.Canvas.TextOut(Lines[i].X, Lines[i].Y - FontSize, Lines[i].Line);
  103.              end;
  104.     tsSub:   begin
  105.                if ABitmap.Canvas.Font.Size = 0 then
  106.                  FontSize := (9 * 2) div 3
  107.                else
  108.                  FontSize := (ABitmap.Canvas.Font.Size * 2) div 3
  109.                ABitmap.Canvas.Font.Size := FontSize;
  110.                ABitmap.Canvas.TextOut(Lines[i].X, Lines[i].Y + FontSize, Lines[i].Line);
  111.              end;
  112.   end;
  113. end;
  114.  
  115. procedure TForm1.Button1Click(Sender: TObject);
  116. begin
  117.   if ((not cbSuper.Checked) and (not cbSub.Checked)) then
  118.     AddLine(FBMP, Self.Font, Edit1.Text);
  119.   if (cbSuper.Checked and (not cbSub.Checked)) then
  120.     AddLine(FBMP, Self.Font, Edit1.Text, tsSuper);
  121.   if ((not cbSuper.Checked) and cbSub.Checked) then
  122.     AddLine(FBMP, Self.Font, Edit1.Text, tsSub);
  123.   Panel2.Canvas.Draw(0, 0, FBMP);
  124. end;
  125.  
  126. procedure TForm1.cbSuperChange(Sender: TObject);
  127. begin
  128.   if cbSuper.Checked then
  129.     cbSub.Checked := False;
  130. end;
  131.  
  132. procedure TForm1.cbSubChange(Sender: TObject);
  133. begin
  134.   if cbSub.Checked then
  135.     cbSuper.Checked := False;
  136. end;
  137.  
  138. end.
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

 

TinyPortal © 2005-2018