quarta-feira, 15 de janeiro de 2025

Como converter decimal para romanos em Delphi

function DecToRoman( Decimal: LongInt ): String;

{Converte um numero decimal em algarismos romanos}

const

    Romans: Array[1..13] of String = ( 'I', 'IV', 'V', 'IX', 'X','XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M' );

    Arabics: Array[1..13] of Integer =( 1, 4, 5, 9, 10, 40, 50, 90,100, 400, 500, 900, 1000);

var

    i: Integer;

    scratch: String;

begin

  scratch := '';

  for i := 13 downto 1 do

  while ( Decimal >= Arabics[i] ) do

  begin

  Decimal := Decimal - Arabics[i];

  scratch := scratch + Romans[i];

  end;

  Result := scratch;

end;

Colocar uma ProgressBar numa StatusBar

Coloque uma StatusBar no form e adicione dois painéis a ela (propriedade Panels). Ajuste as propriedades do primeiro painel comoStyle = psOwnerDraw e Width = 150. Coloque uma ProgressBar no form e mude sua propriedade Visible para false. No evento OnDrawPanel da StatusBar digite o código abaixo:

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;

Panel: TStatusPanel; const Rect: TRect);

begin

  { Se for o primeiro painel... }

  if Panel.Index = 0 then begin

      { Ajusta a tamanho da ProgressBar de acordo com o tamanho do painel }

      ProgressBar1.Width := Rect.Right - Rect.Left +1;

      ProgressBar1.Height := Rect.Bottom - Rect.Top +1;

      { Pinta a ProgressBar no DC (device-context) da StatusBar }

      ProgressBar1.PaintTo(StatusBar.Canvas.Handle, Rect.Left, Rect.Top);

  end;

end;

ColoqueumButtonnoform

DigitenoeventoOnClickdoButtonocódigoabaixo:

procedure TForm1.Button1Click(Sender: TObject);

var

  I: integer;

begin

  for I := ProgressBar1.Min to ProgressBar1.Max do begin

  { Atualiza a posição da ProgressBar }

  ProgressBar1.Position := I;

  { Repinta a StatusBar para forçar a atualização visual }

  StatusBar1.Repaint;

  { Aguarda 50 milisegundos }

  Sleep(50);

  end;

  { Aguarde 500 milisegundos }

  Sleep(500);

  { Reseta (zera) a ProgressBar }

  ProgressBar1.Position := ProgressBar1.Min;

  { Repinta a StatusBar para forçar a atualização visual }

  StatusBar1.Repaint;

end;

Execute e clique no botão para ver o resultado.


Colocar os bitmaps na DLL

 Por vezes, quando iniciamos um projeto, temos uma preocupação: fazer uma aplicação pequena em delphi. Bem, a solução pode passar por colocar todos os bitmaps que vamos utilizar numa DLL. Então vamos lá começar:

Deve usar o Image Editor, criar uma nova Resource File (.res), neste ficheiro vamos colocar os bitmaps e icons (ambos funcionam da mesma forma) que queremos na nossa aplicação, clique com a tecla direita do mouse na nova resource file e crie um novo bitmap, depois desenhe ou cole do clipboard um bitmap, finalmente guarde o ficheiro com o nome images.res. Depois disto estar feito vá ao IDE do Delphi e no File menu clique New... e escolha DLL depois cole o código abaixo, não se esqueça de adicionar uma unit vazia ao projeto. Guarde o projeto da dll no mesmo diretório do ficheiro image.res, finalmente faça o build da DLL (não se esqueça, que não se pode correr (executar) uma DLL!)

Código da DLL:

library ImageRes; {nome da dll}

uses DummyUnit; {DummyUnit é uma unit vazia, que é necessária}

{$R images.res} {nome da resource file, que deve estar no mesmo caminho da dll}

begin

end.

Código da DummyUnit:

unit DummyUnit;

interface

implementation

end.


Colocando bitmaps num ComboBox

Ajuste a propriedade Style do ComboBox para csOwnerDrawVariable

var

  Form1: TForm1;

  Bmp1, Bmp2, Bmp3: TBitmap;

implementation

 {$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

    Bmp1:=TBitmap.Create;

    Bmp.Loadfromfile('c:\chip16.bmp');

    Bmp1:=TBitmap.Create;

    Bmp.Loadfromfile('c:\zoom.bmp');

    Bmp1:=TBitmap.Create;

    Bmp.Loadfromfile('c:\disk.bmp');

    ComboBox1.Items.AddObject('Chip',Bmp1);

    ComboBox1.Items.AddObject('Zoom',Bmp2);

    ComboBox1.Items.AddObject('Disk',Bmp3);

end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOWnerDrawState);

var

  Bitmap: TBitmap;

  Offset: Integer;

begin

  with (Control as TComboBox).Canvas do

  begin

      FillRect(Rect); Bitmap:= TBitmap(ComboBox1.Items.Objects[index]);

      if Bitmap nil then begin

        BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,

        Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), clRed);

        Offset: Bitmap.width + 8;

      end;

      TextOut(Rect.Left + Offset, Rect.Top, ComboBox1.Items[index]);

  end;

end;

procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);

begin

  Height:=20;

end;